Improve (I think) TH code

wasp-lang · Sep 23, 2024 · 14600dd · 14600dd
1 parent 77f92c3
commit 14600dd
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 16 deletions.
diff --git a/waspc/src/Wasp/AppSpec/Core/Decl/JSON.hs b/waspc/src/Wasp/AppSpec/Core/Decl/JSON.hs
@@ -20,7 +20,7 @@ import Wasp.AppSpec.Route ()
 -- This TH function assumes that all IsDecl instances are imported in this file.
 -- It needs this to be able to pick them up.
 -- TODO: Is there a way to ensure we don't forget to import the instances of IsDecl here
---   as we add / remove them?
---   I tried centralizing all IsDecl instances themselves in this file, but failed to get
---   it working, mostly due to `Ref a` which requires `(IsDecl a) =>`.
+-- as we add / remove them?
+-- I tried centralizing all IsDecl instances themselves in this file, but failed to get
+-- it working, mostly due to `Ref a` which requires `(IsDecl a) =>`.
 $(generateFromJsonInstanceForDecl)
diff --git a/waspc/src/Wasp/AppSpec/Core/Decl/JSON/TH.hs b/waspc/src/Wasp/AppSpec/Core/Decl/JSON/TH.hs
@@ -9,7 +9,6 @@ module Wasp.AppSpec.Core.Decl.JSON.TH
   )
 where
 
-import Control.Monad (forM)
 import Data.Aeson (FromJSON (parseJSON), withObject, (.:))
 import Data.Functor ((<&>))
 import Language.Haskell.TH
@@ -18,9 +17,8 @@ import Wasp.AppSpec.Core.IsDecl (IsDecl (declTypeName))
 
 generateFromJsonInstanceForDecl :: Q [Dec]
 generateFromJsonInstanceForDecl = do
-  isDeclTypes <- reifyIsDeclTypes
-
-  caseMatches <- forM isDeclTypes caseMatchForIsDeclType
+  declTypes <- reifyInstancesOfIsDeclClass
+  caseMatches <- mapM getCaseMatchForDeclType declTypes
 
   -- Generates:
   --   _ -> fail $ "Unknown declType " <> declType
@@ -39,18 +37,31 @@ generateFromJsonInstanceForDecl = do
         --     <caseMatches[1]>
         --     ...
         --     <defultCaseMatch>
-        $(pure $ CaseE (VarE (mkName "declType")) (caseMatches <> defaultCaseMatch))
+        $( pure $
+             CaseE
+               (VarE (mkName "declType"))
+               (caseMatches <> defaultCaseMatch)
+         )
     |]
   where
     -- Generates following (for e.g. `Page` type):
-    --   t | t == declTypeName @Page -> pure $ makeDecl @Page declName <$> o .: "declValue"
-    caseMatchForIsDeclType :: Type -> Q Match
-    caseMatchForIsDeclType typ = do
-      guardPredicate <- [|t == $(pure $ AppTypeE (VarE 'declTypeName) typ)|]
-      matchBody <- [e|$(pure $ AppTypeE (VarE 'makeDecl) typ) declName <$> (o .: "declValue")|]
-      pure $ Match (VarP (mkName "t")) (GuardedB [(NormalG guardPredicate, matchBody)]) []
+    --   t | t == declTypeName @Page -> makeDecl @Page declName <$> o .: "declValue"
+    getCaseMatchForDeclType :: Type -> Q Match
+    getCaseMatchForDeclType typ = do
+      casePredicate <- [|t == $(pure $ AppTypeE (VarE 'declTypeName) typ)|]
+      matchBody <-
+        [e|
+          $(pure $ AppTypeE (VarE 'makeDecl) typ)
+            declName
+            <$> (o .: "declValue")
+          |]
+      pure $
+        Match
+          (VarP (mkName "t"))
+          (GuardedB [(NormalG casePredicate, matchBody)])
+          []
 
-    reifyIsDeclTypes :: Q [Type]
-    reifyIsDeclTypes = do
+    reifyInstancesOfIsDeclClass :: Q [Type]
+    reifyInstancesOfIsDeclClass = do
       ClassI _ isDeclInstances <- reify ''IsDecl
       pure [t | InstanceD _ _ (AppT _ t) _ <- isDeclInstances]