fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Multifile fields for Hints,Solutions,Markings

Browse Source
This commit is contained in:
SJost 2018-07-18 13:10:24 +02:00
parent 9feb4b7d5d
commit ab80b9207d
2 changed files with 24 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Handler/Sheet.hs
View File

@ -78,9 +78,10 @@ data SheetForm = SheetForm
, sfActiveTo :: UTCTime
, sfSheetF :: Maybe (Source Handler (Either FileId File))
, sfHintFrom :: Maybe UTCTime
, sfHintF :: Maybe FileInfo
, sfHintF :: Maybe (Source Handler (Either FileId File))
, sfSolutionFrom :: Maybe UTCTime
, sfSolutionF :: Maybe FileInfo
, sfSolutionF :: Maybe (Source Handler (Either FileId File))
, sfMarkingF :: Maybe (Source Handler (Either FileId File))
-- Keine SheetId im Formular!
}
@ -113,11 +114,13 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
<*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur Korrektoren"
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
(sfHintFrom <$> template)
<*> fileAFormOpt (fslI MsgSheetHint)
<*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
<*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur Korrektoren"
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
(sfSolutionFrom <$> template)
<*> fileAFormOpt (fslI MsgSheetSolution)
<*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
<*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking
& setTooltip "Hinweise zur Korrektur, sichtbar nur für Korrektoren") (sfMarkingF <$> template)
<* submitButton
return $ case result of
FormSuccess sheetResult
@ -305,12 +308,13 @@ getSEditR :: TermId -> Text -> Text -> Handler Html
getSEditR tid csh shn = do
(sheetEnt, sheetFileIds) <- runDB $ do
ent <- fetchSheet tid csh shn
fIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
allfIds <- E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent)
E.&&. sheetFile E.^. SheetFileType E.==. E.val SheetExercise
return (file E.^. FileId)
return (ent, fIds)
return (sheetFile E.^. SheetFileType, file E.^. FileId)
let ftIds :: SheetFileType -> Set FileId
ftIds ft = Set.fromList $ mapMaybe (\(E.Value t, E.Value i) -> i <$ guard (ft==t)) allfIds
return (ent, ftIds)
let sid = entityKey sheetEnt
let oldSheet@(Sheet {..}) = entityVal sheetEnt
let template = Just $ SheetForm
@ -322,11 +326,12 @@ getSEditR tid csh shn = do
, sfVisibleFrom = sheetVisibleFrom
, sfActiveFrom = sheetActiveFrom
, sfActiveTo = sheetActiveTo
, sfSheetF = Just . yieldMany . map Left $ Set.toList sheetFileIds
, sfSheetF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise
, sfHintFrom = sheetHintFrom
, sfHintF = Nothing -- TODO
, sfHintF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint
, sfSolutionFrom = sheetSolutionFrom
, sfSolutionF = Nothing -- TODO
, sfSolutionF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution
, sfMarkingF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking
}
let action newSheet = do
replaceRes <- myReplaceUnique sid $ newSheet
@ -366,8 +371,9 @@ handleSheetEdit tid csh msId template dbAction = do
Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName)
(Just sid) -> do -- save files in DB:
whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise
whenIsJust sfHintF $ insertSheetFile sid SheetHint
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
whenIsJust sfHintF $ insertSheetFile' sid SheetHint
whenIsJust sfSolutionF $ insertSheetFile' sid SheetSolution
whenIsJust sfMarkingF $ insertSheetFile' sid SheetMarking
insert_ $ SheetEdit aid actTime sid
addMessageI "info" $ MsgSheetEditOk tid csh sfName
return True

5
src/Utils.hs
View File

@ -153,6 +153,11 @@ trd3 (_,_,z) = z
-----------
-- Maybe --
-----------
toMaybe :: Bool -> a -> Maybe a
toMaybe True = Just
toMaybe False = const Nothing
whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just x) f = f x
whenIsJust Nothing _ = return ()