From 40c312d2bd0263a81c2f076db32fd30a3677f98b Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Thu, 17 Feb 2022 16:05:17 +0100
Subject: [PATCH] chore(lms): change routes to respect schools

---
 routes                       |  6 +++---
 src/Foundation/Navigation.hs |  6 +++---
 src/Handler/LMS.hs           | 13 ++++++++-----
 src/Handler/LMS/Result.hs    |  8 +++++---
 src/Model/Types/Common.hs    |  5 ++---
 src/Utils.hs                 | 15 +++++++++++++++
 6 files changed, 36 insertions(+), 17 deletions(-)

diff --git a/routes b/routes
index 72e6d6ae7..d616ef341 100644
--- a/routes
+++ b/routes
@@ -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
diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs
index c0013e960..6b7ab4575 100644
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@@ -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
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index bddfd6ff3..f4aab2e5f 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -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")
diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs
index 7c6afdb30..bbd7d1dd1 100644
--- a/src/Handler/LMS/Result.hs
+++ b/src/Handler/LMS/Result.hs
@@ -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")
diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs
index 18e3e6b38..a0b83aba5 100644
--- a/src/Model/Types/Common.hs
+++ b/src/Model/Types/Common.hs
@@ -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
\ No newline at end of file
diff --git a/src/Utils.hs b/src/Utils.hs
index 82f30f157..d2aabe9ae 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -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 --
 --------------