refactor(submission-helper): reduce number of db transactions
This commit is contained in:
Gregor Kleen
parent
f454df2069
commit
625caa10b5
@ -10,11 +10,12 @@ import Handler.Utils
|
|||||||
import Handler.Utils.Submission
|
import Handler.Utils.Submission
|
||||||
import Handler.Utils.Invitations
|
import Handler.Utils.Invitations
|
||||||
|
|
||||||
|
import Handler.Submission.Helper.ArchiveTable
|
||||||
|
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
|
|
||||||
import qualified Database.Esqueleto.Legacy as E
|
import qualified Database.Esqueleto.Legacy as E
|
||||||
import qualified Database.Esqueleto.Utils as E
|
import qualified Database.Esqueleto.Utils as E
|
||||||
import qualified Database.Esqueleto.Internal.Internal as E (unsafeSqlFunction)
|
|
||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Map ((!), (!?))
|
import Data.Map ((!), (!?))
|
||||||
@ -367,18 +368,13 @@ submissionHelper tid ssh csh shn mcid = do
|
|||||||
|
|
||||||
-- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
|
-- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
|
||||||
-- Therefore we do not restrict upload behaviour in any way in that case
|
-- Therefore we do not restrict upload behaviour in any way in that case
|
||||||
((res,formWidget'), formEnctype) <- runDB $ do
|
((formWidget', formEnctype), mAct) <- runDBJobs . setSerializable $ do
|
||||||
(sheet@(Entity _ Sheet{..}), buddies, _, _, isLecturer, isOwner, _, _) <- getSheetInfo
|
(sheet@(Entity shid Sheet{..}), buddies, _, _, isLecturer, isOwner, msubmission, _) <- hoist lift getSheetInfo
|
||||||
let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1)
|
let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1)
|
||||||
runFormPost . makeSubmissionForm sheetCourse sheet msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
|
((res, formWidget'), formEnctype) <- hoist lift . runFormPost . makeSubmissionForm sheetCourse sheet msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
|
||||||
let formWidget = wrapForm' BtnHandIn formWidget' def
|
|
||||||
{ formAction = Just $ SomeRoute actionUrl
|
|
||||||
, formEncoding = formEnctype
|
|
||||||
}
|
|
||||||
|
|
||||||
mCID <- fmap join . msgSubmissionErrors . runDBJobs . setSerializable $ do
|
|
||||||
(Entity shid Sheet{..}, _, _, _, isLecturer, _, msubmission, _) <- hoist lift getSheetInfo
|
|
||||||
|
|
||||||
|
-- Calling `msgSubmissionErrors` within a `runDB` is okay as long as we handle `transactionUndo` ourselves iff it returns nothing
|
||||||
|
mAct' <- msgSubmissionErrors $ do
|
||||||
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
|
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
|
||||||
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
|
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
|
||||||
E.where_ $ E.just (submissionUser E.^. SubmissionUserUser) E.==. E.val muid
|
E.where_ $ E.just (submissionUser E.^. SubmissionUserUser) E.==. E.val muid
|
||||||
@ -533,100 +529,41 @@ submissionHelper tid ssh csh shn mcid = do
|
|||||||
| subUsers == subUsersOld -> addMessageI Info MsgSubmissionUnchanged
|
| subUsers == subUsersOld -> addMessageI Info MsgSubmissionUnchanged
|
||||||
| otherwise -> addMessageI Success MsgSubmissionUsersUpdated
|
| otherwise -> addMessageI Success MsgSubmissionUsersUpdated
|
||||||
|
|
||||||
Just <$> encrypt smid
|
cID <- encrypt smid
|
||||||
|
|
||||||
case mCID of
|
|
||||||
Just cID -> do
|
|
||||||
let showRoute = CSubmissionR tid ssh csh shn cID SubShowR
|
let showRoute = CSubmissionR tid ssh csh shn cID SubShowR
|
||||||
mayShow <- hasReadAccessTo showRoute
|
mayShow <- hoist lift $ hasReadAccessTo showRoute
|
||||||
if
|
|
||||||
|
return . Just $ if
|
||||||
| mayShow -> redirect showRoute
|
| mayShow -> redirect showRoute
|
||||||
| otherwise -> redirect $ CSheetR tid ssh csh shn SShowR
|
| otherwise -> redirect $ CSheetR tid ssh csh shn SShowR
|
||||||
Nothing -> return ()
|
|
||||||
|
|
||||||
(Entity shid Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector) <- runDB getSheetInfo
|
case mAct' of
|
||||||
|
Nothing -> ((formWidget', formEnctype), Nothing) <$ E.transactionUndo -- manual rollback because we are calling `msgSubmissionErrors` within a `runDB`
|
||||||
|
Just mAct -> return ((formWidget', formEnctype), mAct)
|
||||||
|
|
||||||
(showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> runDB $ do
|
sequence_ mAct
|
||||||
|
let formWidget = wrapForm' BtnHandIn formWidget' def
|
||||||
|
{ formAction = Just $ SomeRoute actionUrl
|
||||||
|
, formEncoding = formEnctype
|
||||||
|
}
|
||||||
|
|
||||||
|
((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget) <- runDB $ do
|
||||||
|
sheetInfo@(Entity shid Sheet{..}, _, _, _, _, _, msubmission, _) <- getSheetInfo
|
||||||
|
|
||||||
|
(showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do
|
||||||
showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
|
showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
|
||||||
correctionInvisible <- correctionInvisibleWidget tid ssh csh shn cid subEnt
|
correctionInvisible <- correctionInvisibleWidget tid ssh csh shn cid subEnt
|
||||||
|
|
||||||
return (showCorrection, correctionInvisible)
|
return (showCorrection, correctionInvisible)
|
||||||
|
|
||||||
-- Maybe construct a table to display uploaded archive files
|
-- Maybe construct a table to display uploaded archive files
|
||||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerFor UniWorX) ())
|
mFileTable' <- for msmid $ mkSubmissionArchiveTable tid ssh csh shn showCorrection
|
||||||
colonnadeFiles cid = mconcat $ catMaybes
|
let filesCorrected = maybe False (view _1) mFileTable'
|
||||||
[ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \(mOrig, mCorr) -> let
|
mFileTable = view _2 <$> mFileTable'
|
||||||
fileTitle'' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
|
|
||||||
origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
|
|
||||||
corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
|
|
||||||
isFile' = origIsFile <|> corrIsFile
|
|
||||||
in maybeCell ((,) <$> fileTitle'' <*> isFile') $ \(fileTitle', isFile) -> if
|
|
||||||
| Just True <- origIsFile -> anchorCell (subDownloadLink cid SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
|
|
||||||
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
|
|
||||||
, guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \(_, mCorr) -> case mCorr of
|
|
||||||
Nothing -> cell mempty
|
|
||||||
Just (Entity _ SubmissionFile{..})
|
|
||||||
| isJust submissionFileContent -> anchorCell (subDownloadLink cid SubmissionCorrected submissionFileTitle) (i18n MsgFileCorrected :: Widget)
|
|
||||||
| otherwise -> i18nCell MsgCorrected
|
|
||||||
, Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \(mOrig, mCorr) -> let
|
|
||||||
origTime = submissionFileModified . entityVal <$> mOrig
|
|
||||||
corrTime = submissionFileModified . entityVal <$> mCorr
|
|
||||||
fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
|
||||||
in maybeCell fileTime dateTimeCell
|
|
||||||
]
|
|
||||||
subDownloadLink cid sft fileTitle' = CSubmissionR tid ssh csh shn cid $ SubDownloadR sft fileTitle'
|
|
||||||
submissionFiles :: _ -> _ -> E.SqlQuery _
|
|
||||||
submissionFiles smid (sf1 `E.FullOuterJoin` sf2) = do
|
|
||||||
E.on $ sf1 E.?. SubmissionFileTitle E.==. sf2 E.?. SubmissionFileTitle
|
|
||||||
E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission
|
|
||||||
E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId
|
|
||||||
E.&&. sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
|
|
||||||
E.&&. E.val showCorrection -- Do not correlate files if we don't show correction; together with `may-access` this treats corrected files like they literally don't exist
|
|
||||||
|
|
||||||
E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate))
|
sheetTypeDesc <- sheetTypeDescription sheetCourse sheetType
|
||||||
E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True) E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate))
|
|
||||||
E.&&. (sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False) E.||. E.isNothing (sf2 E.?. SubmissionFileIsDeletion))
|
|
||||||
E.&&. (sf1 E.?. SubmissionFileSubmission E.==. E.val (Just smid) E.||. sf2 E.?. SubmissionFileSubmission E.==. E.val (Just smid))
|
|
||||||
|
|
||||||
return (sf1, sf2)
|
multipleSubmissionWarnWidget <- runMaybeT $ do
|
||||||
smid2ArchiveTable (smid,cid) = DBTable
|
|
||||||
{ dbtSQLQuery = submissionFiles smid
|
|
||||||
, dbtRowKey = \(sf1 `E.FullOuterJoin` sf2) -> (sf1 E.?. SubmissionFileId, sf2 E.?. SubmissionFileId)
|
|
||||||
, dbtColonnade = colonnadeFiles cid
|
|
||||||
, dbtProj = dbrOutput <$> dbtProjId
|
|
||||||
, dbtStyle = def
|
|
||||||
, dbtIdent = "files" :: Text
|
|
||||||
, dbtSorting = mconcat
|
|
||||||
[ singletonMap "path" . SortColumn $ \(sf1 `E.FullOuterJoin` sf2) -> (E.unsafeSqlFunction "string_to_array" :: (E.SqlExpr (E.Value (Maybe String)), E.SqlExpr (E.Value String)) -> E.SqlExpr (E.Value [String])) (E.coalesce [sf1 E.?. SubmissionFileTitle, sf2 E.?. SubmissionFileTitle], E.val "/" :: E.SqlExpr (E.Value String))
|
|
||||||
, singletonMap "time" . SortColumn $ \(sf1 `E.FullOuterJoin` sf2) -> (E.unsafeSqlFunction "GREATEST" ([sf1 E.?. SubmissionFileModified, sf2 E.?. SubmissionFileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
|
|
||||||
]
|
|
||||||
, dbtFilter = mconcat
|
|
||||||
[ singletonMap "may-access" . FilterColumn $ \(Any b) (sf1 `E.FullOuterJoin` (_ :: E.SqlExpr (Maybe (Entity SubmissionFile))))
|
|
||||||
-> E.val b E.==. (E.val showCorrection E.||. E.isJust (sf1 E.?. SubmissionFileId))
|
|
||||||
]
|
|
||||||
, dbtFilterUI = mempty
|
|
||||||
, dbtParams = def
|
|
||||||
, dbtCsvEncode = noCsvEncode
|
|
||||||
, dbtCsvDecode = Nothing
|
|
||||||
, dbtExtraReps = []
|
|
||||||
}
|
|
||||||
archiveTableValidator = def
|
|
||||||
& defaultSorting [SortAscBy "path"]
|
|
||||||
& forceFilter "may-access" (Any True)
|
|
||||||
mFileTable <- traverse (runDB . dbTableWidget' archiveTableValidator) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
|
|
||||||
|
|
||||||
|
|
||||||
filesCorrected <- fmap (fromMaybe False) . for msmid $ \subId -> runDB . E.selectExists . E.from $ \(sFile1 `E.LeftOuterJoin` sFile2) -> do
|
|
||||||
E.on $ E.just (sFile1 E.^. SubmissionFileTitle) E.==. sFile2 E.?. SubmissionFileTitle
|
|
||||||
E.&&. E.just (sFile1 E.^. SubmissionFileSubmission) E.==. sFile2 E.?. SubmissionFileSubmission
|
|
||||||
E.&&. sFile1 E.^. SubmissionFileContent E.!=. E.joinV (sFile2 E.?. SubmissionFileContent)
|
|
||||||
E.&&. sFile1 E.^. SubmissionFileIsUpdate E.&&. E.maybe E.false E.not_ (sFile2 E.?. SubmissionFileIsUpdate)
|
|
||||||
E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. E.val subId
|
|
||||||
E.where_ $ sFile2 E.?. SubmissionFileSubmission E.==. E.just (E.val subId)
|
|
||||||
|
|
||||||
sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
|
|
||||||
|
|
||||||
multipleSubmissionWarnWidget <- runDB . runMaybeT $ do
|
|
||||||
subId <- hoistMaybe msmid
|
subId <- hoistMaybe msmid
|
||||||
cID <- hoistMaybe mcid
|
cID <- hoistMaybe mcid
|
||||||
guardM . lift $ orM
|
guardM . lift $ orM
|
||||||
@ -644,6 +581,8 @@ submissionHelper tid ssh csh shn mcid = do
|
|||||||
E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
|
E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
|
||||||
return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning
|
return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning
|
||||||
|
|
||||||
|
return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget)
|
||||||
|
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI $ MsgHeadingSubmissionEditHead tid ssh csh shn
|
setTitleI $ MsgHeadingSubmissionEditHead tid ssh csh shn
|
||||||
(urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
|
(urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
|
||||||
|
|||||||
112
src/Handler/Submission/Helper/ArchiveTable.hs
Normal file
112
src/Handler/Submission/Helper/ArchiveTable.hs
Normal file
@ -0,0 +1,112 @@
|
|||||||
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||||
|
|
||||||
|
module Handler.Submission.Helper.ArchiveTable
|
||||||
|
( mkSubmissionArchiveTable
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
import Handler.Utils
|
||||||
|
import qualified Database.Esqueleto.Legacy as E
|
||||||
|
import qualified Database.Esqueleto.Utils as E
|
||||||
|
import qualified Database.Esqueleto.Internal.Internal as E (unsafeSqlFunction)
|
||||||
|
|
||||||
|
|
||||||
|
type SubmissionArchiveExpr = E.SqlExpr (Maybe (Entity SubmissionFile)) `E.FullOuterJoin` E.SqlExpr (Maybe (Entity SubmissionFile))
|
||||||
|
|
||||||
|
queryOriginal, queryCorrected :: Getter SubmissionArchiveExpr (E.SqlExpr (Maybe (Entity SubmissionFile)))
|
||||||
|
queryOriginal = to $(E.sqlFOJproj 2 1)
|
||||||
|
queryCorrected = to $(E.sqlFOJproj 2 2)
|
||||||
|
|
||||||
|
|
||||||
|
type SubmissionArchiveData = DBRow ( Maybe (Entity SubmissionFile)
|
||||||
|
, Maybe (Entity SubmissionFile)
|
||||||
|
)
|
||||||
|
|
||||||
|
resultOriginal, resultCorrected :: Traversal' SubmissionArchiveData (Entity SubmissionFile)
|
||||||
|
resultOriginal = _dbrOutput . _1 . _Just
|
||||||
|
resultCorrected = _dbrOutput . _2 . _Just
|
||||||
|
|
||||||
|
|
||||||
|
mkSubmissionArchiveTable :: TermId -> SchoolId -> CourseShorthand -> SheetName
|
||||||
|
-> Bool -- ^ @showCorrection@
|
||||||
|
-> SubmissionId
|
||||||
|
-> DB (Bool, Widget)
|
||||||
|
mkSubmissionArchiveTable tid ssh csh shn showCorrection smid = do
|
||||||
|
cID <- encrypt smid :: DB CryptoFileNameSubmission -- shouldn't be expensive due to caching
|
||||||
|
|
||||||
|
let
|
||||||
|
dbtIdent :: Text
|
||||||
|
dbtIdent = "files"
|
||||||
|
|
||||||
|
dbtSQLQuery = runReaderT $ do
|
||||||
|
original <- view queryOriginal
|
||||||
|
corrected <- view queryCorrected
|
||||||
|
|
||||||
|
lift . E.on $
|
||||||
|
original E.?. SubmissionFileTitle E.==. corrected E.?. SubmissionFileTitle
|
||||||
|
E.&&. original E.?. SubmissionFileSubmission E.==. corrected E.?. SubmissionFileSubmission
|
||||||
|
E.&&. original E.?. SubmissionFileId E.!=. corrected E.?. SubmissionFileId
|
||||||
|
E.&&. corrected E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
|
||||||
|
E.&&. E.val showCorrection -- Do not correlate files if we don't show correction; together with `may-access` this treats corrected files like they literally don't exist
|
||||||
|
|
||||||
|
lift . E.where_ $ original E.?. SubmissionFileSubmission E.==. E.val (Just smid)
|
||||||
|
E.||. corrected E.?. SubmissionFileSubmission E.==. E.val (Just smid)
|
||||||
|
|
||||||
|
lift . E.where_ . E.maybe E.true E.not_ $ original E.?. SubmissionFileIsUpdate -- @original@ is unset or not an update
|
||||||
|
lift . E.where_ . E.maybe E.true id $ corrected E.?. SubmissionFileIsUpdate -- @corrected@ is unset or an update
|
||||||
|
lift . E.where_ . E.maybe E.true E.not_ $ corrected E.?. SubmissionFileIsDeletion -- @corrected@ is unset or not a deletion
|
||||||
|
return (original, corrected)
|
||||||
|
dbtRowKey = (,) <$> views queryOriginal (E.?. SubmissionFileId) <*> views queryCorrected (E.?. SubmissionFileId)
|
||||||
|
|
||||||
|
dbtProj = dbtProjId
|
||||||
|
|
||||||
|
dbtColonnade = mconcat $ catMaybes
|
||||||
|
[ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \t -> let
|
||||||
|
mOrig = t ^? resultOriginal
|
||||||
|
mCorr = t ^? resultCorrected
|
||||||
|
fileTitle'' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
|
||||||
|
origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
|
||||||
|
corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
|
||||||
|
isFile' = origIsFile <|> corrIsFile
|
||||||
|
in maybeCell ((,) <$> fileTitle'' <*> isFile') $ \(fileTitle', isFile) -> if
|
||||||
|
| Just True <- origIsFile -> anchorCell (subDownloadLink SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
|
||||||
|
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
|
||||||
|
, guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \t -> case t ^? resultCorrected of
|
||||||
|
Nothing -> cell mempty
|
||||||
|
Just (Entity _ SubmissionFile{..}) -> tellCell (Any True) $ if
|
||||||
|
| isJust submissionFileContent -> anchorCell (subDownloadLink SubmissionCorrected submissionFileTitle) (i18n MsgFileCorrected :: Widget)
|
||||||
|
| otherwise -> i18nCell MsgCorrected
|
||||||
|
, Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \t -> let
|
||||||
|
mOrig = t ^? resultOriginal
|
||||||
|
mCorr = t ^? resultCorrected
|
||||||
|
origTime = submissionFileModified . entityVal <$> mOrig
|
||||||
|
corrTime = submissionFileModified . entityVal <$> mCorr
|
||||||
|
fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
||||||
|
in maybeCell fileTime dateTimeCell
|
||||||
|
]
|
||||||
|
where
|
||||||
|
subDownloadLink sft fileTitle' = CSubmissionR tid ssh csh shn cID $ SubDownloadR sft fileTitle'
|
||||||
|
|
||||||
|
dbtStyle = def
|
||||||
|
|
||||||
|
dbtSorting = mconcat
|
||||||
|
[ singletonMap "path" . SortColumn $ \r -> (E.unsafeSqlFunction "string_to_array" :: (E.SqlExpr (E.Value (Maybe String)), E.SqlExpr (E.Value String)) -> E.SqlExpr (E.Value [String])) (E.coalesce [views queryOriginal (E.?. SubmissionFileTitle) r, views queryCorrected (E.?. SubmissionFileTitle) r], E.val "/" :: E.SqlExpr (E.Value String))
|
||||||
|
, singletonMap "time" . SortColumn $ \r -> (E.unsafeSqlFunction "GREATEST" ([views queryOriginal (E.?. SubmissionFileModified) r, views queryCorrected (E.?. SubmissionFileModified) r] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
|
||||||
|
]
|
||||||
|
dbtFilter = mconcat
|
||||||
|
[ singletonMap "may-access" . FilterColumn $ \(Any b) r
|
||||||
|
-> E.val b E.==. (E.val showCorrection E.||. E.isJust (views queryOriginal (E.?. SubmissionFileId) r))
|
||||||
|
]
|
||||||
|
|
||||||
|
dbtFilterUI = mempty
|
||||||
|
|
||||||
|
dbtParams = def
|
||||||
|
|
||||||
|
dbtCsvEncode = noCsvEncode
|
||||||
|
dbtCsvDecode = Nothing
|
||||||
|
dbtExtraReps = []
|
||||||
|
|
||||||
|
archiveTableValidator = def
|
||||||
|
& defaultSorting [SortAscBy "path"]
|
||||||
|
& forceFilter "may-access" (Any True)
|
||||||
|
in over _1 getAny <$> dbTableWidget archiveTableValidator DBTable{..}
|
||||||
@ -453,7 +453,9 @@ extractRatingsMsg = do
|
|||||||
(Right $(widgetFile "messages/submissionFilesIgnored"))
|
(Right $(widgetFile "messages/submissionFilesIgnored"))
|
||||||
addMessageWidget Warning ignoredModal
|
addMessageWidget Warning ignoredModal
|
||||||
|
|
||||||
-- | Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
|
-- | Needs to *not* be called from within `runDB` so db transaction rollback can happen properly
|
||||||
|
--
|
||||||
|
-- Nontheless: we do assume elsewhere, that we can call `msgSubmissionErrors` from within `runDB` as long as we do `transactionUndo` iff it returns `Nothing`.
|
||||||
msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
|
msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
|
||||||
msgSubmissionErrors = flip catches
|
msgSubmissionErrors = flip catches
|
||||||
[ E.Handler $ \e -> Nothing <$ addMessageI Error (e :: SubmissionSinkException)
|
[ E.Handler $ \e -> Nothing <$ addMessageI Error (e :: SubmissionSinkException)
|
||||||
|
|||||||
Reference in New Issue
Block a user