Sorting Corrections and UniWorXMessages Monoid

src/Foundation.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- MonadCrypto
 
 module Foundation where
@@ -222,6 +223,12 @@ instance RenderMessage UniWorX SheetType where
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
 
+newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
+  deriving (Generic, Typeable)
+  deriving newtype (Semigroup, Monoid, IsList)
+
+instance RenderMessage UniWorX UniWorXMessages where
+  renderMessage foundation ls (UniWorXMessages msgs) = foldMap (renderMessage foundation ls) msgs
 
 -- Menus and Favourites
 data MenuType = NavbarAside | NavbarRight | NavbarSecondary | PageActionPrime | PageActionSecondary

src/Handler/Corrections.hs

@@ -128,7 +128,7 @@ colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult
 colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
 
 colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
-colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
   csh = course ^. _2
   tid = course ^. _3
   ssh = course ^. _4
@@ -209,7 +209,7 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
           E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
           E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
-          E.orderBy [E.asc $ user E.^. UserId]
+          E.orderBy [E.asc $ user E.^. UserDisplayName]
           return (user, pseudonym E.?. SheetPseudonymPseudonym)
         let
           submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
@@ -240,6 +240,16 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
       , ( "assignedtime"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
         )
+      , ( "submittors"
+        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
+            E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+              E.orderBy [E.asc $ user E.^. UserDisplayName]
+              E.limit 1
+              return (user E.^. UserDisplayName)
+
+        )
       ]
     , dbtFilter    = Map.fromList
       [ ( "term"

src/Handler/Sheet.hs

@@ -152,19 +152,19 @@ getSheetListR tid ssh csh = do
       E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
       return (sheet, lastSheetEdit sheet, submission)
     sheetCol = widgetColonnade . mconcat $
-      [ -- TODO: dbRow add numbers
+      [ dbRow
-        sortable (Just "name") (i18nCell MsgSheet)
+      , sortable (Just "name") (i18nCell MsgSheet)
-          $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
       , sortable (Just "last-edit") (i18nCell MsgLastEdit)
-          $ \(_, E.Value mEditTime, _) -> maybe mempty timeCell mEditTime
+          $ \DBRow{dbrOutput=(_, E.Value mEditTime, _)} -> maybe mempty timeCell mEditTime
       , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveFrom
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveFrom
       , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveTo
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveTo
       , sortable Nothing (i18nCell MsgSheetType)
-          $ \(Entity _ Sheet{..}, _, _) -> i18nCell sheetType
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> i18nCell sheetType
       , sortable Nothing (i18nCell MsgSubmission)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
               Nothing -> mempty
               (Just (Entity sid Submission{..})) ->
                 let mkCid = encrypt sid -- TODO: executed twice
@@ -173,7 +173,7 @@ getSheetListR tid ssh csh = do
                       return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                 in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{display cid2}|])
       , sortable (Just "rating") (i18nCell MsgRating)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
               Nothing -> mempty
               (Just (Entity sid Submission{..})) ->
                 let mkCid = encrypt sid
@@ -183,7 +183,7 @@ getSheetListR tid ssh csh = do
                 in anchorCellM mkRoute $(widgetFile "widgets/rating")
       , sortable Nothing -- (Just "percent")
                         (i18nCell MsgRatingPercent)
-          $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType}, _, mbSub)} -> case mbSub of
               (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
@@ -198,8 +198,8 @@ getSheetListR tid ssh csh = do
   table <- runDB $ dbTableWidget' psValidator DBTable
     { dbtSQLQuery  = sheetData
     , dbtColonnade = sheetCol
-    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
+    , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) }
-                   -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
+                   -> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
     , dbtSorting   = Map.fromList
       [ ( "name"
         , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName

src/Handler/Utils/Rating.hs

@@ -219,7 +219,7 @@ addBonusToPoints sts =
     maxBonusPass = fmap $ min maxPasses
     addBonusPass = maybeAdd bonusPasses
 
-gradeSummaryWidget ::  (Int -> UniWorXMessage) -> SheetTypeSummary -> Widget
+gradeSummaryWidget ::  RenderMessage UniWorX msg => (Int -> msg) -> SheetTypeSummary -> Widget
 gradeSummaryWidget title sts =
   let SheetTypeSummary{..} = addBonusToPoints sts
       sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)

src/Import/NoFoundation.hs

@@ -35,10 +35,12 @@ import Mail                   as Import
 import Data.Data              as Import (Data)
 import Data.Typeable          as Import (Typeable)
 import GHC.Generics           as Import (Generic)
+import GHC.Exts               as Import (IsList)
 
 import Data.Hashable          as Import
 import Data.List.NonEmpty     as Import (NonEmpty(..))
 import Data.Text.Encoding.Error    as Import(UnicodeException(..))
+import Data.Semigroup         as Import (Semigroup)
 
 import Control.Monad.Morph    as Import (MFunctor(..))
 

templates/standalone/alerts.julius

@@ -29,7 +29,7 @@
       var iconEl = document.createElement('DIV');
       var closeEl = document.createElement('DIV');
       var dataDecay = alertEl.dataset.decay;
-      var autoDecay = 30;
+      var autoDecay = 10;
       if (dataDecay) {
         autoDecay = parseInt(dataDecay, 10);
       }