feat(eoexamsr): introduce GET param to control synced display

This commit is contained in:
Sarah Vaupel 2021-11-25 22:19:16 +01:00
parent d4aefed687
commit 09261ac757

View File

@ -19,22 +19,22 @@ import qualified Data.Conduit.Combinators as C
data ExamsTableFilterProj = ExamsTableFilterProj
{ etProjFilterMayAccess :: Maybe Bool
{ etProjFilterMayAccess :: Maybe Bool
, etProjFilterHasResults :: Maybe Bool
, etProjFilterIsSynced :: Maybe Bool
, etProjFilterIsSynced :: Maybe Bool
}
instance Default ExamsTableFilterProj where
def = ExamsTableFilterProj
{ etProjFilterMayAccess = Nothing
{ etProjFilterMayAccess = Nothing
, etProjFilterHasResults = Nothing
, etProjFilterIsSynced = Nothing
, etProjFilterIsSynced = Nothing
}
makeLenses_ ''ExamsTableFilterProj
type ExamsTableExpr = ( E.SqlExpr (Maybe (Entity Exam))
type ExamsTableExpr = ( E.SqlExpr (Maybe (Entity Exam ))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
`E.InnerJoin` E.SqlExpr (Maybe (Entity School))
)
@ -84,6 +84,12 @@ getEOExamsR = do
uid <- requireAuthId
now <- liftIO getCurrentTime
getSynced <- lookupGetParam "synced" >>= \case
Just "yes" -> return True
Just "no" -> return False
_ -> return True -- TODO: lookup user setting
-- TODO: lookup GET param and user setting for getLabels
examsTable <- runDB $ do
let
examLink :: Course -> Exam -> SomeRoute UniWorX
@ -203,7 +209,7 @@ getEOExamsR = do
dbtColonnade :: Colonnade Sortable _ _
dbtColonnade = mconcat
[ colSynced
[ bool mempty colSynced getSynced
, maybeAnchorColonnade ( runMaybeT $ mpreview ($(multifocusG 2) (pre $ resultCourse . _entityVal) (pre $ resultExam . _entityVal) . to (uncurry $ liftA2 examLink) . _Just)
<|> mpreviews (resultExternalExam . _entityVal) externalExamLink
)
@ -216,12 +222,14 @@ getEOExamsR = do
, emptyOpticColonnade (resultCourse . _entityVal . _courseSchool <> resultExternalExam . _entityVal . _externalExamSchool) colSchool
, emptyOpticColonnade (resultCourse . _entityVal . _courseTerm <> resultExternalExam . _entityVal . _externalExamTerm) colTermShort
]
dbtSorting = mconcat
dbtSorting = mconcat $
(bool mempty
[ singletonMap "synced" $
SortProjected . comparing $ ((/) `on` toRational) <$> view resultSynchronised <*> view resultResults
, singletonMap "is-synced" $
SortProjected . comparing $ (>=) <$> view resultSynchronised <*> view resultResults
, sortExamName (to $ E.unsafeCoalesce . sequence [views queryExam (E.?. ExamName), views queryExternalExam (E.?. ExternalExamExamName)])
] getSynced) <>
[ sortExamName (to $ E.unsafeCoalesce . sequence [views queryExam (E.?. ExamName), views queryExternalExam (E.?. ExternalExamExamName)])
, sortExamTime (queryExam . $(multifocusG 2) (to $ E.joinV . (E.?. ExamStart)) (to $ E.joinV . (E.?. ExamEnd)))
, sortExamFinished (queryExam . to (E.joinV . (E.?. ExamFinished)))
, sortExamClosed (queryExam . to (E.joinV . (E.?. ExamClosed)))
@ -230,14 +238,16 @@ getEOExamsR = do
, sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
]
dbtFilter = mconcat
dbtFilter = mconcat $
[ singletonMap "may-access" . FilterProjected $ (_etProjFilterMayAccess ?~) . getAny
, singletonMap "has-results" . FilterProjected $ (_etProjFilterHasResults ?~) . getAny
, singletonMap "is-synced" . FilterProjected $ (_etProjFilterIsSynced ?~) . getAny
]
dbtFilterUI = mconcat
] <> (bool mempty
[ singletonMap "is-synced" . FilterProjected $ (_etProjFilterIsSynced ?~) . getAny
] getSynced)
dbtFilterUI = mconcat $
(bool mempty
[ flip (prismAForm $ singletonFilter "is-synced" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamSynchronised)
]
] getSynced)
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def
@ -251,7 +261,7 @@ getEOExamsR = do
dbtExtraReps = []
examsDBTableValidator = def
& defaultSorting [SortAscBy "is-synced", SortAscBy "exam-time"]
& defaultSorting (bool mempty [SortAscBy "is-synced"] getSynced <> [SortAscBy "exam-time"])
& forceFilter "may-access" (Any True)
& forceFilter "has-results" (Any True)