Material working; just links and right missing

This commit is contained in:
Steffen Jost 2019-05-03 18:08:15 +02:00
parent dc4ec6148f
commit 3021435350
4 changed files with 21 additions and 16 deletions

View File

@ -220,7 +220,7 @@ MaterialVisibleFromTip: Ohne Datum nie sichtbar für Teilnehmer; leer lassen ist
MaterialInvisible: Dieses Material ist für Teilnehmer momentan unsichtbar! MaterialInvisible: Dieses Material ist für Teilnehmer momentan unsichtbar!
MaterialInvisibleUntil date@Text: Dieses Material ist für Teilnehmer momentan unsichtbar bis #{date}! MaterialInvisibleUntil date@Text: Dieses Material ist für Teilnehmer momentan unsichtbar bis #{date}!
MaterialFiles: Dateien MaterialFiles: Dateien
MaterialHeading materialName@MaterialName: Material #{materialName} MaterialHeading materialName@MaterialName: Material "#{materialName}"
MaterialListHeading: Materialien MaterialListHeading: Materialien
MaterialNewHeading: Neues Material veröffentlichen MaterialNewHeading: Neues Material veröffentlichen
MaterialNewTitle: Neues Material MaterialNewTitle: Neues Material

8
routes
View File

@ -106,13 +106,13 @@
/pseudonym SPseudonymR GET POST !registeredANDcorrector-submissions /pseudonym SPseudonymR GET POST !registeredANDcorrector-submissions
/corrector-invite/#UserEmail SCorrInviteR GET POST /corrector-invite/#UserEmail SCorrInviteR GET POST
!/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector !/#SheetFileType/*FilePath SFileR GET !timeANDregistered !timeANDmaterials !corrector
/mat MaterialListR GET !materials !registered !corrector /file MaterialListR GET !materials !registered !corrector
/mat/new MaterialNewR GET POST /file/new MaterialNewR GET POST
/mat/#MaterialName MaterialR: /file/#MaterialName MaterialR:
/edit MEditR GET POST /edit MEditR GET POST
/delete MDelR GET POST /delete MDelR GET POST
/show MShowR GET !timeANDregistered !timeANDmaterials !corrector /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 /subs CorrectionsR GET POST !corrector !lecturer

View File

@ -17,6 +17,7 @@ import Utils.Lens
import Utils.Form import Utils.Form
import Handler.Utils import Handler.Utils
-- import Handler.Utils.Delete -- import Handler.Utils.Delete
import Handler.Utils.Table.Cells
import Handler.Utils.Table.Columns import Handler.Utils.Table.Columns
import Control.Monad.Writer (MonadWriter(..), execWriterT) import Control.Monad.Writer (MonadWriter(..), execWriterT)
@ -85,7 +86,8 @@ getMaterialListR tid ssh csh = do
_muid <- maybeAuthId _muid <- maybeAuthId
table <- runDB $ do table <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh 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 table <- dbTableWidget' psValidator DBTable
{ dbtIdent = "material-list" :: Text { dbtIdent = "material-list" :: Text
, dbtStyle = def , dbtStyle = def
@ -94,17 +96,21 @@ getMaterialListR tid ssh csh = do
E.where_ $ material E.^. MaterialCourse E.==. E.val cid E.where_ $ material E.^. MaterialCourse E.==. E.val cid
return material return material
, dbtRowKey = (E.^. MaterialId) , dbtRowKey = (E.^. MaterialId)
, dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Material{..}) } -> -- , dbtProj = \dbr -> guardAuthorizedFor (matLink . materialName $ dbr ^. _dbrOutput . _entityVal) dbr
let link = matLink materialName , dbtProj = guardAuthorizedFor =<< matLink . materialName . row2material -- Moand: (a ->)
in guardAuthorizedFor link dbr
, dbtColonnade = widgetColonnade $ mconcat , dbtColonnade = widgetColonnade $ mconcat
[ dbRow [ dbRow
, sortable (Just "type") (i18nCell MsgMaterialType)
$ foldMap textCell . materialType . row2material
, sortable (Just "name") (i18nCell MsgMaterialName) , 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 , dbtFilter = mempty
, dbtFilterUI = mempty , dbtFilterUI = mempty
@ -157,8 +163,7 @@ getMShowR tid ssh csh mnm = do
, colFilePathSimple (view $ _dbrOutput . _1) matLink , colFilePathSimple (view $ _dbrOutput . _1) matLink
, colFileModification (view $ _dbrOutput . _2) , colFileModification (view $ _dbrOutput . _2)
] ]
, dbtProj = \dbr@DBRow{ dbrOutput=(E.Value fPath, _) } -> , dbtProj = \dbr -> guardAuthorizedFor (matLink $ dbr ^. _dbrOutput . _1 . _Value) dbr
guardAuthorizedFor (matLink fPath) dbr
, dbtStyle = def , dbtStyle = def
, dbtParams = def , dbtParams = def
, dbtFilter = mempty , dbtFilter = mempty

View File

@ -67,7 +67,7 @@ colFilePathSimple row2path row2link = sortable (Just "path") (i18nCell MsgFileTi
-- | Generic column for File Modification -- | Generic column for File Modification
colFileModification :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c) 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 :: IsString s => (r -> E.SqlExpr (Entity File)) -> (s, SortColumn r)
sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. FileTitle)) sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. FileTitle))