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

chore(lms): remove some unnecessary singleton-cases to expose types

Browse Source
This commit is contained in:
Steffen Jost 2022-02-21 15:07:16 +01:00
parent a49c24147e
commit 8ad25c6ca5
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -74,6 +74,12 @@ data LmsResultTableCsv = LmsResultTableCsv
deriving Generic deriving Generic
makeLenses_ ''LmsResultTableCsv makeLenses_ ''LmsResultTableCsv
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece'' 2 1 -- TODO: purpose of dropping here is?
, fieldLabelModifier = camelToPathPiece' 2
} ''LmsResultTableCsv
-- csv without headers -- csv without headers
instance Csv.ToRecord LmsResultTableCsv -- default suffices instance Csv.ToRecord LmsResultTableCsv -- default suffices
instance Csv.FromRecord 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) deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions 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 , fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "action" "data" , sumEncoding = TaggedObject "action" "data"
} ''LmsResultCsvAction } ''LmsResultCsvAction
@ -183,13 +189,11 @@ mkResultTable sid qsh qid = do
DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _ } -> error "UniqueLmsResult was found, but Key no longer exists." DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _ } -> error "UniqueLmsResult was found, but Key no longer exists."
DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffMissing{} -> return () -- no deletion
DBCsvDiffExisting{} -> return () -- no merge DBCsvDiffExisting{} -> return () -- no merge
, dbtCsvClassifyAction = \case , dbtCsvClassifyAction = \LmsResultInsertData{} -> LmsResultInsert
LmsResultInsertData{} -> LmsResultInsert , dbtCsvCoarsenActionClass = \LmsResultInsert -> DBCsvActionNew -- there is only one action: insert into table
, dbtCsvCoarsenActionClass = const 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 , dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error
, dbtCsvExecuteActions = do , dbtCsvExecuteActions = do
C.mapM_ $ \case C.mapM_ $ \LmsResultInsertData{..} -> do
LmsResultInsertData{..} -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
void $ upsert void $ upsert
LmsResult LmsResult