Discuss: Convenience.submissionCell

messages/uniworx/de.msg

@@ -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

src/Handler/Course.hs

@@ -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
+                (Just aid) -> do  regL <- getBy (UniqueParticipant aid cid)
-                                regL <- getBy (UniqueParticipant aid cid)
+                                  return $ isJust regL)
-                                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

src/Handler/Profile.hs

@@ -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
+                  mkRoute cid = CSubmissionR tid ssh csh shn cid SubShowR
-                    cid <- mkCid
+              return $ anchorCellM' mkCid mkRoute display2widget
-                    return $ CSubmissionR tid ssh csh shn cid SubShowR
-              return $ anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
           , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
               regTime <- view $ _dbrOutput . _4 . _unValue
               return $ maybe mempty timeCell regTime

src/Handler/Submission.hs

@@ -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)

src/Handler/Utils/Table/Convenience.hs

@@ -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

src/Handler/Utils/Table/Pagination.hs

@@ -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
+anchorCellM routeM widget = anchorCellM' routeM id (const widget)
-  route <- routeM
+
-  authResult <- liftHandlerT $ isAuthorized route False
+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

templates/submission.hamlet

@@ -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}