From 17ea26430f655291239ad492aeb125f7739498d1 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 5 Dec 2018 11:41:25 +0100 Subject: [PATCH] Sorting Corrections and UniWorXMessages Monoid --- src/Foundation.hs | 7 +++++++ src/Handler/Corrections.hs | 14 ++++++++++++-- src/Handler/Sheet.hs | 24 ++++++++++++------------ src/Handler/Utils/Rating.hs | 2 +- src/Import/NoFoundation.hs | 2 ++ templates/standalone/alerts.julius | 2 +- 6 files changed, 35 insertions(+), 16 deletions(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index c443a3c01..2dec96886 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 7455f2311..649bb4078 100644 --- a/src/Handler/Corrections.hs +++ b/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" diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 523a7d297..c88371762 100644 --- a/src/Handler/Sheet.hs +++ b/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 - sortable (Just "name") (i18nCell MsgSheet) - $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName) + [ dbRow + , sortable (Just "name") (i18nCell MsgSheet) + $ \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{..}, _, _) } - -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False) + , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) } + -> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False) , dbtSorting = Map.fromList [ ( "name" , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index d5f6f8006..11cb411e8 100644 --- a/src/Handler/Utils/Rating.hs +++ b/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) diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 94c8ffbd2..568cabfd2 100644 --- a/src/Import/NoFoundation.hs +++ b/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(..)) diff --git a/templates/standalone/alerts.julius b/templates/standalone/alerts.julius index f993cdfbc..632661eb5 100644 --- a/templates/standalone/alerts.julius +++ b/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); }