Discuss: Convenience.submissionCell
This commit is contained in:
SJost
parent
3523549d0e
commit
ee8990f244
@ -128,6 +128,7 @@ SubmissionFile: Datei zur Abgabe
|
||||
SubmissionFiles: Abgegebene Dateien
|
||||
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
|
||||
SubmissionEditUser: Ihre letzte Bearbeitung
|
||||
SubmissionNoEditUser: Nicht von Ihnen bearbeitet
|
||||
|
||||
CorrectionsTitle: Zugewiesene Korrekturen
|
||||
CourseCorrectionsTitle: Korrekturen für diesen Kurs
|
||||
@ -239,7 +240,9 @@ RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist
|
||||
FileTitle: Dateiname
|
||||
FileModified: Letzte Änderung
|
||||
|
||||
FileCorrected: Korrigiert
|
||||
|
||||
Corrected: Korrigiert
|
||||
FileCorrected: Korrigiert (Dateien)
|
||||
FileCorrectedDeleted: Korrigiert (gelöscht)
|
||||
RatingUpdated: Korrektur gespeichert
|
||||
RatingDeleted: Korrektur zurückgesetzt
|
||||
|
||||
@ -270,9 +270,8 @@ getCShowR tid ssh csh = do
|
||||
<*> count [CourseParticipantCourse ==. cid] -- join
|
||||
<*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
|
||||
Nothing -> return False
|
||||
(Just aid) -> do
|
||||
regL <- getBy (UniqueParticipant aid cid)
|
||||
return $ isJust regL)
|
||||
(Just aid) -> do regL <- getBy (UniqueParticipant aid cid)
|
||||
return $ isJust regL)
|
||||
lecturers <- E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||
|
||||
@ -317,7 +317,7 @@ getProfileDataR = do
|
||||
link= CSheetR tid ssh csh shn SShowR
|
||||
return $ anchorCell link $ display2widget shn
|
||||
|
||||
, sortable (toNothing "submission") (i18nCell MsgSubmission) $ do
|
||||
, sortable (toNothing "submission") (i18nCell MsgSubmission) $ do -- TODO: use submissionCell?!
|
||||
shn <- view $ _dbrOutput . _2 . _unValue
|
||||
sid <- view $ _dbrOutput . _3 . _entityKey
|
||||
crse <- view $ _dbrOutput . _1
|
||||
@ -325,10 +325,8 @@ getProfileDataR = do
|
||||
ssh = crse ^. _2 . _unValue
|
||||
csh = crse ^. _4 . _unValue
|
||||
mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice
|
||||
mkRoute = do
|
||||
cid <- mkCid
|
||||
return $ CSubmissionR tid ssh csh shn cid SubShowR
|
||||
return $ anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
|
||||
mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
|
||||
return $ anchorCellM' mkCid mkRoute display2widget
|
||||
, sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
|
||||
regTime <- view $ _dbrOutput . _4 . _unValue
|
||||
return $ maybe mempty timeCell regTime
|
||||
|
||||
@ -23,6 +23,7 @@ import Import hiding (joinPath)
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Convenience
|
||||
|
||||
import Network.Mime
|
||||
|
||||
@ -107,7 +108,7 @@ submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Submis
|
||||
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
uid <- requireAuthId
|
||||
msmid <- traverse decrypt mcid
|
||||
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
||||
(Entity shid Sheet{..}, buddies, lastEdits, lastEditsUser) <- runDB $ do
|
||||
sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
|
||||
case msmid of
|
||||
Nothing -> do
|
||||
@ -135,7 +136,7 @@ submissionHelper tid ssh 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
|
||||
@ -159,7 +160,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
E.limit numberOfSubmissionEditDates
|
||||
return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
|
||||
lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||
return (sheet,buddies,lastEdits)
|
||||
lastEditUserValues <- E.select . E.from $ \(submissionEdit) -> do
|
||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||
E.&&. submissionEdit E.^. SubmissionEditUser E.==. E.val uid
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
E.limit numberOfSubmissionEditDates
|
||||
return $ submissionEdit E.^. SubmissionEditTime
|
||||
lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time
|
||||
return (sheet,buddies,lastEdits,lastEditsUser)
|
||||
let unpackZips = True -- undefined -- TODO
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
|
||||
mCID <- runDB $ do
|
||||
@ -257,17 +265,17 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
| Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
|
||||
([whamlet|#{fileTitle'}|])
|
||||
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
|
||||
, sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
|
||||
, sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
|
||||
Nothing -> cell mempty
|
||||
Just (_, Entity _ File{..})
|
||||
| isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
|
||||
([whamlet|_{MsgFileCorrected}|])
|
||||
| otherwise -> textCell MsgFileCorrected
|
||||
| otherwise -> textCell MsgCorrected
|
||||
, sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||
origTime = fileModified . entityVal . snd <$> mOrig
|
||||
corrTime = fileModified . entityVal . snd <$> mCorr
|
||||
Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
||||
in textCell $ display fileTime
|
||||
in timeCell fileTime
|
||||
]
|
||||
coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File))
|
||||
coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md)
|
||||
|
||||
@ -68,6 +68,23 @@ courseCell (Course {..}) = anchorCell link name `mappend` desc
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
|
||||
|
||||
sheetCell :: IsDBTable m a => (CourseLink', E.Value SheetName) -> DBCell m a
|
||||
sheetCell (crse, E.Value shn) =
|
||||
let tid = crse ^. _1 . _unValue
|
||||
ssh = crse ^. _2 . _unValue
|
||||
csh = crse ^. _4 . _unValue
|
||||
link= CSheetR tid ssh csh shn SShowR
|
||||
in anchorCell link $ display2widget shn
|
||||
|
||||
submissionCell :: IsDBTable m a => (CourseLink', E.Value SheetName, SubmissionId) -> DBCell m a
|
||||
submissionCell (crse, E.Value shn, sid) =
|
||||
let tid = crse ^. _1 . _unValue
|
||||
ssh = crse ^. _2 . _unValue
|
||||
csh = crse ^. _4 . _unValue
|
||||
mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice -- FIXED!
|
||||
mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
|
||||
mkText cid = display2widget cid
|
||||
in anchorCellM' mkCid mkRoute mkText
|
||||
|
||||
|
||||
-- Generic Columns
|
||||
|
||||
@ -34,7 +34,7 @@ module Handler.Utils.Table.Pagination
|
||||
, dbTableWidget, dbTableWidget'
|
||||
, widgetColonnade, formColonnade, dbColonnade
|
||||
, cell, textCell, stringCell, i18nCell
|
||||
, anchorCell, anchorCell', anchorCellM
|
||||
, anchorCell, anchorCell', anchorCellM, anchorCellM'
|
||||
, tickmarkCell
|
||||
, listCell
|
||||
, formCell, DBFormResult, getDBFormResult
|
||||
@ -505,13 +505,18 @@ anchorCell' :: IsDBTable m a
|
||||
anchorCell' mkRoute mkWidget val = anchorCell (mkRoute val) (mkWidget val)
|
||||
|
||||
anchorCellM :: IsDBTable m a => (WidgetT UniWorX IO (Route UniWorX)) -> Widget -> DBCell m a
|
||||
anchorCellM routeM widget = cell $ do
|
||||
route <- routeM
|
||||
authResult <- liftHandlerT $ isAuthorized route False
|
||||
anchorCellM routeM widget = anchorCellM' routeM id (const widget)
|
||||
|
||||
anchorCellM' :: IsDBTable m a => (WidgetT UniWorX IO x) -> (x -> Route UniWorX) -> (x -> Widget) -> DBCell m a
|
||||
anchorCellM' xM x2route x2widget = cell $ do
|
||||
x <- xM
|
||||
let route = x2route x
|
||||
widget = x2widget x
|
||||
authResult <- liftHandlerT $ isAuthorized route False
|
||||
case authResult of
|
||||
Authorized -> $(widgetFile "table/cell/link") -- show allowed link
|
||||
_otherwise -> widget -- don't show prohibited link
|
||||
|
||||
if
|
||||
| Authorized <- authResult -> $(widgetFile "table/cell/link")
|
||||
| otherwise -> widget
|
||||
|
||||
listCell :: (IsDBTable m a, Traversable f) => f r' -> (r' -> DBCell m a) -> DBCell m a
|
||||
listCell xs mkCell = review dbCell . ([], ) $ do
|
||||
|
||||
@ -8,6 +8,14 @@ $maybe cID <- mcid
|
||||
<ul>
|
||||
$forall (name,time) <- lastEdits
|
||||
<li>_{MsgEditedBy name time}
|
||||
|
||||
_{MsgSubmissionEditUser}: #
|
||||
$if null lastEditsUser
|
||||
_{MsgSubmissionNoEditUser}
|
||||
$else
|
||||
$forall time <- lastEditsUser
|
||||
#{display time}
|
||||
|
||||
$maybe fileTable <- mFileTable
|
||||
<h3>_{MsgSubmissionFiles}
|
||||
^{fileTable}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user