chore(lms): add another common version of camelToPathPiece

This commit is contained in:
Steffen Jost 2022-02-21 14:34:48 +01:00
parent f5cab6e58b
commit a49c24147e
2 changed files with 14 additions and 9 deletions

View File

@ -108,11 +108,12 @@ data LmsResultCsvActionClass = LmsResultInsert
deriving (Eq, Ord, Read, Show, Generic, Typeable, Enum, Bounded)
embedRenderMessage ''UniWorX ''LmsResultCsvActionClass id
data LmsResultCsvAction = LmsResultInsertData { lmsResultInsertIdent :: LmsIdent, lmsResultInsertSuccess :: Day, lmsResultInsertTimestamp :: UTCTime }
-- TODO: why can't we use LmsResultTableCsv here instead?
data LmsResultCsvAction = LmsResultInsertData { lmsResultInsertIdent :: LmsIdent, lmsResultInsertSuccess :: Day }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions
{ constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 2 . dropEnd 1 . splitCamel
{ constructorTagModifier = camelToPathPiece'' 2 1 -- over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 2 . dropEnd 1 . splitCamel
, fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "action" "data"
} ''LmsResultCsvAction
@ -171,15 +172,13 @@ mkResultTable sid qsh qid = do
{ dbtCsvRowKey = \LmsResultTableCsv{..} ->
fmap E.Value . MaybeT . getKeyBy $ UniqueLmsResult qid csvLRTident csvLRTsuccess
, dbtCsvComputeActions = \case -- purpose is to show a diff to the user first
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
now <- liftIO getCurrentTime
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
--let LmsResultTableCsv{..} = dbCsvNew
--let csvLRTident = error "TODO"
-- csvLRTsuccess = error "TODO"
yield $ LmsResultInsertData
{ lmsResultInsertIdent = csvLRTident dbCsvNew
, lmsResultInsertSuccess = csvLRTsuccess dbCsvNew
, lmsResultInsertTimestamp = now
, lmsResultInsertSuccess = csvLRTsuccess dbCsvNew
}
DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _ } -> error "UniqueLmsResult was found, but Key no longer exists."
DBCsvDiffMissing{} -> return () -- no deletion
@ -199,8 +198,8 @@ mkResultTable sid qsh qid = do
, lmsResultSuccess = lmsResultInsertSuccess
, lmsResultTimestamp = now -- lmsResultInsertTimestamp -- does it matter which one to choose?
}
[ LmsResultSuccess =. lmsResultInsertSuccess
, LmsResultTimestamp =. now
[ LmsResultSuccess =. lmsResultInsertSuccess
, LmsResultTimestamp =. now
]
-- queueDBJob
-- audit

View File

@ -3,7 +3,7 @@ module Utils.PathPiece
, nullaryPathPiece', nullaryPathPiece, finitePathPiece
, derivePathPiece
, splitCamel
, camelToPathPiece, camelToPathPiece'
, camelToPathPiece, camelToPathPiece', camelToPathPiece''
, nameToPathPiece, nameToPathPiece'
, tuplePathPiece
, pathPieceJSON, pathPieceJSONKey
@ -211,9 +211,15 @@ splitCamel = map fromList . reverse . helper (error "hasChange undefined at star
sameCategory = (==) `on` Char.generalCategory
-- | convert CamelCase to kebab-case, dropping parts at the start and the end
camelToPathPiece'' :: Textual t => Natural -> Natural -> t -> t
camelToPathPiece'' dropNStart dropNEnd = intercalate "-" . map toLower . drop (fromIntegral dropNStart) . dropEnd (fromIntegral dropNEnd) . splitCamel
-- | convert CamelCase to kebab-case, dropping parts at the start
camelToPathPiece' :: Textual t => Natural -> t -> t
camelToPathPiece' dropN = intercalate "-" . map toLower . drop (fromIntegral dropN) . splitCamel
-- | convert CamelCase to kebab-case suitable for path pieces
camelToPathPiece :: Textual t => t -> t
camelToPathPiece = camelToPathPiece' 0