fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(lms): change routes to respect schools

Browse Source
This commit is contained in:
Steffen Jost 2022-02-17 16:05:17 +01:00
parent e338c025e5
commit 40c312d2bd
6 changed files with 36 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
routes
View File

@ -255,6 +255,6 @@
!/*WellKnownFileName WellKnownR GET !free
-- OSIS CSV Export Demo
/lms/#QualificationId LmsR GET
/lms/#QualificationId/userlist LmsUserlistR GET
/lms/#QualificationId/result LmsResultR GET
/lms/#SchoolId/#QualificationShorthand LmsR GET
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET
/lms/#SchoolId/#QualificationShorthand/result LmsResultR GET

6
src/Foundation/Navigation.hs
View File

@ -133,9 +133,9 @@ breadcrumb HealthR = i18nCrumb MsgMenuHealth Nothing
breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing
breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed
breadcrumb (LmsR _qid) = i18nCrumb MsgMenuLms Nothing
breadcrumb (LmsUserlistR qid) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR qid
breadcrumb (LmsResultR qid) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR qid
breadcrumb (LmsR _sid _qsh) = i18nCrumb MsgMenuLms Nothing
breadcrumb (LmsUserlistR sid qsh) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR sid qsh
breadcrumb (LmsResultR sid qsh) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR sid qsh
breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing
breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR

13
src/Handler/LMS.hs
View File

@ -73,8 +73,9 @@ getYMTH :: MonadHandler m => m Text
getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
getLmsR :: QualificationId -> Handler Html
getLmsR _qid = do
getLmsR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR sid qsh = do
_qid <- runDB . getKeyBy404 $ UniqueSchoolShort sid qsh
-- TODO !!! filter table by qid !!!
{-
dbtCsvName <- csvLmsUserFilename
@ -173,9 +174,11 @@ mkUserlistTable qid = do
dbTable userlistDBTableValidator userlistTable
getLmsUserlistR :: QualificationId -> Handler Html
getLmsUserlistR qid = do
lmsTable <- runDB $ view _2 <$> mkUserlistTable qid
getLmsUserlistR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsUserlistR sid qsh = do
(_qid, lmsTable) <- runDB $ bind2
(getKeyBy404 $ UniqueSchoolShort sid qsh)
((view _2 <$>) . mkUserlistTable)
siteLayoutMsg MsgMenuLmsUserlist $ do
setTitleI MsgMenuLmsUserlist
$(widgetFile "lms-userlist")

8
src/Handler/LMS/Result.hs
View File

@ -149,9 +149,11 @@ mkResultTable qid = do
& defaultSorting [SortAscBy "ident"]
dbTable resultDBTableValidator resultDBTable
getLmsResultR :: QualificationId -> Handler Html
getLmsResultR qid = do
lmsTable <- runDB $ view _2 <$> mkResultTable qid
getLmsResultR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsResultR sid qsh = do
lmsTable <- runDB $ do
qid <- getKeyBy404 $ UniqueSchoolShort sid qsh
view _2 <$> mkResultTable qid
siteLayoutMsg MsgMenuLmsResult $ do
setTitleI MsgMenuLmsResult
$(widgetFile "lms-result")

5
src/Model/Types/Common.hs
View File

@ -57,6 +57,5 @@ type TermCandidateIncidence = UUID
type SessionFileReference = Digest SHA3_256
type WorkflowDefinitionName = CI Text
type WorkflowInstanceName = CI Text
type WorkflowInstanceCategory = CI Text
type QualificationName = CI Text
type QualificationShorthand = CI Text

15
src/Utils.hs
View File

@ -1017,6 +1017,21 @@ mapMM_ f mxs = Fold.mapM_ f =<< mxs
forMM_ :: (Foldable t, Monad m) => m (t a) -> (a -> m ()) -> m ()
forMM_ = flip mapMM_
-- is this a good idea? can we generalise this pattern?
bind2 :: Monad m => m a -> (a -> m b) -> m (a, b)
bind2 ma ma2b = do
a <- ma
b <- ma2b a
return (a,b)
bind3 :: Monad m => m a -> (a -> m b) -> (a -> b -> m c) -> m (a, b, c)
bind3 ma ma2b mab2c = do
a <- ma
b <- ma2b a
c <- mab2c a b
return (a,b,c)
--------------
-- Foldable --
--------------