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

chore(lms): add required lenses for stub wip

Browse Source
This commit is contained in:
Steffen Jost 2022-02-08 18:01:59 +01:00
parent c76b2efd1d
commit 31154b9430
4 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Application.hs
View File

@ -145,7 +145,7 @@ import Handler.Participants
import Handler.StorageKey
import Handler.Error
import Handler.Upload
import Handler.LMS
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

6
src/Handler/Health.hs
View File

@ -2,6 +2,8 @@ module Handler.Health where
import Import
import Handler.Utils
import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified Data.Text.Lazy.Builder as Builder
@ -104,6 +106,7 @@ getStatusR :: Handler Html
getStatusR = do
starttime <- getsYesod appStartTime
currtime <- liftIO getCurrentTime
ft <- formatTime' "%Y%m%d %H:%M:%S" currtime -- use me throughout or delete me (delete, since this Handler is for mechanised tests only)
withUrlRenderer
[hamlet|
$doctype 5
@ -113,7 +116,8 @@ getStatusR = do
<body>
<p>
Current Time <br>
#{show currtime}
#{show currtime} <br>
#{ft}
<p>
Instance Start <br>
#{show starttime}

27
src/Handler/LMS.hs
View File

@ -42,30 +42,31 @@ resultLmsUser = _dbrOutput . _1
resultUser :: Lens' LmsUserTableData (Maybe (Entity User))
resultUser = _dbrOutput . _2
csvLmsUserFilename :: IO Text
csvLmsUserFilename :: MonadHandler m => m Text
csvLmsUserFilename = makeLmsFilename "user"
csvLmsUserlistFilename :: IO Text
csvLmsUserlistFilename :: MonadHandler m => m Text
csvLmsUserlistFilename = makeLmsFilename "userliste"
csvLmsResultFilename :: IO Text
csvLmsResultFilename :: MonadHandler m => m Text
csvLmsResultFilename = makeLmsFilename "ergebnisse"
-- | Create filenames as specified by the LMS interface agreed with Know How AG
makeLmsFilename :: Text -> IO Text
makeLmsFilename :: MonadHandler m => Text -> m Text
makeLmsFilename ftag = do
ymth <- get_ymth
return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv"
-- | Return current datetime in YYYYMMDDHH format
get_ymth :: IO Text
get_ymth :: MonadHandler m => m Text
get_ymth = do
now <- getCurrentTime
return $ formatTime "%Y%m%d%h"
now <- liftIO $ getCurrentTime
formatTime' "%Y%m%d%H" now
getLmsR :: Handler Html
getLmsR = do
dbtCsvName <- csvLmsUserFilename
let dbtIdent = "lmsUsers" :: Text
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtSQLQuery = runReaderT $ do
@ -78,13 +79,17 @@ getLmsR = do
dbtRowKey = queryLmsUser >>> (E.^. LmsUserId)
dbtProj = dbtProjSimple $ \(lmsUser, user) -> do
-- return ("abcdefgh", "12345678", False, False, True)
return (lmsUser E.^. LmsUserIdent, lmsUser E.^. LmsUserPin, lmsUser E.^. LmsUserResetPin, lmsUser E.^. LmsUserResetPin, isJust (user E.?. UserCompanyPersonalNumber))
return ( lmsUser E.^. LmsUserIdent
, lmsUser E.^. LmsUserPin
, lmsUser E.^. LmsUserResetPin
, lmsUser E.^. LmsUserResetPin
-- , True) -- works, so we need a simple type here indeed
, isJust $ E.unValue (user E.?. UserCompanyPersonalNumber))
dbtColonnade = mempty --TODO
dbtSorting = mempty
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
dbtCsvName = "lms.csv"
dbtParams = def
-- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
dbtCsvEncode = do
return $ DBTCsvEncode
@ -99,7 +104,7 @@ getLmsR = do
mitarbeiter
, dbtCsvName
, dbtCsvNoExportData = Nothing
, dbtCsvHeader = Nothing -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
, dbtCsvHeader = def -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
, dbtCsvExampleData = Nothing
}
-- TODO wip, for reference see e.g. Handler.Exam.Users

3
src/Utils/Lens.hs
View File

@ -113,6 +113,9 @@ makeClassyFor_ ''StudyDegree
makeClassyFor_ ''StudyTerms
makeClassyFor_ ''StudySubTerms
makeClassyFor_ ''LmsUser
makeClassyFor_ ''LmsUserlist
makeClassyFor_ ''LmsResult
_entityKey :: Getter (Entity record) (Key record)
-- ^ Not a `Lens'` for safety