Implement Decl, Enum type checking

waspc/src/Analyzer/TypeChecker.hs

@@ -9,6 +9,7 @@ module Analyzer.TypeChecker
     unify,
     unifyTypes,
     checkExpr,
+    checkStmt,
     exprType,
     typeCheck,
   )
@@ -17,6 +18,9 @@ where
 import Analyzer.Parser (AST)
 import qualified Analyzer.Parser as P
 import Analyzer.Type
+  ( DictEntryType (DictOptional, DictRequired),
+    Type (DeclType, DictType, EnumType, ListType),
+  )
 import Analyzer.TypeChecker.AST
   ( TypeError (..),
     TypedAST (..),
@@ -26,6 +30,7 @@ import Analyzer.TypeChecker.AST
   )
 import Analyzer.TypeChecker.Internal
 import Analyzer.TypeDefinitions (TypeDefinitions)
+import qualified Analyzer.TypeDefinitions as TD
 import Control.Monad (foldM)
 import qualified Data.HashMap.Strict as H
 
@@ -124,7 +129,10 @@ hoistDeclarations (P.AST stmts) = mapM_ hoistDeclaration stmts
   where
     hoistDeclaration :: P.Stmt -> T ()
     -- Todo: check that typName is a real DeclType
-    hoistDeclaration (P.Decl typName ident _) = setType ident $ DeclType typName
+    hoistDeclaration (P.Decl typName ident _) =
+      lookupDecl typName >>= \case
+        Nothing -> throw $ TypeError $ "Invalid declaration type '" ++ typName ++ "'"
+        Just _ -> setType ident $ DeclType typName
 
 -- | Determine the type of an expression
 checkExpr :: P.Expr -> T TypedExpr
@@ -162,7 +170,14 @@ checkExpr (P.List values) = do
 
 -- | Checks that statements have valid types
 checkStmt :: P.Stmt -> T TypedStmt
-checkStmt (P.Decl typName _ expr) = error "check decl unimplemented"
+checkStmt (P.Decl typName name expr) =
+  lookupDecl typName >>= \case
+    Nothing -> throw $ TypeError $ "Invalid declaration type '" ++ typName ++ "'"
+    Just (TD.DeclType _ expectedType) -> do
+      mTypedExpr <- weaken expectedType <$> checkExpr expr
+      case mTypedExpr of
+        Left e -> throw e
+        Right typedExpr -> return $ Decl name typedExpr (DeclType typName)
 
 checkAST :: AST -> T TypedAST
 checkAST (P.AST stmts) = TypedAST <$> mapM checkStmt stmts
@@ -173,4 +188,4 @@ check ast = hoistDeclarations ast >> checkAST ast
 -- | Checks that an AST conforms to the type rules of Wasp and produces a
 --   an AST labelled with type information.
 typeCheck :: TypeDefinitions -> AST -> Either TypeError TypedAST
-typeCheck _ ast = runT $ check ast
+typeCheck tds ast = runT tds $ check ast

waspc/src/Analyzer/TypeChecker/Internal.hs

@@ -1,15 +1,19 @@
+{-# LANGUAGE TupleSections #-}
+
 module Analyzer.TypeChecker.Internal where
 
 import Analyzer.Parser.AST
 import Analyzer.Type
 import Analyzer.TypeChecker.AST
+import qualified Analyzer.TypeDefinitions as TD
 import Control.Monad.Except
+import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.HashMap.Strict as H
 
 type Bindings = H.HashMap Ident Type
 
-type T a = StateT Bindings (Except TypeError) a
+type T a = StateT Bindings (ReaderT TD.TypeDefinitions (Except TypeError)) a
 
 lookupType :: Ident -> T (Maybe Type)
 lookupType ident = gets $ H.lookup ident
@@ -20,8 +24,19 @@ setType ident typ = modify $ H.insert ident typ
 throw :: TypeError -> T a
 throw = throwError
 
-runTWithBound :: Bindings -> T a -> Either TypeError a
-runTWithBound bindings t = runExcept $ evalStateT t bindings
+lookupDecl :: String -> T (Maybe TD.DeclType)
+lookupDecl name = asks $ TD.getDeclType name
 
-runT :: T a -> Either TypeError a
-runT = runTWithBound H.empty
+runTWithBound :: Bindings -> TD.TypeDefinitions -> T a -> Either TypeError a
+runTWithBound bindings tds t = runExcept $ flip runReaderT tds $ evalStateT t bindings
+
+runT :: TD.TypeDefinitions -> T a -> Either TypeError a
+runT tds = runTWithBound bindings tds
+  where
+    bindings :: Bindings
+    -- Binds all enum values to the correct enum types
+    bindings =
+      foldr
+        (\(TD.EnumType name variants) b -> H.fromList (map (,EnumType name) variants) <> b)
+        H.empty
+        $ TD.getEnumTypes tds

waspc/src/Analyzer/TypeDefinitions.hs

@@ -3,8 +3,10 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Analyzer.TypeDefinitions
-  ( TypeDefinitions,
+  ( TypeDefinitions (..),
     empty,
+    getDeclTypes,
+    getEnumTypes,
     getDeclType,
     getEnumType,
     addDeclType,
@@ -41,6 +43,12 @@ data TypeDefinitions = TypeDefinitions
 empty :: TypeDefinitions
 empty = TypeDefinitions {declTypes = M.empty, enumTypes = M.empty}
 
+getDeclTypes :: TypeDefinitions -> [DeclType]
+getDeclTypes = M.elems . declTypes
+
+getEnumTypes :: TypeDefinitions -> [EnumType]
+getEnumTypes = M.elems . enumTypes
+
 getDeclType :: String -> TypeDefinitions -> Maybe DeclType
 getDeclType name (TypeDefinitions dts _) = M.lookup name dts
 

waspc/test/Analyzer/TypeCheckerTest.hs

@@ -3,7 +3,8 @@ module Analyzer.TypeCheckerTest where
 import qualified Analyzer.Parser as P
 import Analyzer.Type
 import Analyzer.TypeChecker
-import Analyzer.TypeChecker.Internal (Bindings, runTWithBound)
+import Analyzer.TypeChecker.Internal (Bindings, runT, runTWithBound)
+import qualified Analyzer.TypeDefinitions as TD
 import Data.Either (isLeft, isRight)
 import qualified Data.HashMap.Strict as H
 import Test.Tasty.Hspec
@@ -21,11 +22,34 @@ chooseType =
     ]
 
 checkExpr' :: Bindings -> P.Expr -> Either TypeError TypedExpr
-checkExpr' bindings expr = runTWithBound bindings $ checkExpr expr
+checkExpr' bindings expr = runTWithBound bindings TD.empty $ checkExpr expr
 
 spec_Parser :: Spec
 spec_Parser = do
   describe "Analyzer.TypeChecker" $ do
+    describe "unify" $ do
+      it "Doesn't affect 2 expressions of the same type" $ do
+        property $ \(a, b) ->
+          let initial = [IntegerLiteral a, DoubleLiteral b]
+              actual = unify initial
+           in actual == Right initial
+      it "Unifies two same-typed dictionaries to their original type" $ do
+        let typ = DictType $ H.fromList [("a", DictRequired BoolType), ("b", DictOptional NumberType)]
+        let a = Dict [("a", BoolLiteral True), ("b", IntegerLiteral 2)] typ
+        let b = Dict [("a", BoolLiteral True), ("b", DoubleLiteral 3.14)] typ
+        unify [a, b]
+          `shouldBe` Right [a, b]
+      it "Unifies an empty dict and a dict with one property" $ do
+        let a = Dict [] (DictType H.empty)
+        let b = Dict [("a", BoolLiteral True)] $ DictType $ H.singleton "a" $ DictRequired BoolType
+        let expected = DictType $ H.singleton "a" $ DictOptional BoolType
+        fmap (map exprType) (unify [a, b])
+          `shouldBe` Right [expected, expected]
+      it "Is idempotent when unifying an empty dict and a singleton dict" $ do
+        let a = Dict [] (DictType H.empty)
+        let b = Dict [("a", BoolLiteral True)] $ DictType $ H.singleton "a" $ DictRequired BoolType
+        unify [a, b] `shouldBe` (unify [a, b] >>= unify)
+
     describe "checkExpr" $ do
       it "Types string literals as StringType" $ do
         let actual = exprType <$> checkExpr' H.empty (P.StringLiteral "string")
@@ -80,10 +104,10 @@ spec_Parser = do
       it "Fails to type check a dictionary with duplicated keys" $ do
         let ast = P.Dict [("a", P.IntegerLiteral 5), ("a", P.IntegerLiteral 6)]
         let actual = exprType <$> checkExpr' H.empty ast
-        isLeft actual `shouldBe` True
+        actual `shouldSatisfy` isLeft
 
       it "Type checks an empty list" $ do
-        isRight (exprType <$> checkExpr' H.empty (P.List [])) `shouldBe` True
+        (exprType <$> checkExpr' H.empty (P.List [])) `shouldSatisfy` isRight
       it "Type checks a list where all elements have the same type" $ do
         let ast = P.List [P.IntegerLiteral 5, P.DoubleLiteral 1.6]
         let actual = exprType <$> checkExpr' H.empty ast
@@ -92,7 +116,7 @@ spec_Parser = do
       it "Fails to type check a list containing strings and numbers" $ do
         let ast = P.List [P.IntegerLiteral 5, P.StringLiteral "4"]
         let actual = exprType <$> checkExpr' H.empty ast
-        isLeft actual `shouldBe` True
+        actual `shouldSatisfy` isLeft
       it "Type checks a list of dictionaries that unify but have different types" $ do
         let ast =
               P.List
@@ -117,27 +141,89 @@ spec_Parser = do
                   P.Dict [("a", P.StringLiteral "string")]
                 ]
         let actual = exprType <$> checkExpr' H.empty ast
-        isLeft actual `shouldBe` True
+        actual `shouldSatisfy` isLeft
 
-    describe "unify" $ do
-      it "Doesn't affect 2 expressions of the same type" $ do
-        property $ \(a, b) ->
-          let initial = [IntegerLiteral a, DoubleLiteral b]
-              actual = unify initial
-           in actual == Right initial
-      it "Unifies two same-typed dictionaries to their original type" $ do
-        let typ = DictType $ H.fromList [("a", DictRequired BoolType), ("b", DictOptional NumberType)]
-        let a = Dict [("a", BoolLiteral True), ("b", IntegerLiteral 2)] typ
-        let b = Dict [("a", BoolLiteral True), ("b", DoubleLiteral 3.14)] typ
-        unify [a, b]
-          `shouldBe` Right [a, b]
-      it "Unifies an empty dict and a dict with one property" $ do
-        let a = Dict [] (DictType H.empty)
-        let b = Dict [("a", BoolLiteral True)] $ DictType $ H.singleton "a" $ DictRequired BoolType
-        let expected = DictType $ H.singleton "a" $ DictOptional BoolType
-        fmap (map exprType) (unify [a, b])
-          `shouldBe` Right [expected, expected]
-      it "Is idempotent when unifying an empty dict and a singleton dict" $ do
-        let a = Dict [] (DictType H.empty)
-        let b = Dict [("a", BoolLiteral True)] $ DictType $ H.singleton "a" $ DictRequired BoolType
-        unify [a, b] `shouldBe` (unify [a, b] >>= unify)
+    describe "checkStmt" $ do
+      it "Type checks existing declaration type with correct argument" $ do
+        let ast = P.Decl "string" "App" (P.StringLiteral "Wasp")
+        let lib = TD.TypeDefinitions {TD.declTypes = H.singleton "string" (TD.DeclType "string" StringType), TD.enumTypes = H.empty}
+        let actual = runT lib $ checkStmt ast
+        let expected = Right $ Decl "App" (StringLiteral "Wasp") (DeclType "string")
+        actual `shouldBe` expected
+      it "Fails to type check non-existant declaration type" $ do
+        let ast = P.Decl "string" "App" (P.StringLiteral "Wasp")
+        let actual = runT TD.empty $ checkStmt ast
+        actual `shouldSatisfy` isLeft
+      it "Fails to type check existing declaration type with incorrect argument" $ do
+        let ast = P.Decl "string" "App" (P.IntegerLiteral 5)
+        let lib =
+              TD.TypeDefinitions
+                { TD.declTypes = H.singleton "string" (TD.DeclType "string" StringType),
+                  TD.enumTypes = H.empty
+                }
+        let actual = runT lib $ checkStmt ast
+        actual `shouldSatisfy` isLeft
+      it "Type checks declaration with dict type with an argument that unifies to the correct type" $ do
+        let ast = P.Decl "maybeString" "App" (P.Dict [("val", P.StringLiteral "Wasp")])
+        let lib =
+              TD.TypeDefinitions
+                { TD.declTypes =
+                    H.singleton "maybeString" $
+                      TD.DeclType "maybeString" $
+                        DictType $ H.singleton "val" (DictOptional StringType),
+                  TD.enumTypes = H.empty
+                }
+        let actual = runT lib $ checkStmt ast
+        let expected =
+              Right $
+                Decl
+                  "App"
+                  ( Dict
+                      [("val", StringLiteral "Wasp")]
+                      (DictType $ H.singleton "val" (DictOptional StringType))
+                  )
+                  (DeclType "maybeString")
+        actual `shouldBe` expected
+
+    describe "typeCheck" $ do
+      it "Type checks a simple, well-typed example" $ do
+        let ast =
+              P.AST
+                [ P.Decl "app" "Todo" (P.Dict [("title", P.StringLiteral "Todo App")]),
+                  P.Decl "app" "Trello" (P.Dict [("title", P.StringLiteral "Trello Clone")])
+                ]
+        let lib =
+              TD.TypeDefinitions
+                { TD.declTypes =
+                    H.fromList
+                      [ ( "app",
+                          TD.DeclType "app" $
+                            DictType $
+                              H.fromList
+                                [ ("title", DictOptional StringType)
+                                ]
+                        )
+                      ],
+                  TD.enumTypes = H.empty
+                }
+        let actual = typeCheck lib ast
+        actual `shouldSatisfy` isRight
+      it "Fails to type check a simple, ill-typed example" $ do
+        let ast = P.AST [P.Decl "string" "App" (P.IntegerLiteral 5)]
+        let lib =
+              TD.TypeDefinitions
+                { TD.declTypes = H.singleton "string" (TD.DeclType "string" StringType),
+                  TD.enumTypes = H.empty
+                }
+        let actual = typeCheck lib ast
+        actual `shouldSatisfy` isLeft
+      it "Type checks an existing enum value" $ do
+        let ast = P.AST [P.Decl "food" "Cucumber" (P.Identifier "Dill")]
+        let lib =
+              TD.TypeDefinitions
+                { TD.declTypes = H.singleton "food" (TD.DeclType "food" (EnumType "flavor")),
+                  TD.enumTypes = H.singleton "flavor" (TD.EnumType "flavor" ["Fresh", "Dill"])
+                }
+        let actual = typeCheck lib ast
+        let expected = Right $ TypedAST [Decl "Cucumber" (Var "Dill" (EnumType "flavor")) (DeclType "food")]
+        actual `shouldBe` expected