chore(lms): add another common version of camelToPathPiece
This commit is contained in:
parent
f5cab6e58b
commit
a49c24147e
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user