From a49c24147e17ae7404f0267d1f8bde832ac2be6e Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Mon, 21 Feb 2022 14:34:48 +0100
Subject: [PATCH] chore(lms): add another common version of camelToPathPiece

---
 src/Handler/LMS/Result.hs | 15 +++++++--------
 src/Utils/PathPiece.hs    |  8 +++++++-
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs
index ea2994a39..8db8a1f1f 100644
--- a/src/Handler/LMS/Result.hs
+++ b/src/Handler/LMS/Result.hs
@@ -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 
diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs
index 3a46b2cff..6e6d54950 100644
--- a/src/Utils/PathPiece.hs
+++ b/src/Utils/PathPiece.hs
@@ -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