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

chore(lms): encode bool by 0 and 1 in lms csv export/import

Browse Source
This commit is contained in:
Steffen Jost 2022-02-24 13:03:59 +01:00
parent c1d0f63620
commit aa54bba62b
2 changed files with 31 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,13 +22,13 @@ import Database.Esqueleto.Utils.TH
data LmsUserlistTableCsv = LmsUserlistTableCsv data LmsUserlistTableCsv = LmsUserlistTableCsv
{ csvLULident :: LmsIdent { csvLULident :: LmsIdent
, csvLULfailed :: Bool , csvLULfailed :: LmsBool
} }
deriving Generic deriving Generic
makeLenses_ ''LmsUserlistTableCsv makeLenses_ ''LmsUserlistTableCsv
-- csv without headers -- TODO not yet supported -- csv without headers -- TODO not yet supported
instance Csv.ToRecord LmsUserlistTableCsv instance Csv.ToRecord LmsUserlistTableCsv
instance Csv.FromRecord LmsUserlistTableCsv instance Csv.FromRecord LmsUserlistTableCsv
-- csv with headers -- csv with headers
@ -121,7 +121,7 @@ mkUserlistTable sid qsh qid = do
dbtCsvDoEncode = \() -> C.map (doEncode' . view _2) dbtCsvDoEncode = \() -> C.map (doEncode' . view _2)
doEncode' = LmsUserlistTableCsv doEncode' = LmsUserlistTableCsv
<$> view (_dbrOutput . _entityVal . _lmsUserlistIdent) <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent)
<*> view (_dbrOutput . _entityVal . _lmsUserlistFailed) <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed . _lmsBool)
dbtCsvDecode = Just DBTCsvDecode {..} dbtCsvDecode = Just DBTCsvDecode {..}
where where
dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} -> dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} ->
@ -129,13 +129,13 @@ mkUserlistTable sid qsh qid = do
dbtCsvComputeActions = \case -- shows a diff first dbtCsvComputeActions = \case -- shows a diff first
DBCsvDiffNew{dbCsvNew} -> do DBCsvDiffNew{dbCsvNew} -> do
yield $ LmsUserlistInsertData yield $ LmsUserlistInsertData
{ lmsUserlistInsertIdent = csvLULident dbCsvNew { lmsUserlistInsertIdent = csvLULident dbCsvNew
, lmsUserlistInsertFailed = csvLULfailed dbCsvNew , lmsUserlistInsertFailed = lms2bool $ csvLULfailed dbCsvNew
} }
DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do
yield $ LmsUserlistUpdateData yield $ LmsUserlistUpdateData
{ lmsUserlistInsertIdent = csvLULident { lmsUserlistInsertIdent = csvLULident
, lmsUserlistInsertFailed = csvLULfailed , lmsUserlistInsertFailed = csvLULfailed & lms2bool
} }
DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffMissing{} -> return () -- no deletion
dbtCsvClassifyAction = \case dbtCsvClassifyAction = \case

25
src/Model/Types/Lms.hs
View File

@ -36,3 +36,28 @@ deriveJSON defaultOptions
, sumEncoding = TaggedObject "lmsaudit" "lmsaction" , sumEncoding = TaggedObject "lmsaudit" "lmsaction"
} ''LmsStatus } ''LmsStatus
derivePersistFieldJSON ''LmsStatus derivePersistFieldJSON ''LmsStatus
-- LMS Interface requires Bool to be encoded by 0 or 1 only
data LmsBool = LmsUnset | LmsSet
deriving (Eq, Ord, Read, Show, Generic, Typeable, NFData)
lms2bool :: LmsBool -> Bool
lms2bool LmsUnset = False
lms2bool LmsSet = True
bool2lms :: Bool -> LmsBool
bool2lms False = LmsUnset
bool2lms True = LmsSet
_lmsBool :: Iso' Bool LmsBool
_lmsBool = iso bool2lms lms2bool
instance Csv.ToField LmsBool where
toField LmsUnset = "0"
toField LmsSet = "1"
instance Csv.FromField LmsBool where
parseField i
| i == "0" = pure LmsUnset
| i == "1" = pure LmsSet
| otherwise = empty