diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index 73a04b422..35902b986 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/src/Handler/LMS/Userlist.hs @@ -22,13 +22,13 @@ import Database.Esqueleto.Utils.TH data LmsUserlistTableCsv = LmsUserlistTableCsv { csvLULident :: LmsIdent - , csvLULfailed :: Bool + , csvLULfailed :: LmsBool } deriving Generic makeLenses_ ''LmsUserlistTableCsv -- csv without headers -- TODO not yet supported -instance Csv.ToRecord LmsUserlistTableCsv +instance Csv.ToRecord LmsUserlistTableCsv instance Csv.FromRecord LmsUserlistTableCsv -- csv with headers @@ -121,7 +121,7 @@ mkUserlistTable sid qsh qid = do dbtCsvDoEncode = \() -> C.map (doEncode' . view _2) doEncode' = LmsUserlistTableCsv <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent) - <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed) + <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed . _lmsBool) dbtCsvDecode = Just DBTCsvDecode {..} where dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} -> @@ -129,13 +129,13 @@ mkUserlistTable sid qsh qid = do dbtCsvComputeActions = \case -- shows a diff first DBCsvDiffNew{dbCsvNew} -> do yield $ LmsUserlistInsertData - { lmsUserlistInsertIdent = csvLULident dbCsvNew - , lmsUserlistInsertFailed = csvLULfailed dbCsvNew + { lmsUserlistInsertIdent = csvLULident dbCsvNew + , lmsUserlistInsertFailed = lms2bool $ csvLULfailed dbCsvNew } DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do yield $ LmsUserlistUpdateData { lmsUserlistInsertIdent = csvLULident - , lmsUserlistInsertFailed = csvLULfailed + , lmsUserlistInsertFailed = csvLULfailed & lms2bool } DBCsvDiffMissing{} -> return () -- no deletion dbtCsvClassifyAction = \case diff --git a/src/Model/Types/Lms.hs b/src/Model/Types/Lms.hs index d62851469..13d2ae183 100644 --- a/src/Model/Types/Lms.hs +++ b/src/Model/Types/Lms.hs @@ -36,3 +36,28 @@ deriveJSON defaultOptions , sumEncoding = TaggedObject "lmsaudit" "lmsaction" } ''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