diff --git a/ChangeLog.md b/ChangeLog.md
index fbe1b5009..240b51546 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,4 +1,11 @@
+ * Version 31.07.2018
+
+ Viele Verbesserung zur Anzeige von Korrekturen
+
+ Kursliste über alle Semester hinweg (Top-Level-Navigation "Kurse"), wird in Zukunft Filter/Suchfunktion erhalten
+
* Version 10.07.2018
+
Bugfixes, wählbares Format für Datum
* Version 04.07.2018
diff --git a/messages/de.msg b/messages/de.msg
index 8b271d82e..ae6d17cb8 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -5,6 +5,7 @@ BtnRegister: Anmelden
BtnDeregister: Abmelden
BtnHijack: Sitzung übernehmen
+Registered: Angemeldet
RegisterFrom: Anmeldungen von
RegisterTo: Anmeldungen bis
DeRegUntil: Abmeldungen bis
@@ -29,6 +30,7 @@ TermPlaceholder: W/S + vierstellige Jahreszahl
LectureStart: Beginn Vorlesungen
Course: Kurs
+CourseShort: Kürzel
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
CourseRegisterOk: Sie wurden angemeldet
CourseDeregisterOk: Sie wurden abgemeldet
@@ -40,6 +42,7 @@ CourseNewDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display ti
CourseEditDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
FFSheetName: Name
TermCourseListHeading tid@TermId: Kursübersicht #{display tid}
+CourseListTitle: Alle Kurse
TermCourseListTitle tid@TermId: Kurse #{display tid}
CourseNewHeading: Neuen Kurs anlegen
CourseEditHeading tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} editieren
@@ -190,6 +193,7 @@ NotPassed: Nicht bestanden
RatingTime: Korrigiert
RatingComment: Kommentar
SubmissionUsers: Studenten
+Rating: Korrektur
RatingPoints: Punkte
RatingFiles: Korrigierte Dateien
@@ -227,4 +231,4 @@ EditedBy name@Text time@Text: Durch #{name} um #{time}
LastEdit: Letzte Änderung
SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
-SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.
\ No newline at end of file
+SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.
diff --git a/src/Foundation.hs b/src/Foundation.hs
index b8f8fe169..131ed25bd 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -668,7 +668,7 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid)
breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR)
- breadcrumb CourseListR = return ("Kurs" , Just HomeR)
+ breadcrumb CourseListR = return ("Kurse" , Just HomeR)
breadcrumb CourseNewR = return ("Neu" , Just CourseListR)
breadcrumb (CourseR tid csh CShowR) = return (CI.original csh, Just $ TermCourseListR tid)
-- (CourseR tid csh CRegisterR) -- is POST only
@@ -744,7 +744,7 @@ defaultLinks = -- Define the menu items of the header.
, NavbarAside $ MenuItem
{ menuItemLabel = "Kurse"
, menuItemIcon = Just "calendar-alt"
- , menuItemRoute = TermCurrentR -- should be CourseListActiveR or similar in the future
+ , menuItemRoute = CourseListR
, menuItemAccessCallback' = return True
}
, NavbarAside $ MenuItem
@@ -964,7 +964,8 @@ pageHeading (TermEditExistR tid)
pageHeading (TermCourseListR tid)
= Just . i18nHeading . MsgTermCourseListHeading $ tid
--- CourseListR -- just a redirect to TermCurrentR
+pageHeading (CourseListR)
+ = Just $ i18nHeading $ MsgCourseListTitle
pageHeading CourseNewR
= Just $ i18nHeading MsgCourseNewHeading
pageHeading (CourseR tid csh CShowR)
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 3d2a61116..c2792c48d 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -85,19 +85,18 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse)
- $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> cell $
+ $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
- in [whamlet|#{display csh}|]
+ in anchorCell (CourseR tid csh CShowR) [whamlet|#{display csh}|]
colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
- $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> cell $
- let tid = course ^. _3
- csh = course ^. _2
- shn = sheetName $ entityVal sheet
- in [whamlet|#{display shn}|]
- -- textCell $ sheetName $ entityVal sheet
+ $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
+ let tid = course ^. _3
+ csh = course ^. _2
+ shn = sheetName $ entityVal sheet
+ in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|]
colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
@@ -106,12 +105,15 @@ colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
- $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> cell $ do
+ $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
shn = sheetName $ entityVal sheet
- cid <- encrypt (entityKey submission :: SubmissionId)
- [whamlet|#{display cid}|]
+ mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
+ mkRoute = do
+ cid <- mkCid
+ return $ CSubmissionR tid csh shn cid SubShowR
+ in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool)))
colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
@@ -121,6 +123,15 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName)
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
+colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
+ let tid = course ^. _3
+ csh = course ^. _2
+ -- shn = sheetName
+ mkRoute = do
+ cid <- encrypt subId
+ return $ CSubmissionR tid csh sheetName cid CorrectionR
+ in anchorCellM mkRoute $(widgetFile "widgets/rating")
type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
@@ -165,6 +176,9 @@ makeCorrectionsTable whereClause colChoices psValidator = do
, ( "corrector"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName
)
+ , ( "rating"
+ , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
+ )
]
, dbtFilter = [ ( "term"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if
@@ -317,6 +331,7 @@ postCorrectionsR = do
, colCourse
, colSheet
, colSubmissionLink
+ , colRating
] -- Continue here
psValidator = def
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
@@ -337,6 +352,7 @@ postCCorrectionsR tid csh = do
, colCorrector
, colSubmittors
, colSubmissionLink
+ , colRating
] -- Continue here
psValidator = def
correctionsR whereClause colonnade psValidator $ Map.fromList
@@ -355,6 +371,7 @@ postSSubsR tid csh shn = do
, colCorrector
, colSubmittors
, colSubmissionLink
+ , colRating
]
psValidator = def
correctionsR whereClause colonnade psValidator $ Map.fromList
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 38cfbe239..080e444ec 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -1,7 +1,11 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -18,6 +22,7 @@ import qualified Data.Text as T
import Data.Function ((&))
-- import Yesod.Form.Bootstrap3
+import qualified Data.Set as Set
import qualified Data.Map as Map
import Colonnade hiding (fromMaybe,bool)
@@ -28,8 +33,117 @@ import qualified Database.Esqueleto as E
import qualified Data.UUID.Cryptographic as UUID
-getCourseListR :: Handler TypedContent
-getCourseListR = redirect TermCurrentR
+type CourseTableData = DBRow (Entity Course, Int64, Bool)
+
+colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colCourse = sortable (Just "course") (i18nCell MsgCourse)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
+ anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|]
+
+colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
+ anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
+
+colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colTerm = sortable (Just "term") (i18nCell MsgTerm)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
+ anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|]
+
+colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
+ cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
+
+colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
+ cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
+
+colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _) } -> textCell $ case courseCapacity of
+ Nothing -> MsgCourseMembersCount currentParticipants
+ Just max -> MsgCourseMembersCountLimited currentParticipants max
+
+colRegistered :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
+ $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered) } -> tickmarkCell registered
+
+type CourseTableExpr = E.SqlExpr (Entity Course)
+
+course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64)
+course2Participants course = E.sub_select . E.from $ \courseParticipant -> do
+ E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+ return (E.countRows :: E.SqlExpr (E.Value Int64))
+
+course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
+course2Registered muid course = E.exists . E.from $ \courseParticipant -> do
+ E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+ E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
+
+makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
+ => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
+makeCourseTable whereClause colChoices psValidator = do
+ muid <- maybeAuthId
+ let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
+ dbtSQLQuery course = do
+ let participants = course2Participants course
+ let registered = course2Registered muid course
+ E.where_ $ whereClause (course, participants, registered)
+ return (course, participants, registered)
+ dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
+ dbtProj = traverse $ \(course, E.Value participants, E.Value registered) -> return (course, participants, registered)
+ dbTable psValidator $ DBTable
+ { dbtSQLQuery
+ , dbtColonnade = colChoices
+ , dbtProj
+ , dbtSorting = Map.fromList -- OverloadedLists does not work with the templates here
+ [ ( "course", SortColumn $ \course -> course E.^. CourseName)
+ , ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
+ , ( "term" , SortColumn $ \course -> course E.^. CourseTerm)
+ , ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom)
+ , ( "register-to", SortColumn $ \course -> course E.^. CourseRegisterTo)
+ , ( "participants", SortColumn $ course2Participants
+ )
+ , ( "registered", SortColumn $ course2Registered muid
+ )
+ ]
+ , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
+ [ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
+ | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
+ | otherwise -> course E.^. CourseName `E.in_` E.valList (Set.toList criterias)
+ )
+ , ( "cshort", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
+ | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
+ | otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList criterias)
+ )
+ , ( "term" , FilterColumn $ \(course :: CourseTableExpr) criterias -> if
+ | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
+ | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
+ )
+ ]
+ , dbtStyle = def
+ , dbtIdent = "courses" :: Text
+ }
+
+getCourseListR :: Handler Html
+getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
+ muid <- maybeAuthId
+ let colonnade = widgetColonnade $ mconcat
+ [ colCourse
+ , colCShort
+ , colTerm
+ , maybe mempty (const colRegistered) muid
+ ]
+ whereClause = const $ E.val True
+ validator = def
+ & defaultSorting [("course", SortAsc), ("term", SortDesc)]
+ coursesTable <- makeCourseTable whereClause colonnade validator
+ defaultLayout $ do
+ setTitleI MsgCourseListTitle
+ [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
+ $(widgetFile "courses")
getTermCurrentR :: Handler Html
getTermCurrentR = do
@@ -37,59 +151,24 @@ getTermCurrentR = do
case fromNullable termIds of
Nothing -> notFound
(Just (maximum -> tid)) -> -- getTermCourseListR tid
- redirect $ TermCourseListR tid -- redirect avids problematic breadcrumbs, headings, etc.
-
+ redirect $ TermCourseListR tid -- redirect avoids problematic breadcrumbs, headings, etc.
getTermCourseListR :: TermId -> Handler Html
getTermCourseListR tid = do
void . runDB $ get404 tid -- Just ensure the term exists
-
- let
- tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64))
- tableData course = do
- E.where_ $ course E.^. CourseTerm E.==. E.val tid
- let
- participants = E.sub_select . E.from $ \courseParticipant -> do
- E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
- return (E.countRows :: E.SqlExpr (E.Value Int64))
- return (course, participants)
- psValidator = def
- & defaultSorting [("shorthand", SortAsc)]
-
- coursesTable <- dbTable psValidator $ DBTable
- { dbtSQLQuery = tableData
- , dbtColonnade = widgetColonnade $ mconcat
- [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell'
- (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR)
- (\(Entity _ Course{..}, _) -> toWidget courseShorthand)
- , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
- , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
- , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
- Nothing -> MsgCourseMembersCount num
- Just max -> MsgCourseMembersCountLimited num max
+ muid <- maybeAuthId
+ let colonnade = widgetColonnade $ mconcat
+ [ dbRow
+ , colCShort
+ , colRegFrom
+ , colRegTo
+ , colParticipants
+ , maybe mempty (const colRegistered) muid
]
- , dbtProj = return . dbrOutput
- , dbtSorting = Map.fromList
- [ ( "shorthand"
- , SortColumn $ \course -> course E.^. CourseShorthand
- )
- , ( "register-from"
- , SortColumn $ \course -> course E.^. CourseRegisterFrom
- )
- , ( "register-to"
- , SortColumn $ \course -> course E.^. CourseRegisterTo
- )
- , ( "members"
- , SortColumn $ \course -> E.sub_select . E.from $ \courseParticipant -> do
- E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
- return (E.countRows :: E.SqlExpr (E.Value Int64))
- )
- ]
- , dbtFilter = mempty
- , dbtStyle = def
- , dbtIdent = "courses" :: Text
- }
-
+ whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
+ validator = def
+ & defaultSorting [("cshort", SortAsc)]
+ coursesTable <- makeCourseTable whereClause colonnade validator
defaultLayout $ do
setTitleI . MsgTermCourseListTitle $ tid
$(widgetFile "courses")
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 64cc2a6b2..8319760f2 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -156,49 +156,74 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
getSheetListR :: TermId -> CourseShorthand -> Handler Html
getSheetListR tid csh = do
+ muid <- maybeAuthId
Entity cid _ <- runDB . getBy404 $ CourseTermShort tid csh
let
- sheetData :: E.SqlExpr (E.Entity Sheet) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)))
- sheetData sheet = do
+ sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission)))
+ sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do
+ E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
+ E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
+ E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
let sheetEdit = E.sub_select . E.from $ \sheetEdit -> do
E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
return . E.max_ $ sheetEdit E.^. SheetEditTime
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
- return (sheet, sheetEdit)
+ return (sheet, sheetEdit, submission)
sheetCol = widgetColonnade . mconcat $
[ sortable (Just "name") (i18nCell MsgSheet)
- $ \(Entity _ Sheet{..}, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName)
+ $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName)
, sortable (Just "last-edit") (i18nCell MsgLastEdit)
- $ \(_, E.Value mEditTime) -> case mEditTime of
- Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
- Nothing -> mempty
+ $ \(_, E.Value mEditTime, _) -> case mEditTime of
+ Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
+ Nothing -> mempty
, sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
- $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget
+ $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget
, sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
- $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
+ $ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
, sortable Nothing (i18nCell MsgSheetType)
- $ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType
+ $ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType
+ , sortable Nothing (i18nCell MsgSubmission)
+ $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+ Nothing -> mempty
+ (Just (Entity sid Submission{..})) ->
+ let mkCid = encrypt sid -- TODO: executed twice
+ mkRoute = do
+ cid <- mkCid
+ return $ CSubmissionR tid csh sheetName cid SubShowR
+ in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
+ , sortable (Just "rating") (i18nCell MsgRating)
+ $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+ Nothing -> mempty
+ (Just (Entity sid Submission{..})) ->
+ let mkCid = encrypt sid
+ mkRoute = do
+ cid <- mkCid
+ return $ CSubmissionR tid csh sheetName cid CorrectionR
+ in anchorCellM mkRoute $(widgetFile "widgets/rating")
]
psValidator = def
& defaultSorting [("submission-since", SortAsc)]
table <- dbTable psValidator $ DBTable
{ dbtSQLQuery = sheetData
, dbtColonnade = sheetCol
- , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _) }
+ , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False)
, dbtSorting = Map.fromList
[ ( "name"
- , SortColumn $ \sheet -> sheet E.^. SheetName
+ , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
)
, ( "last-edit"
- , SortColumn $ \sheet -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
+ , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
return $ sheetEdit E.?. SheetEditTime
)
, ( "submission-since"
- , SortColumn $ \sheet -> sheet E.^. SheetActiveFrom
+ , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom
)
, ( "submission-until"
- , SortColumn $ \sheet -> sheet E.^. SheetActiveTo
+ , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
+ )
+ , ( "rating"
+ , SortColumn $ \(_ `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> submission E.?. SubmissionRatingPoints
)
]
, dbtFilter = Map.fromList
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index a7bda4a73..cc2b06fe6 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -34,6 +34,7 @@ module Handler.Utils.Table.Pagination
, widgetColonnade, formColonnade, dbColonnade
, cell, textCell, stringCell, i18nCell
, anchorCell, anchorCell', anchorCellM
+ , tickmarkCell
, listCell
, formCell, DBFormResult, getDBFormResult
, dbRow, dbSelect
@@ -472,6 +473,11 @@ stringCell = textCell
i18nCell = textCell
textCell msg = cell [whamlet|_{msg}|]
+tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
+tickmarkCell True = textCell (tickmark :: Text)
+tickmarkCell False = mempty
+
+
anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
anchorCell = anchorCellM . return
diff --git a/templates/widgets/rating.hamlet b/templates/widgets/rating.hamlet
new file mode 100644
index 000000000..f1c321bfd
--- /dev/null
+++ b/templates/widgets/rating.hamlet
@@ -0,0 +1,16 @@
+$# Display Rating, expects
+$# submissionRatingPoints :: Maybe points
+
+$maybe points <- submissionRatingPoints
+ $case sheetType
+ $of Bonus{..}
+ _{MsgAchievedOf points maxPoints}
+ $of Normal{..}
+ _{MsgAchievedOf points maxPoints}
+ $of Pass{..}
+ $if points >= passingPoints
+ _{MsgPassed}
+ $else
+ _{MsgNotPassed}
+ $of NotGraded
+ #{show tickmark}