chore(lms): direct export for lms users working

routes

@@ -256,7 +256,8 @@
 
 -- OSIS CSV Export Demo
 /lms/#SchoolId/#QualificationShorthand                  LmsR  				      GET POST
-/lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	          GET POST
+/lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	          GET 
+/lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	    GET 
 /lms/#SchoolId/#QualificationShorthand/userlist         LmsUserlistR	      GET POST
 /lms/#SchoolId/#QualificationShorthand/userliss/upload  LmsUserlistUploadR	GET POST
 /lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	    POST

src/Foundation/Navigation.hs

@@ -135,6 +135,7 @@ breadcrumb StatusR          = i18nCrumb MsgMenuHealth          Nothing  -- never
 
 breadcrumb (LmsR               _sid _qsh) = i18nCrumb MsgMenuLms             Nothing
 breadcrumb (LmsUsersR           sid  qsh) = i18nCrumb MsgMenuLmsUsers      $ Just $ LmsR          sid qsh
+breadcrumb (LmsUsersDirectR     sid  qsh) = i18nCrumb MsgMenuLmsUsers      $ Just $ LmsUsersR     sid qsh -- never displayed, TypedContent
 breadcrumb (LmsUserlistR        sid  qsh) = i18nCrumb MsgMenuLmsUserlist   $ Just $ LmsR          sid qsh
 breadcrumb (LmsUserlistUploadR  sid  qsh) = i18nCrumb MsgMenuLmsUpload     $ Just $ LmsUserlistR  sid qsh
 breadcrumb (LmsUserlistDirectR  sid  qsh) = i18nCrumb MsgMenuLmsUpload     $ Just $ LmsUserlistR  sid qsh -- never displayed

src/Handler/LMS.hs

@@ -6,7 +6,7 @@
 
 module Handler.LMS
   ( getLmsR               , postLmsR
-  , getLmsUsersR          , postLmsUsersR
+  , getLmsUsersR                                  , getLmsUsersDirectR
   , getLmsUserlistR       , postLmsUserlistR
   , getLmsUserlistUploadR , postLmsUserlistUploadR, postLmsUserlistDirectR
   , getLmsResultR         , postLmsResultR

src/Handler/LMS/Users.hs

@@ -1,7 +1,9 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
+{- LANGUAGE TypeApplications -} -- only needed for Database.Esqueleto.Experimental
 
 module Handler.LMS.Users
-  ( getLmsUsersR, postLmsUsersR 
+  ( getLmsUsersR
+  , getLmsUsersDirectR
   )
   where
 
@@ -16,6 +18,7 @@ import Handler.Utils.LMS
 import qualified Data.Map as Map
 import qualified Data.Csv as Csv
 import qualified Data.Conduit.List as C
+-- import qualified Database.Esqueleto.Experimental as Ex
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 
@@ -27,6 +30,15 @@ data LmsUserTableCsv = LmsUserTableCsv -- for csv export only
   deriving Generic
 makeLenses_ ''LmsUserTableCsv 
 
+-- | Mundane conversion needed for direct download without dbTable onlu
+lmsUser2csv :: LmsUser -> LmsUserTableCsv
+lmsUser2csv lu@LmsUser{..} = LmsUserTableCsv
+  { csvLUTident     = lmsUserIdent 
+  , csvLUTpin       = lmsUserPin
+  , csvLUTresetPin  = lmsUserResetPin    & LmsBool 
+  , csvLUTdelete    = lmsUserToDelete lu & LmsBool
+  , csvLUTstaff     = False              & LmsBool
+  }
 
 -- csv without headers -- TODO not yet supported
 -- instance Csv.ToRecord   LmsUserTableCsv
@@ -76,6 +88,7 @@ mkUserTable _sid qsh qid = do
       where
         dbtSQLQuery lmsuser = do
           E.where_ $ lmsuser E.^. LmsUserQualification E.==. E.val qid 
+              E.&&. E.isNothing (lmsuser E.^. LmsUserEnded)
           return lmsuser
         dbtRowKey = (E.^. LmsUserId)
         dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
@@ -116,8 +129,7 @@ mkUserTable _sid qsh qid = do
               <*> view (_dbrOutput . _entityVal . _lmsUserPin)
               <*> view (_dbrOutput . _entityVal . _lmsUserResetPin . _lmsBool)
               <*> view (_dbrOutput . _entityVal . _lmsUserToDelete . _lmsBool)
-              -- <*> const $ LmsBool False
+              <*> const (LmsBool False)              
-              <*> view (_dbrOutput . _entityVal . _lmsUserToDelete . _lmsBool)
 
         dbtCsvDecode = Nothing
         dbtExtraReps = []
@@ -126,9 +138,8 @@ mkUserTable _sid qsh qid = do
       & defaultSorting [SortAscBy csvLmsIdent]
   dbTable userDBTableValidator userDBTable
 
-getLmsUsersR,  postLmsUsersR :: SchoolId -> QualificationShorthand -> Handler Html
+getLmsUsersR :: SchoolId -> QualificationShorthand -> Handler Html
-getLmsUsersR = postLmsUsersR
+getLmsUsersR sid qsh = do
-postLmsUsersR sid qsh = do
   lmsTable <- runDB $ do 
     qid <- getKeyBy404 $ UniqueQualificationSchoolShort sid qsh 
     view _2 <$> mkUserTable sid qsh qid 
@@ -136,6 +147,29 @@ postLmsUsersR sid qsh = do
     setTitleI MsgMenuLmsUsers
     $(widgetFile "lms-user")
 
-
+getLmsUsersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
+getLmsUsersDirectR sid qsh = do
+  lms_users <- runDB $ do
+    qid <- getKeyBy404 $ UniqueQualificationSchoolShort sid qsh 
+    selectList [LmsUserQualification ==. qid, LmsUserEnded ==. Nothing] [Asc LmsUserStarted, Asc LmsUserIdent] 
+    {- To avoid exporting unneeded columns, we would need an SqlSelect instance for LmsUserTableCsv; probably not worth it 
+      Ex.select $ do 
+        lmsuser <- Ex.from $ Ex.table @LmsUser
+        Ex.where_ $ lmsuser Ex.^. LmsUserQualification Ex.==. Ex.val qid 
+            Ex.&&. Ex.isNothing (lmsuser Ex.^. LmsUserEnded)
+        pure $ LmsUserTableCsv
+          { csvLUTident    = lmsuser Ex.^. LmsUserIdent 
+          , csvLUTpin      = lmsuser Ex.^. LmsUserPin 
+          , csvLUTresetPin = LmsBool . Ex.unValue $ lmsuser Ex.^. LmsUserResetPin
+          , csvLUTdelete   = LmsBool . Ex.unValue $ Ex.isNothing (lmsuser Ex.^. LmsUserEnded) Ex.&&. Ex.not_ (Ex.isNothing $ lmsuser Ex.^. LmsUserSuccess)
+          , csvLUTstaff    = LmsBool False
+          }
+      -} 
+  let csvRenderedData = toNamedRecord . lmsUser2csv . entityVal <$> lms_users      
+      csvRenderedHeader = lmsUserTableCsvHeader      
+  csvSheetName <- csvFilenameLmsUser qsh  
+  addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
+  csvRenderedToTypedContent csvSheetName CsvRendered{..}  
+      
 -- direct Download see:
 -- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod