From 3021435350af743f77bc7f6a7f5001fe832a11c3 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 3 May 2019 18:08:15 +0200 Subject: [PATCH] Material working; just links and right missing --- messages/uniworx/de.msg | 2 +- routes | 8 ++++---- src/Handler/Material.hs | 25 +++++++++++++++---------- src/Handler/Utils/Table/Columns.hs | 2 +- 4 files changed, 21 insertions(+), 16 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7873810fe..37a5523e6 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -220,7 +220,7 @@ MaterialVisibleFromTip: Ohne Datum nie sichtbar für Teilnehmer; leer lassen ist MaterialInvisible: Dieses Material ist für Teilnehmer momentan unsichtbar! MaterialInvisibleUntil date@Text: Dieses Material ist für Teilnehmer momentan unsichtbar bis #{date}! MaterialFiles: Dateien -MaterialHeading materialName@MaterialName: Material #{materialName} +MaterialHeading materialName@MaterialName: Material "#{materialName}" MaterialListHeading: Materialien MaterialNewHeading: Neues Material veröffentlichen MaterialNewTitle: Neues Material diff --git a/routes b/routes index 135c9baa1..70c4b50d0 100644 --- a/routes +++ b/routes @@ -106,13 +106,13 @@ /pseudonym SPseudonymR GET POST !registeredANDcorrector-submissions /corrector-invite/#UserEmail SCorrInviteR GET POST !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector - /mat MaterialListR GET !materials !registered !corrector - /mat/new MaterialNewR GET POST - /mat/#MaterialName MaterialR: + /file MaterialListR GET !materials !registered !corrector + /file/new MaterialNewR GET POST + /file/#MaterialName MaterialR: /edit MEditR GET POST /delete MDelR GET POST /show MShowR GET !timeANDregistered !timeANDmaterials !corrector - /file/*FilePath MFileR GET !timeANDregistered !timeANDmaterials !corrector + /part/*FilePath MFileR GET !timeANDregistered !timeANDmaterials !corrector /subs CorrectionsR GET POST !corrector !lecturer diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 483f35671..07a88b731 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -17,6 +17,7 @@ import Utils.Lens import Utils.Form import Handler.Utils -- import Handler.Utils.Delete +import Handler.Utils.Table.Cells import Handler.Utils.Table.Columns import Control.Monad.Writer (MonadWriter(..), execWriterT) @@ -85,7 +86,8 @@ getMaterialListR tid ssh csh = do _muid <- maybeAuthId table <- runDB $ do cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - let psValidator = def & defaultSorting [SortDescBy "last-edit"] + let row2material = entityVal . dbrOutput -- no inner join, just Entity Material + psValidator = def & defaultSorting [SortDescBy "last-edit"] table <- dbTableWidget' psValidator DBTable { dbtIdent = "material-list" :: Text , dbtStyle = def @@ -94,17 +96,21 @@ getMaterialListR tid ssh csh = do E.where_ $ material E.^. MaterialCourse E.==. E.val cid return material , dbtRowKey = (E.^. MaterialId) - , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Material{..}) } -> - let link = matLink materialName - in guardAuthorizedFor link dbr + -- , dbtProj = \dbr -> guardAuthorizedFor (matLink . materialName $ dbr ^. _dbrOutput . _entityVal) dbr + , dbtProj = guardAuthorizedFor =<< matLink . materialName . row2material -- Moand: (a ->) , dbtColonnade = widgetColonnade $ mconcat [ dbRow + , sortable (Just "type") (i18nCell MsgMaterialType) + $ foldMap textCell . materialType . row2material , sortable (Just "name") (i18nCell MsgMaterialName) - $ \DBRow{dbrOutput=(Entity _ Material{..})} -> cell $ toWgt materialName + $ liftA2 anchorCell matLink toWgt . materialName . row2material + , sortable (Just "last-edit") (i18nCell MsgFileModified) + $ dateTimeCell . materialLastEdit . row2material ] - , dbtSorting = const Map.empty -- Map.fromList - [ - + , dbtSorting = Map.fromList + [ ( "type" , SortColumn (E.^. MaterialType) ) + , ( "name" , SortColumn (E.^. MaterialName) ) + , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mempty , dbtFilterUI = mempty @@ -157,8 +163,7 @@ getMShowR tid ssh csh mnm = do , colFilePathSimple (view $ _dbrOutput . _1) matLink , colFileModification (view $ _dbrOutput . _2) ] - , dbtProj = \dbr@DBRow{ dbrOutput=(E.Value fPath, _) } -> - guardAuthorizedFor (matLink fPath) dbr + , dbtProj = \dbr -> guardAuthorizedFor (matLink $ dbr ^. _dbrOutput . _1 . _Value) dbr , dbtStyle = def , dbtParams = def , dbtFilter = mempty diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index d31f6365f..1c125344b 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -67,7 +67,7 @@ colFilePathSimple row2path row2link = sortable (Just "path") (i18nCell MsgFileTi -- | Generic column for File Modification colFileModification :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c) -colFileModification row2time = sortable (Just "time") (i18nCell MsgFileModified) (timeCell . E.unValue . row2time) +colFileModification row2time = sortable (Just "time") (i18nCell MsgFileModified) (dateTimeCell . E.unValue . row2time) sortFilePath :: IsString s => (r -> E.SqlExpr (Entity File)) -> (s, SortColumn r) sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. FileTitle))