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

chore(lms): userlist page csv export added

Browse Source
This commit is contained in:
Steffen Jost 2022-02-23 17:07:43 +01:00
parent 01a2f47961
commit 60087d44b0
3 changed files with 54 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Handler/LMS/Result.hs
View File

@ -72,7 +72,7 @@ makeLenses_ ''LmsResultTableCsv
instance Csv.ToRecord LmsResultTableCsv -- default suffices
instance Csv.FromRecord LmsResultTableCsv -- default suffices
-- csv with headers
-- csv with headers -- TODO not yet supported
lmsResultTableCsvHeader :: Csv.Header
lmsResultTableCsvHeader = Csv.header [ csvResultIdent, csvResultSuccess ]
@ -88,7 +88,6 @@ instance FromNamedRecord LmsResultTableCsv where
<$> csv Csv..: csvResultIdent
<*> csv Csv..: csvResultSuccess
instance CsvColumnsExplained LmsResultTableCsv where
csvColumnsExplanations _ = mconcat
[ single csvResultIdent MsgCsvColumnLmsIdent

47
src/Handler/LMS/Userlist.hs
View File

@ -20,12 +20,46 @@ import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
data LmsUserlistTableCsv = LmsUserlistTableCsv
{ csvLULident :: LmsIdent
, csvLULfailed :: Bool
}
deriving Generic
makeLenses_ ''LmsUserlistTableCsv
-- csv without headers -- TODO not yet supported
instance Csv.ToRecord LmsUserlistTableCsv
instance Csv.FromRecord LmsUserlistTableCsv
-- csv with headers
lmsUserlistTableCsvHeader :: Csv.Header
lmsUserlistTableCsvHeader = Csv.header [ csvUserlistIdent, csvUserlistBlocked ]
instance ToNamedRecord LmsUserlistTableCsv where
toNamedRecord LmsUserlistTableCsv{..} = Csv.namedRecord
[ csvUserlistIdent Csv..= csvLULident
, csvUserlistBlocked Csv..= csvLULfailed
]
instance FromNamedRecord LmsUserlistTableCsv where
parseNamedRecord (lsfHeaderTranslate -> csv)
= LmsUserlistTableCsv
<$> csv Csv..: csvUserlistIdent
<*> csv Csv..: csvUserlistBlocked
instance CsvColumnsExplained LmsUserlistTableCsv where
csvColumnsExplanations _ = mconcat
[ single csvUserlistIdent MsgCsvColumnLmsIdent
, single csvUserlistBlocked MsgCsvColumnLmsFailed
]
where
single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
single k v = singletonMap k [whamlet|_{v}|]
mkUserlistTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
mkUserlistTable _sid qsh qid = do
dbtCsvName <- csvFilenameLmsUserlist qsh
let _dbtCsvSheetName = dbtCsvName
let dbtCsvSheetName = dbtCsvName
let
userlistTable = DBTable{..}
where
@ -56,7 +90,16 @@ mkUserlistTable _sid qsh qid = do
dbtParams = def
dbtIdent :: Text
dbtIdent = "lms-userlist"
dbtCsvEncode = noCsvEncode
dbtCsvEncode = Just DBTCsvEncode {..}
where
dbtCsvExportForm = pure ()
dbtCsvNoExportData = Just id
dbtCsvExampleData = Nothing
dbtCsvHeader = const $ return lmsUserlistTableCsvHeader
dbtCsvDoEncode = \() -> C.map (doEncode' . view _2)
doEncode' = LmsUserlistTableCsv
<$> view (_dbrOutput . _entityVal . _lmsUserlistIdent)
<*> view (_dbrOutput . _entityVal . _lmsUserlistFailed)
dbtCsvDecode = Nothing -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later!
dbtExtraReps = []

13
test/Database/Fill.hs
View File

@ -457,11 +457,14 @@ fillDb = do
for_ [jost] $ \uid ->
void . insert' $ UserSchool uid avn False
_qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False
void . insert' $ LmsResult qid_r (LmsIdent "hijklmn") (addBDays (-1) $ utctDay now) now
void . insert' $ LmsResult qid_r (LmsIdent "opqgrs" ) (addBDays (-2) $ utctDay now) now
void . insert' $ LmsResult qid_r (LmsIdent "pqgrst" ) (addBDays (-3) $ utctDay now) now
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing True
_qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False
void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (addBDays (-1) $ utctDay now) now
void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (addBDays (-2) $ utctDay now) now
void . insert' $ LmsResult qid_f (LmsIdent "pqgrst" ) (addBDays (-3) $ utctDay now) now
void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
let
sdBsc = StudyDegreeKey' 82
sdMst = StudyDegreeKey' 88