Extracted JSON manipulation into Util. (wasp-lang#65)

package.yaml

@@ -90,3 +90,4 @@ tests:
       - tasty-discover
       - QuickCheck
       - parsec
+      - deepseq

src/Generator/EntityGenerator.hs

@@ -22,7 +22,6 @@ import Data.Aeson ((.=), object, toJSON)
 import qualified Data.Aeson as Aeson
 import qualified Data.Text as Text
 import System.FilePath (FilePath, (</>), (<.>))
-import qualified Data.HashMap.Strict as M
 
 import qualified Util
 import Wasp
@@ -98,9 +97,8 @@ generateEntityCreateForm wasp entityForm =
     templateSrcPath = entityTemplatesDirPath </> "components" </> "CreateForm.js"
     dstPath = "src" </> (entityCreateFormPathInSrc entity entityForm)
 
-    -- TODO(matija): extract this into a util function.
-    Aeson.Object entityData = entityTemplateData wasp entity
-    templateData = Aeson.Object (M.insert "entityForm" (toJSON entityForm) entityData)
+    entityTemplateJson = entityTemplateData wasp entity
+    templateData = Util.jsonSet "entityForm" (toJSON entityForm) entityTemplateJson
 
 -- | Generates creation forms for the given entity.
 generateEntityCreateForms :: Wasp -> Entity -> [FileDraft]

src/Util.hs

@@ -4,10 +4,13 @@ module Util
     , toLowerFirst
     , toUpperFirst
     , headSafe
+    , jsonSet
     ) where
 
 import Data.Char (isUpper, toLower, toUpper)
 import qualified Data.Aeson as Aeson
+import qualified Data.Text as Text
+import qualified Data.HashMap.Strict as M
 
 
 camelToKebabCase :: String -> String
@@ -35,3 +38,7 @@ toUpperFirst = onFirst toUpper
 headSafe :: [a] -> Maybe a
 headSafe [] = Nothing
 headSafe xs = Just (head xs)
+
+jsonSet :: Text.Text -> Aeson.Value -> Aeson.Value -> Aeson.Value
+jsonSet key value (Aeson.Object o) = Aeson.Object $ M.insert key value o
+jsonSet _ _ _ = error "Input JSON must be an object"

test/UtilTest.hs

@@ -1,6 +1,11 @@
 module UtilTest where
 
 import Test.Tasty.Hspec
+import Control.Exception (evaluate)
+import Control.DeepSeq
+
+import qualified Data.Aeson as Aeson
+import Data.Aeson ((.=), object, toJSON)
 
 import Util
 
@@ -32,3 +37,28 @@ spec_toUpperFirst :: Spec
 spec_toUpperFirst = do
     it "Capitalizes first letter of string" $ do
         toUpperFirst "fooBar" `shouldBe` "FooBar"
+
+spec_jsonSet :: Spec
+spec_jsonSet = do
+    let inputObj = object
+            [ "prop1" .= ("first" :: String)
+            ]
+
+    it "When input JSON is not an object, throws an error." $ do
+        (evaluate . force) (jsonSet "someProp" (Aeson.Number 23) (Aeson.Bool True))
+            `shouldThrow` errorCall "Input JSON must be an object"
+
+    it "When a new property is set, result object contains it along with the original ones." $ do
+        let expectedObj = object
+                [ "prop1" .= ("first" :: String)
+                , "newProp" .= (23 :: Int)
+                ]
+        (jsonSet "newProp" (Aeson.Number 23) inputObj) `shouldBe` expectedObj
+
+    it "When an existing property is set, it is overwritten in the result object." $ do
+        let newStrValue = "newVal" :: String
+        let expectedObj = object
+                [ "prop1" .= newStrValue
+                ]
+        (jsonSet "prop1" (toJSON newStrValue) inputObj) `shouldBe` expectedObj
+