feat(eoexamsr): implement label sorting
This commit is contained in:
Sarah Vaupel
parent
12c79612b7
commit
808c2fc770
@ -22,6 +22,7 @@ TableExamName !ident-ok: Name
|
||||
TableExamTime: Termin
|
||||
TableExamRegistration: Prüfungsanmeldung
|
||||
TableExamResult: Prüfungsergebnis
|
||||
TableExamLabel !ident-ok: Label
|
||||
TableSheet: Blatt
|
||||
TableLastEdit: Letzte Änderung
|
||||
TableSubmission: Abgabenummer
|
||||
|
||||
@ -22,6 +22,7 @@ TableExamName: Name
|
||||
TableExamTime: Time
|
||||
TableExamRegistration: Exam registration
|
||||
TableExamResult: Exam result
|
||||
TableExamLabel: Label
|
||||
TableSheet: Sheet
|
||||
TableLastEdit: Latest edit
|
||||
TableSubmission: Submission-number
|
||||
|
||||
@ -99,6 +99,9 @@ resultSchool = _dbrOutput . _1 . _Right . _3
|
||||
resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
|
||||
resultExternalExam = _dbrOutput . _1 . _Left . _1
|
||||
|
||||
resultLabel :: Traversal' ExamsTableData (Maybe (Entity ExamOfficeLabel))
|
||||
resultLabel = _dbrOutput . _1 . choosing _2 _4
|
||||
|
||||
resultSynchronised, resultResults :: Lens' ExamsTableData (Maybe Natural)
|
||||
resultSynchronised = _dbrOutput . _2
|
||||
resultResults = _dbrOutput . _3
|
||||
@ -169,18 +172,6 @@ getEOExamsR = do
|
||||
return (exam, course, school, mLabelExam, externalExam, mLabelExternalExam)
|
||||
dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))
|
||||
|
||||
-- [ singletonMap "may-access" . FilterProjected $ \(Any b) r -> (== b) <$> if
|
||||
-- | Just exam <- r ^? resultExam . _entityVal
|
||||
-- , Just course <- r ^? resultCourse . _entityVal
|
||||
-- -> hasReadAccessTo . urlRoute $ examLink course exam
|
||||
-- | Just eexam <- r ^? resultExternalExam . _entityVal
|
||||
-- -> hasReadAccessTo . urlRoute $ externalExamLink eexam :: DB Bool
|
||||
-- | otherwise
|
||||
-- -> return $ error "Got neither exam nor externalExam in result"
|
||||
-- , singletonMap "has-results" . FilterProjected $ \(Any b) r -> (return $ b == (r ^. resultResults > 0) :: DB Bool)
|
||||
-- , singletonMap "is-synced" . FilterProjected $ \(Any b) r -> (return $ b == (r ^. resultSynchronised >= r ^. resultResults) :: DB Bool)
|
||||
-- ]
|
||||
|
||||
dbtProj :: _ ExamsTableData
|
||||
dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do -- dbtProjSimple . runReaderT $ do
|
||||
exam <- view $ _dbtProjRow . _dbrOutput . _1
|
||||
@ -231,6 +222,19 @@ getEOExamsR = do
|
||||
_other -> return $ error "Got exam & externalExam in same result"
|
||||
|
||||
|
||||
colLabel = Colonnade.singleton (fromSortable . Sortable (Just "label") $ i18nCell MsgTableExamLabel) $ \x -> flip runReader x $ do
|
||||
mLabel <- preview resultLabel
|
||||
|
||||
-- TODO: implement and use select widget for setting label
|
||||
if
|
||||
| Just (Just (Entity _ ExamOfficeLabel{..})) <- mLabel
|
||||
-> return $ cell
|
||||
[whamlet|
|
||||
$newline never
|
||||
#{examOfficeLabelName}
|
||||
|]
|
||||
| otherwise -> return $ cell mempty
|
||||
|
||||
colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
|
||||
mExam <- preview resultExam
|
||||
mSchool <- preview resultSchool
|
||||
@ -264,7 +268,8 @@ getEOExamsR = do
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ bool mempty colSynced getSynced
|
||||
[ bool mempty colLabel getLabels
|
||||
, bool mempty colSynced getSynced
|
||||
, maybeAnchorColonnade ( runMaybeT $ mpreview ($(multifocusG 2) (pre $ resultCourse . _entityVal) (pre $ resultExam . _entityVal) . to (uncurry $ liftA2 examLink) . _Just)
|
||||
<|> mpreviews (resultExternalExam . _entityVal) externalExamLink
|
||||
)
|
||||
@ -278,6 +283,12 @@ getEOExamsR = do
|
||||
, emptyOpticColonnade (resultCourse . _entityVal . _courseTerm <> resultExternalExam . _entityVal . _externalExamTerm) colTermShort
|
||||
]
|
||||
dbtSorting = mconcat $
|
||||
(bool mempty
|
||||
[ singletonMap "label-prio" $
|
||||
SortProjected . comparing $ (fmap . fmap $ examOfficeLabelPriority . entityVal) <$> preview resultLabel
|
||||
, singletonMap "label-status" $
|
||||
SortProjected . comparing $ (fmap . fmap $ examOfficeLabelStatus . entityVal) <$> preview resultLabel
|
||||
] getLabels) <>
|
||||
(bool mempty
|
||||
[ singletonMap "synced" $
|
||||
SortProjected . comparing $ ((/) `on` toRational . fromMaybe 0) <$> view resultSynchronised <*> view resultResults
|
||||
@ -293,6 +304,7 @@ getEOExamsR = do
|
||||
, sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
|
||||
]
|
||||
|
||||
-- TODO: implement label filters: prio, status, name
|
||||
dbtFilter = mconcat $
|
||||
[ singletonMap "may-access" . FilterProjected $ (_etProjFilterMayAccess ?~) . getAny
|
||||
, singletonMap "has-results" . FilterProjected $ (_etProjFilterHasResults ?~) . getAny
|
||||
@ -316,7 +328,7 @@ getEOExamsR = do
|
||||
dbtExtraReps = []
|
||||
|
||||
examsDBTableValidator = def
|
||||
& defaultSorting (bool mempty [SortAscBy "is-synced"] getSynced <> [SortAscBy "exam-time"])
|
||||
& defaultSorting (bool mempty [SortDescBy "label-prio", SortAscBy "label-status"] getLabels <> bool mempty [SortAscBy "is-synced"] getSynced <> [SortAscBy "exam-time"])
|
||||
& forceFilter "may-access" (Any True)
|
||||
& forceFilter "has-results" (Any True)
|
||||
|
||||
|
||||
@ -248,6 +248,15 @@ colExamFinishedOffice resultFinished = Colonnade.singleton (fromSortable header)
|
||||
sortExamFinished :: OpticSortColumn (Maybe UTCTime)
|
||||
sortExamFinished queryFinished = singletonMap "exam-finished" . SortColumn $ view queryFinished
|
||||
|
||||
colExamLabel :: OpticColonnade (Maybe ExamOfficeLabelName)
|
||||
colExamLabel resultLabel = Colonnade.singleton (fromSortable header) body
|
||||
where
|
||||
header = Sortable (Just "exam-label") (i18nCell MsgTableExamLabel)
|
||||
body = views resultLabel $ maybe mempty i18nCell
|
||||
|
||||
sortExamLabel :: OpticSortColumn (Maybe ExamOfficeLabelName)
|
||||
sortExamLabel queryLabel = singletonMap "exam-label" . SortColumn $ view queryLabel
|
||||
|
||||
---------------------
|
||||
-- Exam occurences --
|
||||
---------------------
|
||||
|
||||
@ -215,6 +215,8 @@ makeLenses_ ''UTCTime
|
||||
makeLenses_ ''Exam
|
||||
makeLenses_ ''ExamOccurrence
|
||||
|
||||
makeLenses_ ''ExamOfficeLabel
|
||||
|
||||
makePrisms ''AuthenticationMode
|
||||
|
||||
makeLenses_ ''CourseUserNote
|
||||
|
||||
Reference in New Issue
Block a user