{-# LANGUAGE TemplateHaskell #-}moduleYesod.Routes.TH.RenderRoute(-- ** RenderRoutemkRenderRouteInstance,mkRenderRouteInstance',mkRouteCons,mkRenderRouteClauses)whereimportYesod.Routes.TH.TypesimportLanguage.Haskell.TH.SyntaximportData.Maybe(maybeToList)importControl.Monad(replicateM)importData.Text(pack)importWeb.PathPieces(PathPiece(..),PathMultiPiece(..))importYesod.Routes.ClassimportData.Monoid(mconcat)-- | Generate the constructors of a route data type.mkRouteCons::[ResourceTreeType]->([Con],[Dec])mkRouteCons=mconcat.mapmkRouteConwheremkRouteCon(ResourceLeafres)=([con],[])wherecon=NormalC(mkName$resourceNameres)$map(\x->(NotStrict,x))$concat[singles,multi,sub]singles=concatMap(toSingle.snd)$resourcePiecesrestoSingleStatic{}=[]toSingle(Dynamictyp)=[typ]multi=maybeToList$resourceMultiressub=caseresourceDispatchresofSubsite{subsiteType=typ}->[ConT''Route`AppT`typ]_->[]mkRouteCon(ResourceParentnamepieceschildren)=([con],dec:decs)where(cons,decs)=mkRouteConschildrencon=NormalC(mkNamename)$map(\x->(NotStrict,x))$concat[singles,[ConT$mkNamename]]dec=DataD[](mkNamename)[]cons[''Show,''Read,''Eq]singles=concatMap(toSingle.snd)piecestoSingleStatic{}=[]toSingle(Dynamictyp)=[typ]-- | Clauses for the 'renderRoute' method.mkRenderRouteClauses::[ResourceTreeType]->Q[Clause]mkRenderRouteClauses=mapMgowhereisDynamicDynamic{}=TrueisDynamic_=Falsego(ResourceParentnamepieceschildren)=doletcnt=length$filter(isDynamic.snd)piecesdyns<-replicateMcnt$newName"dyn"child<-newName"child"letpat=ConP(mkNamename)$mapVarP$dyns++[child]pack'<-[|pack|]tsp<-[|toPathPiece|]letpiecesSingle=mkPieces(AppEpack'.LitE.StringL)tsp(mapsndpieces)dynschildRender<-newName"childRender"letrr=VarEchildRenderchildClauses<-mkRenderRouteClauseschildrena<-newName"a"b<-newName"b"colon<-[|(:)|]letconsyys=InfixE(Justy)colon(Justys)letpieces'=foldrcons(VarEa)piecesSingleletbody=LamE[TupP[VarPa,VarPb]](TupE[pieces',VarEb])`AppE`(rr`AppE`VarEchild)return$Clause[pat](NormalBbody)[FunDchildRenderchildClauses]go(ResourceLeafres)=doletcnt=length(filter(isDynamic.snd)$resourcePiecesres)+maybe0(const1)(resourceMultires)dyns<-replicateMcnt$newName"dyn"sub<-caseresourceDispatchresofSubsite{}->fmapreturn$newName"sub"_->return[]letpat=ConP(mkName$resourceNameres)$mapVarP$dyns++subpack'<-[|pack|]tsp<-[|toPathPiece|]letpiecesSingle=mkPieces(AppEpack'.LitE.StringL)tsp(mapsnd$resourcePiecesres)dynspiecesMulti<-caseresourceMultiresofNothing->return$ListE[]Just{}->dotmp<-[|toPathMultiPiece|]return$tmp`AppE`VarE(lastdyns)body<-casesubof[x]->dorr<-[|renderRoute|]a<-newName"a"b<-newName"b"colon<-[|(:)|]letconsyys=InfixE(Justy)colon(Justys)letpieces=foldrcons(VarEa)piecesSinglereturn$LamE[TupP[VarPa,VarPb]](TupE[pieces,VarEb])`AppE`(rr`AppE`VarEx)_->docolon<-[|(:)|]letconsab=InfixE(Justa)colon(Justb)return$TupE[foldrconspiecesMultipiecesSingle,ListE[]]return$Clause[pat](NormalBbody)[]mkPieces__[]_=[]mkPiecestoTexttsp(Statics:ps)dyns=toTexts:mkPiecestoTexttsppsdynsmkPiecestoTexttsp(Dynamic{}:ps)(d:dyns)=tsp`AppE`VarEd:mkPiecestoTexttsppsdynsmkPieces__((Dynamic_):_)[]=error"mkPieces 120"-- | Generate the 'RenderRoute' instance.---- This includes both the 'Route' associated type and the-- 'renderRoute' method. This function uses both 'mkRouteCons' and-- 'mkRenderRouteClasses'.mkRenderRouteInstance::Type->[ResourceTreeType]->Q[Dec]mkRenderRouteInstance=mkRenderRouteInstance'[]-- | A more general version of 'mkRenderRouteInstance' which takes an-- additional context.mkRenderRouteInstance'::Cxt->Type->[ResourceTreeType]->Q[Dec]mkRenderRouteInstance'cxttypress=docls<-mkRenderRouteClausesresslet(cons,decs)=mkRouteConsressreturn$InstanceDcxt(ConT''RenderRoute`AppT`typ)[DataInstD[]''Route[typ]consclazzes,FunD(mkName"renderRoute")cls]:decswhereclazzes=[''Show,''Eq,''Read]