module Handler.Sheet.List ( getSheetListR ) where import Import hiding (link) import Utils.Sheet import Handler.Utils import Handler.Utils.SheetType import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import qualified Data.Map as Map getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetListR tid ssh csh = do muid <- maybeAuthId now <- liftIO getCurrentTime cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh let hasSFT :: (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool) -> [SheetFileType] hasSFT (E.Value hasExercise, E.Value hasHint, E.Value hasSolution, E.Value hasMarking) = [ sft | sft <- universeF , sft /= SheetExercise || hasExercise , sft /= SheetHint || hasHint , sft /= SheetSolution || hasSolution , sft /= SheetMarking || hasMarking ] lastSheetEdit sheet = E.subSelectMaybe . E.from $ \sheetEdit -> do E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId return . E.max_ $ sheetEdit E.^. SheetEditTime sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionUser))) -> E.SqlQuery () sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission E.on $ E.just (sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid E.where_ $ sheet E.^. SheetCourse E.==. E.val cid querySubmission :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionUser))) -> E.SqlExpr (Maybe (Entity Submission)) querySubmission (_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) = submission sheetFilter :: SheetName -> DB Bool sheetFilter sheetName = hasReadAccessTo $ CSheetR tid ssh csh sheetName SShowR sheetCol = widgetColonnade . mconcat $ [ -- dbRow , sortable (Just "name") (i18nCell MsgTableSheet) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) sheetName , sortable (Just "last-edit") (i18nCell MsgTableLastEdit) $ \DBRow{dbrOutput=(_, E.Value mEditTime, _, _)} -> foldMap dateTimeCell mEditTime , sortable (Just "visible-from") (i18nCell MsgSheetAccessibleSince) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom , sortable (toNothing "downloads") (i18nCell MsgFiles) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, existFiles)} -> listCell [ icnCell & addIconFixedWidth | let existingSFTs = hasSFT existFiles , sft <- [minBound..maxBound] , let link = CSheetR tid ssh csh sheetName $ SZipR sft , let icn = toWgt $ sheetFile2markup sft , let icnCell = if sft `elem` existingSFTs then linkEitherCell link (icn, [whamlet| |]) else spacerCell ] id & cellAttrs <>~ [("class","list--inline list--space-separated")] , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveFrom , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveTo , sortable Nothing (i18nCell MsgSheetSheetType) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> cell $ do sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType tr <- getTranslate toWidget $ sheetTypeDesc tr , sortable Nothing (i18nCell MsgTableSubmission) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub, _)} -> case mbSub of Nothing -> mempty (Just (Entity sid Submission{})) -> let mkCid = encrypt sid -- TODO: executed twice mkRoute = do cid' <- mkCid return $ CSubmissionR tid ssh csh sheetName cid' SubShowR in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{cid2}|]) , sortable (Just "rating") (i18nCell MsgTableRating) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} -> let stats = sheetTypeSum sheetType in -- for statistics over all shown rows case mbSub of Nothing -> cellTell mempty $ stats Nothing (Just (Entity sid sub@Submission{..})) -> let mkRoute :: (MonadHandler m, HandlerSite m ~ UniWorX) => m (Route UniWorX) mkRoute = liftHandler $ do cid' <- encrypt sid return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating") tellStats = tell $ stats submissionRatingPoints in guardAuthCell ((, False) <$> mkRoute) $ acell & cellContents %~ (<* tellStats) , sortable Nothing -- (Just "percent") (i18nCell MsgRatingPercent) $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType, sheetName}, _, mbSub,_)} -> case mbSub of (Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) -> case preview (_grading . _maxPoints) sType of Just maxPoints | maxPoints /= 0 -> let mkRoute = liftHandler $ do cid' <- encrypt sid return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR in guardAuthCell ((, False) <$> mkRoute) . cell $ do toWidget . toMessage $ textPercent sPoints maxPoints _other -> mempty _other -> mempty ] psValidator = def & defaultSorting [SortDescBy "submission-until", SortDescBy "submission-since"] & forceFilter "may-access" (Any True) (raw_statistics,table) <- runDB $ dbTableWidget psValidator DBTable { dbtColonnade = sheetCol , dbtSQLQuery = \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> do sheetData dt let existFiles = -- check whether files exist for given type ( hasSheetFileQuery sheet (E.val muid) SheetExercise , hasSheetFileQuery sheet (E.val muid) SheetHint , hasSheetFileQuery sheet (E.val muid) SheetSolution , hasSheetFileQuery sheet (E.val muid) SheetMarking ) return (sheet, lastSheetEdit sheet, submission, existFiles) , dbtRowKey = \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetId , dbtProj = dbtProjFilteredPostId , dbtSorting = Map.fromList [ ( "name" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName ) , ( "last-edit" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> lastSheetEdit sheet ) , ( "visible-from" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetVisibleFrom ) , ( "submission-since" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom ) , ( "submission-until" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo ) , ( "rating" , SortColumn $ \(_sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> submission E.?. SubmissionRatingPoints ) -- GitLab Issue $143: HOW TO SORT? -- , ( "percent" -- , SortColumn $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> -- case sheetType of -- no Haskell inside Esqueleto, right? -- (submission E.?. SubmissionRatingPoints) E./. (sheet E.^. SheetType) -- ) ] , dbtFilter = mconcat [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) DBRow{..} -> let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool)) in (== b) <$> sheetFilter sheetName :: DB Bool , singletonMap "rated" . FilterColumn $ \(Any b) -> (E.==. E.val b) . E.isJust . (E.?. SubmissionRatingTime) . querySubmission , singletonMap "is-exam" . mkFilterProjectedPost $ \(Any b) DBRow{..} -> let (Entity _ Sheet{..}, _, _, _) = dbrOutput :: (Entity Sheet, E.Value (Maybe UTCTime), Maybe (Entity Submission), (E.Value Bool, E.Value Bool, E.Value Bool, E.Value Bool)) in return $ is _ExamPartPoints sheetType == b :: DB Bool ] , dbtFilterUI = mconcat [ flip (prismAForm $ singletonFilter "is-exam" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSheetTypeIsExam) , flip (prismAForm $ singletonFilter "rated" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgIsRated) ] , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } , dbtParams = def , dbtIdent = "sheets" :: Text , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] } -- ) ( -- !!!DEPRECTAED!!! Summary only over shown rows !!! -- -- Collect summary over all Sheets, not just the ones shown due to pagination: -- do -- rows <- E.select $ E.from $ \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> -- sheetData dt *> return (sheet E.^. SheetName, sheet E.^. SheetType, submission E.?. SubmissionRatingPoints) -- flip filterM rows (\(E.Value sheetName, _, _) -> sheetFilter sheetName) -- ) let statistics = gradeSummaryWidget MsgSheetGradingSummaryTitle raw_statistics -- only over shown rows -- foldMap (\(_, E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) defaultLayout $(widgetFile "sheetList")