From ab80b9207d81fd8650ce45084f0589f2723b15e5 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 18 Jul 2018 13:10:24 +0200
Subject: [PATCH] Multifile fields for Hints,Solutions,Markings

---
 src/Handler/Sheet.hs | 32 +++++++++++++++++++-------------
 src/Utils.hs         |  5 +++++
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index f564b0af4..2dfe98535 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -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
diff --git a/src/Utils.hs b/src/Utils.hs
index 7132bd178..1ec44e5ba 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -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 ()