diff --git a/models b/models index ce5229b24..31f089285 100644 --- a/models +++ b/models @@ -142,8 +142,8 @@ SubmissionEdit SubmissionFile submission SubmissionId file FileId - isUpdate Bool - isDeletion Bool + isUpdate Bool -- is this the file updated by a corrector (original will always be retained) + isDeletion Bool -- only set if isUpdate is also set, but file was deleted by corrector UniqueSubmissionFile file submission isUpdate deriving Show SubmissionUser diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 8f3d895cb..61b2c4eb3 100644 --- a/src/Handler/Sheet.hs +++ b/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 diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index b15ec6adf..08996f47e 100644 --- a/src/Handler/Submission.hs +++ b/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) - -> runConduit $ transPipe lift files .| Conduit.map Left .| sinkSubmission shid uid Nothing + (Just files, _) -- new files + -> 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 Archiv $forall (name,time) <- lastEdits
last edited by #{name} at #{formatTimeGerDTlong time} - $maybe cid <- mcid + $maybe fileTable <- mFileTable

Enthaltene Dateien: - $forall (Entity _ File{..}) <- oldfiles - - #{fileTitle} + ^{fileTable} |] - 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.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] + 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.desc returns corrector updated data first return f getSubmissionDownloadSingleR :: CryptoUUIDSubmission -> FilePath -> Handler TypedContent