Minor
This commit is contained in:
SJost
parent
d70781659e
commit
546c7bde95
4
models
4
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
<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
|
||||
<a href=@{SubmissionDownloadSingleR cid fileTitle}>
|
||||
#{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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user