chore(lms): change routes to respect schools

routes

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

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 (LmsR         _sid _qsh) = i18nCrumb MsgMenuLms             Nothing
-breadcrumb (LmsUserlistR  qid) = i18nCrumb MsgMenuLmsUserlist   $ Just $ LmsR qid
+breadcrumb (LmsUserlistR  sid  qsh) = i18nCrumb MsgMenuLmsUserlist   $ Just $ LmsR sid qsh
-breadcrumb (LmsResultR    qid) = i18nCrumb MsgMenuLmsResult     $ Just $ LmsR qid
+breadcrumb (LmsResultR    sid  qsh) = i18nCrumb MsgMenuLmsResult     $ Just $ LmsR sid qsh
 
 breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
 breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR

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 :: SchoolId -> QualificationShorthand -> Handler Html
-getLmsR _qid = do  
+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 :: SchoolId -> QualificationShorthand -> Handler Html
-getLmsUserlistR qid = do  
+getLmsUserlistR sid qsh = do  
-  lmsTable <- runDB $ view _2 <$> mkUserlistTable qid
+  (_qid, lmsTable) <- runDB $ bind2
+    (getKeyBy404 $ UniqueSchoolShort sid qsh)
+    ((view _2 <$>) . mkUserlistTable)    
   siteLayoutMsg MsgMenuLmsUserlist $ do
     setTitleI MsgMenuLmsUserlist
     $(widgetFile "lms-userlist")

src/Handler/LMS/Result.hs

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

src/Model/Types/Common.hs

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

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 --
 --------------