[Analyzer] Instead of directly embedding Declarations into AST, now they are referenced via Ref (#343)

waspc/src/AST.hs

@@ -0,0 +1,32 @@
+module AST
+  ( App (..),
+    AuthMethod (..),
+    Page (..),
+  )
+where
+
+import AST.Core.Ref (Ref)
+
+-- TODO: Make AST full-featured, so it supports latest version of waps-lang.
+
+-- TODO: Split into multiple files (one for App, one for Page, ...).
+
+-- TODO: I should probably move Decl out of Analyzer and make it part of the AST here,
+--   since currently AST has no "top structure", right now it is just a bunch of nodes,
+--   and Decl is what wraps it all together, which really makes it a part of AST, not Analyzer.
+--   Also, in order for Ref to make sense, we need Decl since it contains names, so that
+--   again suggests that we need to make Decl part of AST.
+
+data App = App
+  { title :: String,
+    authMethod :: AuthMethod,
+    defaultPage :: Ref Page
+  }
+  deriving (Show, Eq)
+
+data AuthMethod = EmailAndPassword deriving (Show, Eq)
+
+data Page = Page
+  { content :: String
+  }
+  deriving (Show, Eq)

waspc/src/AST/Core/Ref.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module AST.Core.Ref
+  ( Ref (..),
+  )
+where
+
+import Data.Data (Data)
+
+-- | Reference to a part of the AST, by its name.
+-- e.g. `Ref "HomePage" :: Ref Page` is a reference to a page that is declared under the name "HomePage".
+newtype Ref a = Ref {name :: String} deriving (Show, Eq, Data)

waspc/src/Analyzer.hs

@@ -111,6 +111,7 @@ module Analyzer
     -- * API
     analyze,
     E.takeDecls,
+    AnalyzeError (..),
   )
 where
 

waspc/src/Analyzer/Evaluator.hs

@@ -25,9 +25,6 @@ import Data.Maybe (fromMaybe)
 evaluate :: TD.TypeDefinitions -> AST.TypedAST -> Either EvaluationError [Decl]
 evaluate typeDefs (AST.TypedAST stmts) = runExcept $ flip runReaderT typeDefs $ evalStateT (evalStmts stmts) H.empty
 
--- TODO: Currently, trying to reference declarations declared after the current one
--- fails. There are some solutions mentioned in docs/wasplang that should be
--- investigated.
 evalStmts :: [AST.TypedStmt] -> Eval [Decl]
 evalStmts = traverse evalStmt
 

waspc/src/Analyzer/Evaluator/Evaluation/TypedExpr/Combinators.hs

@@ -7,7 +7,7 @@ module Analyzer.Evaluator.Evaluation.TypedExpr.Combinators
     integer,
     double,
     bool,
-    decl,
+    declRef,
     enum,
     list,
     extImport,
@@ -16,7 +16,8 @@ module Analyzer.Evaluator.Evaluation.TypedExpr.Combinators
   )
 where
 
-import Analyzer.Evaluator.Decl.Operations (fromDecl)
+import AST.Core.Ref (Ref)
+import qualified AST.Core.Ref as Ref
 import Analyzer.Evaluator.Evaluation.Internal (evaluation, evaluation', runEvaluation)
 import Analyzer.Evaluator.Evaluation.TypedExpr (TypedExprEvaluation)
 import qualified Analyzer.Evaluator.EvaluationError as EvaluationError
@@ -25,7 +26,6 @@ import qualified Analyzer.Type as T
 import qualified Analyzer.TypeChecker.AST as TypedAST
 import qualified Analyzer.TypeDefinitions as TD
 import Control.Arrow (left)
-import qualified Data.HashMap.Strict as H
 
 -- | An evaluation that expects a "StringLiteral".
 string :: TypedExprEvaluation String
@@ -55,20 +55,20 @@ bool = evaluation' $ \case
   expr -> Left $ EvaluationError.ExpectedType T.BoolType (TypedAST.exprType expr)
 
 -- | An evaluation that expects a "Var" bound to a "Decl" of type "a".
-decl :: forall a. TD.IsDeclType a => TypedExprEvaluation a
-decl = evaluation $ \(_, bindings) -> \case
-  TypedAST.Var var typ -> case H.lookup var bindings of
-    Nothing -> Left $ EvaluationError.UndefinedVariable var
-    Just dcl -> case fromDecl @a dcl of
-      Nothing ->
+declRef :: forall a. TD.IsDeclType a => TypedExprEvaluation (Ref a)
+declRef = evaluation' $ \case
+  TypedAST.Var varName varType ->
+    case varType of
+      T.DeclType declTypeName | declTypeName == expectedDeclTypeName -> pure $ Ref.Ref varName
+      _ ->
         Left $
           EvaluationError.WithContext
-            (EvaluationError.ForVariable var)
-            (EvaluationError.ExpectedType (T.DeclType declTypeName) typ)
-      Just (_dclName, dclValue) -> Right dclValue
-  expr -> Left $ EvaluationError.ExpectedType (T.DeclType declTypeName) (TypedAST.exprType expr)
+            (EvaluationError.ForVariable varName)
+            (EvaluationError.ExpectedType expectedType varType)
+  expr -> Left $ EvaluationError.ExpectedType expectedType (TypedAST.exprType expr)
   where
-    declTypeName = TD.dtName $ TD.declType @a
+    expectedDeclTypeName = TD.dtName $ TD.declType @a
+    expectedType = T.DeclType expectedDeclTypeName
 
 -- | An evaluation that expects a "Var" bound to an "EnumType" for "a".
 enum :: forall a. TD.IsEnumType a => TypedExprEvaluation a

waspc/src/Analyzer/Evaluator/TH/Decl.hs

@@ -7,6 +7,7 @@ module Analyzer.Evaluator.TH.Decl
   )
 where
 
+import AST.Core.Ref (Ref)
 import Analyzer.Evaluator.Decl.Operations (makeDecl)
 import Analyzer.Evaluator.Evaluation
 import Analyzer.Evaluator.TH.Common
@@ -185,7 +186,7 @@ genWaspTypeFromHaskellType typ =
     KImport -> [|T.ExtImportType|]
     KJSON -> [|T.QuoterType "json"|]
     KPSL -> [|T.QuoterType "psl"|]
-    KDecl -> [|T.DeclType $ dtName $ declType @ $(pure typ)|]
+    KDeclRef t -> [|T.DeclType $ dtName $ declType @ $(pure t)|]
     KEnum -> [|T.EnumType $ etName $ enumType @ $(pure typ)|]
     KOptional _ -> fail "Maybe is only allowed in record fields"
 
@@ -201,37 +202,20 @@ genEvaluationExprForHaskellType typ =
     KImport -> [|extImport|]
     KJSON -> [|json|]
     KPSL -> [|psl|]
-    KDecl -> [|decl @ $(pure typ)|]
+    KDeclRef t -> [|declRef @ $(pure t)|]
     KEnum -> [|enum @ $(pure typ)|]
     KOptional _ -> fail "Maybe is only allowed in record fields"
 
--- | An intermediate mapping between Haskell types and Wasp types, used for
--- generating @Types@, @Evaluation@, @DictEntryTypes@, and @DictEvaluation@.
-data WaspKind
-  = KString
-  | KInteger
-  | KDouble
-  | KBool
-  | KList Type
-  | KImport
-  | KJSON
-  | KPSL
-  | KDecl
-  | KEnum
-  | -- | Valid only in a record field, represents @DictOptional@/@Maybe@
-    KOptional Type
-
 -- | Find the "WaspKind" of a Haskell type.
 waspKindOfType :: Type -> Q WaspKind
 waspKindOfType typ = do
-  typIsDecl <- isInstance ''IsDeclType [typ]
-  typIsEnum <- isInstance ''IsEnumType [typ]
-  if typIsDecl
-    then pure KDecl
-    else
-      if typIsEnum
-        then pure KEnum
-        else case typ of
+  maybeDeclRefKind <- tryCastingToDeclRefKind typ
+  maybeEnumKind <- tryCastingToEnumKind typ
+  case maybeDeclRefKind of
+    Just declRefKind -> pure declRefKind
+    Nothing -> case maybeEnumKind of
+      Just enumKind -> pure enumKind
+      Nothing -> case typ of
         ConT name
           | name == ''String -> pure KString
           | name == ''Integer -> pure KInteger
@@ -243,5 +227,34 @@ waspKindOfType typ = do
         ListT `AppT` elemType -> pure (KList elemType)
         ConT name `AppT` elemType | name == ''Maybe -> pure (KOptional elemType)
         _ -> fail $ "No translation to wasp type for type " ++ show typ
+  where
+    tryCastingToDeclRefKind :: Type -> Q (Maybe WaspKind)
+    tryCastingToDeclRefKind (ConT name `AppT` subType) | name == ''Ref = do
+      isDeclTypeRef <- isInstance ''IsDeclType [subType]
+      return $ if isDeclTypeRef then Just (KDeclRef subType) else Nothing
+    tryCastingToDeclRefKind _ = return Nothing
+
+    tryCastingToEnumKind :: Type -> Q (Maybe WaspKind)
+    tryCastingToEnumKind t = do
+      isEnumType <- isInstance ''IsEnumType [t]
+      return $ if isEnumType then Just KEnum else Nothing
+
+-- | An intermediate mapping between Haskell types and Wasp types, we use it internally
+-- in this module when generating @Types@, @Evaluation@, @DictEntryTypes@, and @DictEvaluation@
+-- so that we have easier time when figuring out what we are dealing with.
+data WaspKind
+  = KString
+  | KInteger
+  | KDouble
+  | KBool
+  | KList Type
+  | KImport
+  | KJSON
+  | KPSL
+  | -- | Reference to a declaration type @Type@.
+    KDeclRef Type
+  | KEnum
+  | -- | Valid only in a record field, represents @DictOptional@/@Maybe@
+    KOptional Type
 
 ---------------------------------------

waspc/src/Analyzer/StdTypeDefinitions.hs

@@ -1,37 +1,28 @@
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Analyzer.StdTypeDefinitions
-  ( AuthMethod (..),
-    App (..),
-    stdTypes,
+  ( stdTypes,
   )
 where
 
+import qualified AST
 import Analyzer.Evaluator.TH (makeDeclType, makeEnumType)
 import qualified Analyzer.TypeDefinitions as TD
 
+makeEnumType ''AST.AuthMethod
+makeDeclType ''AST.Page
+
+makeDeclType ''AST.App
+
 {- ORMOLU_DISABLE -}
 -- | Collection of domain types that are standard for Wasp, that define what the Wasp language looks like.
 -- These are injected this way instead of hardcoding them into the Analyzer in order to make it
 -- easier to modify and maintain the Wasp compiler/language.
 stdTypes :: TD.TypeDefinitions
 stdTypes =
-  TD.addEnumType @AuthMethod $
-  TD.addDeclType @App $
+  TD.addEnumType @AST.AuthMethod $
+  TD.addDeclType @AST.Page $
+  TD.addDeclType @AST.App $
   TD.empty
 {- ORMOLU_ENABLE -}
-
--- | TODO: Remove these types from here and instead use types from the Wasp module (Wasp AST).
--- For that we will need to make sure that those types are correctly shaped so that our
--- TH functions can automatically create appropriate instances for them.
-
---------- MOCK TYPES ----------
-data AuthMethod = EmailAndPassword deriving (Show, Eq)
-
-data App = App {title :: String, authMethod :: AuthMethod} deriving (Show, Eq)
-
-makeEnumType ''AuthMethod
-
-makeDeclType ''App
-
--------- / MOCK TYPES ---------

waspc/test/Analyzer/EvaluatorTest.hs

@@ -5,6 +5,7 @@
 
 module Analyzer.EvaluatorTest where
 
+import AST.Core.Ref (Ref (..))
 import Analyzer.Evaluator
 import Analyzer.Evaluator.TH
 import Analyzer.Parser (ExtImportName (ExtImportField, ExtImportModule), parse)
@@ -38,7 +39,7 @@ data Special = Special {imps :: [ExtImport], json :: JSON, psl :: PSL} deriving
 makeDeclType ''Special
 
 data Business = Business
-  { employees :: [Person],
+  { employees :: [Ref Person],
     worth :: Double,
     businessType :: BusinessType,
     location :: Maybe String
@@ -83,10 +84,7 @@ spec_Evaluator = do
           `shouldBe` Right
             [ ( "Grocer",
                 Business
-                  { employees =
-                      [ Person "Tim Stocker" 40,
-                        Person "John Cashier" 23
-                      ],
+                  { employees = [Ref "Tim", Ref "John"],
                     businessType = Store,
                     worth = 115.0,
                     location = Nothing

waspc/test/AnalyzerTest.hs

@@ -1,7 +1,12 @@
+{-# LANGUAGE TypeApplications #-}
+
 module AnalyzerTest where
 
+import AST (App (..), AuthMethod (..), Page (..))
+import AST.Core.Ref (Ref (..))
 import Analyzer
-import Analyzer.StdTypeDefinitions (App (..), AuthMethod (..))
+import qualified Analyzer.TypeChecker as TC
+import Data.Either (isRight)
 import Test.Tasty.Hspec
 
 spec_Analyzer :: Spec
@@ -13,7 +18,51 @@ spec_Analyzer = do
               [ "app Todo {",
                 "  title: \"Todo App\",",
                 "  authMethod: EmailAndPassword,",
+                "  defaultPage: HomePage",
+                "}",
+                "page HomePage { content: \"Hello world\" }"
+              ]
+      let decls = analyze source
+      let expectedApps = [("Todo", App {title = "Todo App", authMethod = EmailAndPassword, defaultPage = Ref "HomePage"})]
+      takeDecls @App <$> decls `shouldBe` Right expectedApps
+      let expectedPages = [("HomePage", Page {content = "Hello world"})]
+      takeDecls @Page <$> decls `shouldBe` Right expectedPages
+
+    it "Returns a type error if unexisting declaration is referenced" $ do
+      let source =
+            unlines
+              [ "page HomePage { content: \"Hello world\" }",
+                "app Todo {",
+                "  title: \"Todo App\",",
+                "  authMethod: EmailAndPassword,",
+                "  defaultPage: NonExistentPage",
                 "}"
               ]
-      let expectedApps = [("Todo", App {title = "Todo App", authMethod = EmailAndPassword})]
-      takeDecls <$> analyze source `shouldBe` Right expectedApps
+      takeDecls @App <$> analyze source `shouldBe` Left (TypeError $ TC.UndefinedIdentifier "NonExistentPage")
+
+    it "Returns a type error if referenced declaration is of wrong type" $ do
+      let source =
+            unlines
+              [ "app Todo {",
+                "  title: \"Todo App\",",
+                "  authMethod: EmailAndPassword,",
+                "  defaultPage: Todo",
+                "}"
+              ]
+      takeDecls @App <$> analyze source `shouldSatisfy` isAnalyzerOutputTypeError
+
+    it "Works when referenced declaration is declared after the reference." $ do
+      let source =
+            unlines
+              [ "app Todo {",
+                "  title: \"Todo App\",",
+                "  authMethod: EmailAndPassword,",
+                "  defaultPage: HomePage",
+                "}",
+                "page HomePage { content: \"Hello world\" }"
+              ]
+      isRight (analyze source) `shouldBe` True
+
+isAnalyzerOutputTypeError :: Either AnalyzeError a -> Bool
+isAnalyzerOutputTypeError (Left (TypeError _)) = True
+isAnalyzerOutputTypeError _ = False