{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE Rank2Types #-}{-# LANGUAGE OverloadedStrings #-}moduleYesod.Helpers.Crud(Item(..),Crud(..),CrudRoute(..),defaultCrud)whereimportYesod.YesodimportYesod.WidgetimportYesod.DispatchimportYesod.ContentimportYesod.HandlerimportText.HamletimportYesod.FormimportLanguage.Haskell.TH.Syntax-- | An entity which can be displayed by the Crud subsite.classItemawhere-- | The title of an entity, to be displayed in the list of all entities.itemTitle::a->String-- | Defines all of the CRUD operations (Create, Read, Update, Delete)-- necessary to implement this subsite. When using the "Yesod.Form" module and-- 'ToForm' typeclass, you can probably just use 'defaultCrud'.dataCrudmasteritem=Crud{crudSelect::GHandler(Crudmasteritem)master[(Keyitem,item)],crudReplace::Keyitem->item->GHandler(Crudmasteritem)master(),crudInsert::item->GHandler(Crudmasteritem)master(Keyitem),crudGet::Keyitem->GHandler(Crudmasteritem)master(Maybeitem),crudDelete::Keyitem->GHandler(Crudmasteritem)master()}mkYesodSub"Crud master item"[ClassP''Yesod[VarT$mkName"master"],ClassP''Item[VarT$mkName"item"],ClassP''SinglePiece[ConT''Key`AppT`VarT(mkName"item")],ClassP''ToForm[VarT$mkName"item",VarT$mkName"master"]][$parseRoutes|/CrudListRGET/addCrudAddRGETPOST/edit/#StringCrudEditRGETPOST/delete/#StringCrudDeleteRGETPOST|]getCrudListR::(Yesodmaster,Itemitem,SinglePiece(Keyitem))=>GHandler(Crudmasteritem)masterRepHtmlgetCrudListR=doitems<-getYesodSub>>=crudSelecttoMaster<-getRouteToMasterdefaultLayout$dosetTitle"Items"addBody[$hamlet|%h1Items%ul$forallitemsitem%li%a!href=@toMaster.CrudEditR.toSinglePiece.fst.item@$itemTitle.snd.item$%p%a!href=@toMaster.CrudAddR@Addnewitem|]getCrudAddR::(Yesodmaster,Itemitem,SinglePiece(Keyitem),ToFormitemmaster)=>GHandler(Crudmasteritem)masterRepHtmlgetCrudAddR=crudHelper"Add new"(Nothing::Maybe(Keyitem,item))FalsepostCrudAddR::(Yesodmaster,Itemitem,SinglePiece(Keyitem),ToFormitemmaster)=>GHandler(Crudmasteritem)masterRepHtmlpostCrudAddR=crudHelper"Add new"(Nothing::Maybe(Keyitem,item))TruegetCrudEditR::(Yesodmaster,Itemitem,SinglePiece(Keyitem),ToFormitemmaster)=>String->GHandler(Crudmasteritem)masterRepHtmlgetCrudEditRs=doitemId<-maybenotFoundreturn$itemReadIdscrud<-getYesodSubitem<-crudGetcruditemId>>=maybenotFoundreturncrudHelper"Edit item"(Just(itemId,item))FalsepostCrudEditR::(Yesodmaster,Itemitem,SinglePiece(Keyitem),ToFormitemmaster)=>String->GHandler(Crudmasteritem)masterRepHtmlpostCrudEditRs=doitemId<-maybenotFoundreturn$itemReadIdscrud<-getYesodSubitem<-crudGetcruditemId>>=maybenotFoundreturncrudHelper"Edit item"(Just(itemId,item))TruegetCrudDeleteR::(Yesodmaster,Itemitem,SinglePiece(Keyitem))=>String->GHandler(Crudmasteritem)masterRepHtmlgetCrudDeleteRs=doitemId<-maybenotFoundreturn$itemReadIdscrud<-getYesodSubitem<-crudGetcruditemId>>=maybenotFoundreturn-- Just ensure it existstoMaster<-getRouteToMasterdefaultLayout$dosetTitle"Confirm delete"addBody[$hamlet|%form!method=post!action=@toMaster.CrudDeleteR.s@%h1Reallydelete?%pDoyoureallywanttodelete$itemTitle.item$?%p%input!type=submit!value=Yes\$%a!href=@toMaster.CrudListR@No|]postCrudDeleteR::(Yesodmaster,Itemitem,SinglePiece(Keyitem))=>String->GHandler(Crudmasteritem)masterRepHtmlpostCrudDeleteRs=doitemId<-maybenotFoundreturn$itemReadIdscrud<-getYesodSubtoMaster<-getRouteToMastercrudDeletecruditemIdredirectRedirectTemporary$toMasterCrudListRitemReadId::SinglePiecex=>String->MaybexitemReadId=either(constNothing)Just.fromSinglePiececrudHelper::(Itema,Yesodmaster,SinglePiece(Keya),ToFormamaster)=>String->Maybe(Keya,a)->Bool->GHandler(Crudmastera)masterRepHtmlcrudHelpertitlemeisPost=docrud<-getYesodSub(errs,form,enctype)<-runFormPost$toForm$fmapsndmetoMaster<-getRouteToMastercase(isPost,errs)of(True,FormSuccessa)->doeid<-casemeofJust(eid,_)->docrudReplacecrudeidareturneidNothing->crudInsertcrudaredirectRedirectTemporary$toMaster$CrudEditR$toSinglePieceeid_->return()defaultLayout$dowrapWidgetform(wrapFormtoMasterenctype)setTitle$stringtitlewherewrapFormtoMasterenctypeform=[$hamlet|%p%a!href=@toMaster.CrudListR@Returntolist%h1$title$%form!method=post!enctype=$enctype$%table^form^%tr%td!colspan=2%input!type=submit$maybemee\$%a!href=@toMaster.CrudDeleteR.toSinglePiece.fst.e@Delete|]-- | A default 'Crud' value which relies about persistent and "Yesod.Form".defaultCrud::(PersistEntityi,PersistBackend(YesodDBa(GHandler(Crudai)a)),YesodPersista)=>a->CrudaidefaultCrud=constCrud{crudSelect=runDB$selectList[][]00,crudReplace=\a->runDB.replacea,crudInsert=runDB.insert,crudGet=runDB.get,crudDelete=runDB.delete}