This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Utils/Sheet.hs
2018-10-28 19:11:40 +01:00

44 lines
1.9 KiB
Haskell

module Handler.Utils.Sheet where
import Import
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Internal.Sql as E
fetchSheetAux :: ( BaseBackend backend ~ SqlBackend
, E.SqlSelect b a
, Typeable a, MonadHandler m, IsPersistBackend backend
, PersistQueryRead backend, PersistUniqueRead backend
)
=> (E.SqlExpr (Entity Sheet) -> b)
-> TermId -> SchoolId -> CourseShorthand -> SheetName -> ReaderT backend m a
fetchSheetAux prj tid ssh csh shn =
let cachId = encodeUtf8 $ tshow (tid,ssh,csh,shn)
in cachedBy cachId $ do
-- Mit Yesod:
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-- getBy404 $ CourseSheet cid shn
-- Mit Esqueleto:
sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.&&. sheet E.^. SheetName E.==. E.val shn
return $ prj sheet
case sheetList of
[sheet] -> return sheet
_other -> notFound
fetchSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet)
fetchSheet = fetchSheetAux id
fetchSheetId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet)
fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid ssh cid shn
fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid ssh cid shn