71 lines
3.4 KiB
Haskell
71 lines
3.4 KiB
Haskell
module Handler.Utils.Sheet where
|
|
|
|
import Import
|
|
import Handler.Utils.Delete
|
|
|
|
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
|
|
|
|
|
|
sheetDeleteRoute :: Set SheetId -> DeleteRoute Sheet
|
|
sheetDeleteRoute drRecords = DeleteRoute
|
|
{ drRecords
|
|
, drGetInfo = \(sheet `E.InnerJoin` course `E.InnerJoin` school) -> do
|
|
E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
|
|
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
|
let submissions = E.sub_select . E.from $ \submission -> do
|
|
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
|
|
return E.countRows
|
|
E.orderBy [E.asc $ sheet E.^. SheetName]
|
|
return (submissions, sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
|
|
, drUnjoin = \(sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet
|
|
, drRenderRecord = \(E.Value submissions, E.Value shn', _, E.Value cName, _, E.Value sName, E.Value tid') ->
|
|
return [whamlet|
|
|
$newline never
|
|
#{shn'} (_{SomeMessage $ ShortTermIdentifier (unTermKey tid')}, #{sName}, #{cName})
|
|
$if submissions /= 0
|
|
<i>_{SomeMessage $ MsgSheetDelHasSubmissions submissions}
|
|
|]
|
|
, drRecordConfirmString = \(E.Value submissions, E.Value shn', E.Value csh', _, E.Value ssh', _, E.Value tid') ->
|
|
return $ [st|#{termToText (unTermKey tid')}/#{ssh'}/#{csh'}/#{shn'}|] <> bool mempty [st| + #{tshow submissions} Subs|] (submissions /= 0)
|
|
, drCaption = SomeMessage MsgSheetDeleteQuestion
|
|
, drSuccessMessage = SomeMessage MsgSheetDeleted
|
|
, drAbort = error "drAbort undefined"
|
|
, drSuccess = error "drSuccess undefined"
|
|
}
|