diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 2ccc7c667..91eb63eeb 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -171,7 +171,7 @@ SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan SheetName: Name SheetDescription: Hinweise für Teilnehmer SheetGroup: Gruppenabgabe -SheetVisibleFrom: Verfügbar seit +SheetVisibleFrom: Sichtbar für Teilnehmer ab SheetVisibleFromTip: Ohne Datum nie sichtbar und keine Abgabe möglich; nur für unfertige Blätter leer lassen, deren Bewertung/Fristen sich noch ändern können SheetActiveFrom: Beginn Abgabezeitraum SheetActiveFromTip: Download der Aufgabenstellung erst ab diesem Datum möglich @@ -407,6 +407,7 @@ Pseudonyms: Pseudonyme FileTitle: Dateiname FileModified: Letzte Änderung VisibleFrom: Veröffentlicht +AccessibleSince: Verfügbar seit Corrected: Korrigiert @@ -753,6 +754,10 @@ MenuCorrections: Korrekturen MenuCorrectionsOwn: Meine Korrekturen MenuSubmissions: Abgaben MenuSheetList: Übungsblätter +MenuMaterialList: Material +MenuMaterialNew: Neues Material veröffentlichen +MenuMaterialEdit: Material bearbeiten +MenuMaterialDelete: Material löschen MenuTutorialList: Tutorien MenuTutorialNew: Neues Tutorium anlegen MenuSheetNew: Neues Übungsblatt anlegen diff --git a/src/Foundation.hs b/src/Foundation.hs index 3376ef527..d6aa98f7d 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -163,9 +163,13 @@ pattern CSheetR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetR pattern CSheetR tid ssh csh shn ptn = CourseR tid ssh csh (SheetR shn ptn) +pattern CMaterialR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> MaterialR -> Route UniWorX +pattern CMaterialR tid ssh csh mnm ptn + = CourseR tid ssh csh (MaterialR mnm ptn) + pattern CTutorialR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> TutorialR -> Route UniWorX -pattern CTutorialR tid ssh csh shn ptn - = CourseR tid ssh csh (TutorialR shn ptn) +pattern CTutorialR tid ssh csh tnm ptn + = CourseR tid ssh csh (TutorialR tnm ptn) pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionR -> Route UniWorX pattern CSubmissionR tid ssh csh shn cid ptn @@ -668,7 +672,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of cTime <- liftIO getCurrentTime let visible = NTop materialVisibleFrom <= NTop (Just cTime) guard visible - reutrn Authorized + return Authorized CourseR tid ssh csh CRegisterR -> do now <- liftIO getCurrentTime @@ -1405,6 +1409,14 @@ instance YesodBreadcrumbs UniWorX where -- (CSubmissionR tid ssh csh shn _ SubDownloadR) -- just for Download breadcrumb (CSheetR tid ssh csh shn SCorrR) = return ("Korrektoren", Just $ CSheetR tid ssh csh shn SShowR) -- (CSheetR tid ssh csh shn SFileR) -- just for Downloads + + breadcrumb (CourseR tid ssh csh MaterialListR) = return ("Material" , Just $ CourseR tid ssh csh CShowR) + breadcrumb (CourseR tid ssh csh MaterialNewR ) = return ("Neu" , Just $ CourseR tid ssh csh MaterialListR) + breadcrumb (CMaterialR tid ssh csh mnm MShowR) = return (CI.original mnm, Just $ CourseR tid ssh csh MaterialListR) + breadcrumb (CMaterialR tid ssh csh mnm MEditR) = return ("Bearbeiten" , Just $ CMaterialR tid ssh csh mnm MShowR) + breadcrumb (CMaterialR tid ssh csh mnm MDelR) = return ("Löschen" , Just $ CMaterialR tid ssh csh mnm MShowR) + -- (CMaterialR tid ssh csh mnm MFileR) -- just for Downloads + -- Others breadcrumb (CorrectionsR) = return ("Korrekturen", Just HomeR) breadcrumb (CorrectionsUploadR) = return ("Hochladen", Just CorrectionsR) @@ -1763,6 +1775,14 @@ pageActions (CourseNewR) = [ ] pageActions (CourseR tid ssh csh CShowR) = [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuMaterialList + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialListR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem { menuItemType = PageActionPrime , menuItemLabel = MsgMenuSheetList , menuItemIcon = Nothing @@ -1891,6 +1911,34 @@ pageActions (CourseR tid ssh csh SheetListR) = , menuItemAccessCallback' = return True } ] +pageActions (CourseR tid ssh csh MaterialListR) = + [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuMaterialNew + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialNewR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + ] +pageActions (CMaterialR tid ssh csh mnm MShowR) = + [ MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuMaterialEdit + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CMaterialR tid ssh csh mnm MEditR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgMenuMaterialDelete + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CMaterialR tid ssh csh mnm MDelR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + ] pageActions (CourseR tid ssh csh CTutorialListR) = [ MenuItem { menuItemType = PageActionPrime diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 07a88b731..56e696daf 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -83,7 +83,7 @@ getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR tid ssh csh = do let matLink :: MaterialName -> Route UniWorX matLink = CourseR tid ssh csh . flip MaterialR MShowR - _muid <- maybeAuthId + now <- liftIO getCurrentTime table <- runDB $ do cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh let row2material = entityVal . dbrOutput -- no inner join, just Entity Material @@ -104,13 +104,18 @@ getMaterialListR tid ssh csh = do $ foldMap textCell . materialType . row2material , sortable (Just "name") (i18nCell MsgMaterialName) $ liftA2 anchorCell matLink toWgt . materialName . row2material + , sortable (toNothingS "description") mempty + $ foldMap modalCell . materialDescription . row2material + , sortable (Just "visble-from") (i18nCell MsgAccessibleSince) + $ foldMap (dateTimeCellVisible now) . materialVisibleFrom . row2material , sortable (Just "last-edit") (i18nCell MsgFileModified) $ dateTimeCell . materialLastEdit . row2material ] , dbtSorting = Map.fromList - [ ( "type" , SortColumn (E.^. MaterialType) ) - , ( "name" , SortColumn (E.^. MaterialName) ) - , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) + [ ( "type" , SortColumn (E.^. MaterialType) ) + , ( "name" , SortColumn (E.^. MaterialName) ) + , ( "visible-from" , SortColumn (E.^. MaterialVisibleFrom) ) + , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mempty , dbtFilterUI = mempty diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index d12e2723e..e5c86ed26 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -154,6 +154,7 @@ getSheetOldUnassigned tid ssh csh = runDB $ do getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetListR tid ssh csh = do muid <- maybeAuthId + now <- liftIO getCurrentTime cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh let lastSheetEdit sheet = E.sub_select . E.from $ \sheetEdit -> do @@ -175,9 +176,9 @@ getSheetListR tid ssh csh = do , sortable (Just "name") (i18nCell MsgSheet) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName) , sortable (Just "last-edit") (i18nCell MsgLastEdit) - $ \DBRow{dbrOutput=(_, E.Value mEditTime, _)} -> maybe mempty dateTimeCell mEditTime - , sortable (Just "visible-from") (i18nCell MsgSheetVisibleFrom) - $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> maybe mempty dateTimeCell sheetVisibleFrom + $ \DBRow{dbrOutput=(_, E.Value mEditTime, _)} -> foldMap dateTimeCell mEditTime + , sortable (Just "visible-from") (i18nCell MsgAccessibleSince) + $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> foldMap (dateTimeCellVisible now) sheetVisibleFrom , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> dateTimeCell sheetActiveFrom , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 307336e70..5f7a29e52 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -53,7 +53,13 @@ pathPieceCell = cell . toWidget . toPathPiece sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a sqlCell act = mempty & cellContents .~ lift act --- Recfor line numbers, use dbRow +markCell :: (IsDBTable m a) => (a -> Bool) -> (a -> DBCell m a) -> a -> DBCell m a +markCell condition normal x + | condition x = (normal x) <> (cell $ isVisibleWidget False) + | otherwise = normal x + + +-- Recall: for line numbers, use dbRow --------------------- -- Icon cells @@ -76,6 +82,9 @@ commentCell Nothing = mempty commentCell (Just link) = anchorCell link icon where icon = toWidget $ hasComment True +-- | Display an icon that opens a modal upon clicking +modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a +modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget content) ----------------- -- Datatype cells @@ -88,6 +97,12 @@ dateCell t = cell $ formatTime SelFormatDate t >>= toWidget dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a dateTimeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget +dateTimeCellVisible :: IsDBTable m a => UTCTime -> UTCTime -> DBCell m a +dateTimeCellVisible watershed t = cell $ do + tfw <- formatTime SelFormatDateTime t >>= toWidget + icn <- bool mempty (toWidget $ isVisible False) $ watershed < t + return $ tfw <> icn + userCell :: IsDBTable m a => Text -> Text -> DBCell m a userCell displayName surname = cell $ nameWidget displayName surname