diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index 8db8a1f1f..75b95d252 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -74,6 +74,12 @@ data LmsResultTableCsv = LmsResultTableCsv deriving Generic makeLenses_ ''LmsResultTableCsv +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece'' 2 1 -- TODO: purpose of dropping here is? + , fieldLabelModifier = camelToPathPiece' 2 + } ''LmsResultTableCsv + + -- csv without headers instance Csv.ToRecord LmsResultTableCsv -- default suffices instance Csv.FromRecord LmsResultTableCsv -- default suffices @@ -113,7 +119,7 @@ data LmsResultCsvAction = LmsResultInsertData { lmsResultInsertIdent :: LmsIdent deriving (Eq, Ord, Read, Show, Generic, Typeable) deriveJSON defaultOptions - { constructorTagModifier = camelToPathPiece'' 2 1 -- over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 2 . dropEnd 1 . splitCamel + { constructorTagModifier = camelToPathPiece'' 2 1 , fieldLabelModifier = camelToPathPiece' 2 , sumEncoding = TaggedObject "action" "data" } ''LmsResultCsvAction @@ -183,13 +189,11 @@ mkResultTable sid qsh qid = do DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _ } -> error "UniqueLmsResult was found, but Key no longer exists." DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffExisting{} -> return () -- no merge - , dbtCsvClassifyAction = \case - LmsResultInsertData{} -> LmsResultInsert - , dbtCsvCoarsenActionClass = const DBCsvActionNew -- there is only one action: insert into table + , dbtCsvClassifyAction = \LmsResultInsertData{} -> LmsResultInsert + , dbtCsvCoarsenActionClass = \LmsResultInsert -> DBCsvActionNew -- there is only one action: insert into table , dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error , dbtCsvExecuteActions = do - C.mapM_ $ \case - LmsResultInsertData{..} -> do + C.mapM_ $ \LmsResultInsertData{..} -> do now <- liftIO getCurrentTime void $ upsert LmsResult