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

5
src/Utils.hs
View File

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