Refactor questionnaire version DB model

Author: vknaisl

registry-public/package.yaml

@@ -33,15 +33,18 @@ library:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -52,5 +55,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields

registry-server/package.yaml

@@ -140,15 +140,18 @@ tests:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -159,5 +162,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields

shared-common/package.yaml

@@ -120,15 +120,18 @@ tests:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -139,5 +142,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields

shared-common/src/Shared/Common/Database/DAO/Common.hs

@@ -365,8 +365,8 @@ createDeleteEntitiesByFn entityName queryParams = do
   let action conn = execute conn sql params
   runDB action
 
-createDeleteEntityLikeFn :: AppContextC s sc m => String -> String -> [String] -> m Int64
-createDeleteEntityLikeFn entityName key params = do
+createDeleteEntityWhereInFn :: AppContextC s sc m => String -> String -> [String] -> m Int64
+createDeleteEntityWhereInFn entityName key params = do
   let sql = fromString $ f' "DELETE FROM %s WHERE %s IN (%s)" [entityName, key, generateQuestionMarks params]
   logQuery sql params
   let action conn = execute conn sql params

shared-common/src/Shared/Common/Util/List.hs

@@ -55,6 +55,20 @@ takeWhileInclusive p (x : xs) =
       then takeWhileInclusive p xs
       else []
 
+dropWhileInclusive :: (a -> Bool) -> [a] -> [a]
+dropWhileInclusive _ [] = []
+dropWhileInclusive p (x : xs) =
+  if p x
+    then dropWhileInclusive p xs
+    else x : xs
+
+dropWhileExclusive :: (a -> Bool) -> [a] -> [a]
+dropWhileExclusive _ [] = []
+dropWhileExclusive p (x : xs) =
+  if p x
+    then dropWhileExclusive p xs
+    else xs
+
 generateList :: Int -> [Int]
 generateList size = [0 .. (size - 1)]
 

shared-common/src/Shared/PersistentCommand/Database/DAO/PersistentCommand/PersistentCommandDAO.hs

@@ -96,7 +96,7 @@ deletePersistentCommands :: AppContextC s sc m => m Int64
 deletePersistentCommands = createDeleteEntitiesFn entityName
 
 deletePersistentCommandsByCreatedBy :: AppContextC s sc m => [U.UUID] -> m Int64
-deletePersistentCommandsByCreatedBy createdBys = createDeleteEntityLikeFn entityName "created_by" (fmap U.toString createdBys)
+deletePersistentCommandsByCreatedBy createdBys = createDeleteEntityWhereInFn entityName "created_by" (fmap U.toString createdBys)
 
 deletePersistentCommandByUuid :: AppContextC s sc m => U.UUID -> m Int64
 deletePersistentCommandByUuid uuid = createDeleteEntityByFn entityName [("uuid", U.toString uuid)]

shared-common/test/Shared/Specs/Common/Util/ListSpec.hs

@@ -23,6 +23,14 @@ listSpec =
       it "[1,2] -> [1,2]" $ [1, 2] `elems` [1, 2] `shouldBe` True
       it "[2,1] -> [1,2]" $ [2, 1] `elems` [1, 2] `shouldBe` True
       it "[1,2] -> [1]" $ [1, 2] `elems` [1] `shouldBe` False
+    describe "dropWhileInclusive" $ do
+      it "(<= 3) [] -> []" $ dropWhileInclusive (<= 3) [] `shouldBe` []
+      it "(<= 3) [1,2,3,4,5,6] -> [4,5,6]" $ dropWhileInclusive (<= 3) [1, 2, 3, 4, 5, 6] `shouldBe` [4, 5, 6]
+      it "(/= 3) [1,2,3,4,5,6] -> [3,4,5,6]" $ dropWhileInclusive (/= 3) [1, 2, 3, 4, 5, 6] `shouldBe` [3, 4, 5, 6]
+    describe "dropWhileExclusive" $ do
+      it "(<= 3) [] -> []" $ dropWhileExclusive (<= 3) [] `shouldBe` []
+      it "(<= 3) [1,2,3,4,5,6] -> [5,6]" $ dropWhileExclusive (<= 3) [1, 2, 3, 4, 5, 6] `shouldBe` [5, 6]
+      it "(/= 3) [1,2,3,4,5,6] -> [4,5,6]" $ dropWhileExclusive (/= 3) [1, 2, 3, 4, 5, 6] `shouldBe` [4, 5, 6]
     describe "generateList" $ do
       it "0 -> []" $ generateList 0 `shouldBe` []
       it "1 -> [0]" $ generateList 1 `shouldBe` [0]

wizard-common/package.yaml

@@ -100,15 +100,18 @@ tests:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -119,5 +122,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields

wizard-public/package.yaml

@@ -40,15 +40,18 @@ library:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -59,5 +62,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields

wizard-server/package.yaml

@@ -164,15 +164,18 @@ tests:
 default-extensions:
   - DataKinds
   - DeriveGeneric
+  - DisambiguateRecordFields
   - DuplicateRecordFields
   - ExistentialQuantification
   - ExtendedDefaultRules
   - FlexibleContexts
   - FlexibleInstances
   - FunctionalDependencies
   - GeneralizedNewtypeDeriving
+  - LambdaCase
   - MultiParamTypeClasses
   - OverloadedStrings
+  - OverloadedRecordDot
   - QuasiQuotes
   - RankNTypes
   - RecordWildCards
@@ -183,5 +186,3 @@ default-extensions:
   - TypeOperators
   - TypeSynonymInstances
   - UnicodeSyntax
-  - OverloadedRecordDot
-  - DisambiguateRecordFields