This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/LMS.hs
2022-02-08 09:36:11 +01:00

101 lines
3.5 KiB
Haskell

module Handler.LMS
( getLmsR
)
where
import Import
import Handler.Utils
import qualified Data.Csv as Csv
import qualified Data.Conduit.List as C
type LmsUserIdent = Text -- Unique random use-once identifier for each individual e-learning course; i.e. users may have several active LmsUserIdents at once!
data LmsUserTableCsv = LmsUserTableCsv -- Export only
{ csvLmsUserIdent :: LmsUserIdent
, csvLmsUserPin :: Text
, csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Bool
}
data LmsUserlistTableCsv = LmsUserlistTableCsv -- Import only, all users that are currently enlisted at the e-learning plattform
{ csvLmsUserlistIdent :: LmsUserIdent
, csvLmsUserlistFailed :: Bool
}
data LmsResultTableCsv = LmsResultTableCsv -- Import only, all users that succeeded are returned ONCE only; must then be deleted via LmsUserTableCsv Export!
{ csvLmsResultIdent :: LmsUserIdent
, csvLmsResultSuccess :: UTCTime -- datestamp user succeeded (might be local time, unclear)
}
csvLmsUserFilename :: IO Text
csvLmsUserFilename = makeLmsFilename "user"
csvLmsUserlistFilename :: IO Text
csvLmsUserlistFilename = makeLmsFilename "userliste"
csvLmsResultFilename :: IO Text
csvLmsResultFilename = makeLmsFilename "ergebnisse"
-- | Create filenames as specified by the LMS interface agreed with Know How AG
makeLmsFilename :: Text -> IO 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 = do
now <- getCurrentTime
return $ formatTime "%Y%m%d%h"
getLmsR :: Handler Html
getLmsR = do
let dbtIdent = "lmsUsers" :: Text
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
dbtSQLQuery q = error "TODO"
dbtRowKey = error "TODO"
dbtProj = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do
return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste?
dbtColonnade = colChoices
dbtSorting = mempty
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
dbtCsvName = "lms.csv"
-- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
dbtCsvEncode = do
return $ DBTCsvEncode
{ dbtCsvExportForm = def
, dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
LmsTableCsv -- <- for each desired column one view
<$> _t1
<*> _t2
<*> _t3
<*> _t4
<*> _t5
, dbtCsvName
, dbtCsvSheetName
, dbtCsvNoExportData = Nothing -- ?
, dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
, dbtCsvExampleData = Nothing
}
-- TODO wip, for reference see e.g. Handler.Exam.Users
dbtCsvDecode = Just DBTCsvDecode
{ dbtCsvRowKey = _1
, dbtCsvComputeActions = _2
, dbtCsvClassifyAction = _3
, dbtCsvCoarsenActionClass = _4
, dbtCsvValidateActions = _5
, dbtCsvExecuteActions = _6 -- <- actions based on sent data here
, dbtCsvRenderKey = _7
, dbtCsvRenderActionClass = _8
, dbtCsvRenderException = _9
}
dbTable psValidator DBTable{..}
heading = [whamlet|LMS|]
siteLayout heading $ do
setTitleI heading
$(widgetFile "lms")