Minor

models

@@ -142,8 +142,8 @@ SubmissionEdit
 SubmissionFile
     submission      SubmissionId
     file            FileId
-    isUpdate        Bool
+    isUpdate        Bool         -- is this the file updated by a corrector (original will always be retained)
-    isDeletion      Bool
+    isDeletion      Bool         -- only set if isUpdate is also set, but file was deleted by corrector
     UniqueSubmissionFile file submission isUpdate
     deriving Show
 SubmissionUser

src/Handler/Sheet.hs

@@ -121,7 +121,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
       ] ]
 
 correctorForm :: Maybe SheetId -> [(UserId,Load)] -> MForm Handler (FormResult [(UserId,Load)], [FieldView UniWorX])
-correctorForm _msid templates = do undefined
+correctorForm _msid templates = return mempty -- TODO deprecated
   -- Datenbank UserId -> UserName
   -- Eingabelist für Colonnade
      -- enthält die benötigten Felder

src/Handler/Submission.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ParallelListComp #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -11,6 +12,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Handler.Submission where
 
@@ -51,6 +53,9 @@ import Yesod.Colonnade
 import qualified Text.Blaze.Html5.Attributes as HA
 
 
+numberOfSubmissionEditDates :: Int64
+numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
+
 
 makeSubmissionForm :: Maybe SubmissionId -> Bool -> SheetGroup -> [Text] -> Form (Maybe (Source Handler File), [Text])
 makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
@@ -75,7 +80,7 @@ getSubmissionR = postSubmissionR
 postSubmissionR tid csh shn (SubmissionMode mcid) = do
   uid   <- requireAuthId
   msmid <- traverse decrypt mcid
-  (Entity shid Sheet{..}, buddies, oldfiles,lastEdits)  <- runDB $ do
+  (Entity shid Sheet{..}, buddies, lastEdits)  <- runDB $ do
     sheet@(Entity shid Sheet{..})  <- fetchSheet tid csh shn
     case msmid of
       Nothing     -> do
@@ -103,7 +108,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
                     E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
               E.orderBy  [E.asc $ user E.^. UserEmail]
               return $ user E.^. UserEmail
-            return (sheet,buddies,[],[])
+            return (sheet,buddies,[])
           (E.Value smid:_) -> do
             cID <- encrypt smid
             addMessageI "info" $ MsgSubmissionAlreadyExists
@@ -118,16 +123,15 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
                 E.&&. submissionUser E.^. SubmissionUserUser       E.!=. E.val uid
           E.orderBy  [E.asc $ user E.^. UserEmail]
           return $ user E.^. UserEmail
-        oldfiles <- sourceToList $ submissionFileSource smid
         -- mLastEdit <- selectFirst [SubmissionEditSubmission ==. smid] [Desc SubmissionEditTime]
         lastEditValues <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
             E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
             E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
             E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
-            E.limit 3 -- TODO for Debug Purposes
+            E.limit numberOfSubmissionEditDates
             return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
         let lastEdits = map (bimap E.unValue E.unValue) lastEditValues
-        return (sheet,buddies,oldfiles,lastEdits)
+        return (sheet,buddies,lastEdits)
   let unpackZips = True -- undefined -- TODO
   ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
   mCID <- runDB $ do
@@ -174,10 +178,10 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
         now <- liftIO $ getCurrentTime
         smid <- do
           smid <- case (mFiles, msmid) of
-            (Nothing, Just smid)
+            (Nothing, Just smid)   -- no new files, existing submission partners updated
               -> return smid
-            (Just files, Nothing)
+            (Just files, _)  -- new files
-              -> runConduit $ transPipe lift files .| Conduit.map Left .| sinkSubmission shid uid Nothing
+              -> runConduit $ transPipe lift files .| Conduit.map Left .| sinkSubmission shid uid ((,False) <$> msmid)
             _ -> error "Impossible, because of definition of `makeSubmissionForm`"
           -- Determine members of pre-registered group
           groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
@@ -208,6 +212,28 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
   let formTitle = pageTitle
   let formText  = Nothing :: Maybe UniWorXMessage
   actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
+  -- Maybe construct a table to display uploaded archive files
+  let colonnadeFiles cid = mconcat
+        -- [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype
+        [ sortable (Just "path") "Dateiname" $ anchorCell (\(Entity _ File{..}) -> SubmissionDownloadSingleR cid fileTitle)
+                                                          (\(Entity _ File{..}) -> str2widget fileTitle)
+        , sortable (Just "time") "Modifikation" $ \(Entity _ File{..}) -> stringCell $ formatTimeGerWDT fileModified
+        ]
+      smid2ArchiveTable (smid,cid) = DBTable
+        { dbtSQLQuery = submissionFileQuery smid
+        , dbtColonnade = colonnadeFiles cid
+        , dbtAttrs = tableDefault
+        , dbtIdent = "files" :: Text
+        , dbtSorting =  [ ( "path"
+                          , SortColumn $ \(sf `E.InnerJoin` f) -> f E.^. FileTitle
+                          )
+                        , ( "time"
+                          , SortColumn $ \(sf `E.InnerJoin` f) -> f E.^. FileModified
+                          )
+                        ]
+        }
+  mFileTable <- traverse (dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
+
   defaultLayout $ do
     setTitleI pageTitle
     $(widgetFile "formPageI18n")
@@ -218,24 +244,25 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
           <a href=@{SubmissionDownloadArchiveR arCid}>Archiv
         $forall (name,time) <- lastEdits
           <div>last edited by #{name} at #{formatTimeGerDTlong time}
-        $maybe cid <- mcid
+        $maybe fileTable <- mFileTable
           <h3>Enthaltene Dateien:
-          $forall (Entity _ File{..}) <- oldfiles
+          ^{fileTable}
-            <a href=@{SubmissionDownloadSingleR cid fileTitle}>
-              #{fileTitle}
     |]
 
 
 
 
 
-
 submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
-submissionFileSource submissionID = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
+submissionFileSource = E.selectSource . E.from . submissionFileQuery
+
+submissionFileQuery :: SubmissionId -> E.SqlExpr (Entity SubmissionFile) `E.InnerJoin` E.SqlExpr (Entity File)
+                        -> E.SqlQuery (E.SqlExpr (Entity File))
+submissionFileQuery submissionID (sf `E.InnerJoin` f) = E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
   E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
   E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
-  E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
+  E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion -- TODO@gk: won't work as intended! Fix with refactor
-  E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
+  E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]  -- E.desc returns corrector updated data first
   return f
 
 getSubmissionDownloadSingleR :: CryptoUUIDSubmission -> FilePath -> Handler TypedContent