Made Dependencies and Entity full-featured (in AppSpec and Analyzer) (#374)

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

@@ -12,7 +12,6 @@ module Wasp.Analyzer.Evaluator.Evaluation.TypedExpr.Combinators
     list,
     extImport,
     json,
-    psl,
   )
 where
 
@@ -25,7 +24,6 @@ import qualified Wasp.Analyzer.TypeChecker.AST as TypedAST
 import qualified Wasp.Analyzer.TypeDefinitions as TD
 import Wasp.AppSpec.Core.Ref (Ref)
 import qualified Wasp.AppSpec.Core.Ref as Ref
-import qualified Wasp.AppSpec.Entity as AppSpec.Entity
 import qualified Wasp.AppSpec.ExtImport as AppSpec.ExtImport
 import qualified Wasp.AppSpec.JSON as AppSpec.JSON
 
@@ -98,9 +96,3 @@ json :: TypedExprEvaluation AppSpec.JSON.JSON
 json = evaluation' $ \case
   TypedAST.JSON str -> pure $ AppSpec.JSON.JSON str
   expr -> Left $ EvaluationError.ExpectedType (T.QuoterType "json") (TypedAST.exprType expr)
-
--- | An evaluation that expects a "PSL".
-psl :: TypedExprEvaluation AppSpec.Entity.PSL
-psl = evaluation' $ \case
-  TypedAST.PSL str -> pure $ AppSpec.Entity.PSL str
-  expr -> Left $ EvaluationError.ExpectedType (T.QuoterType "psl") (TypedAST.exprType expr)

waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs

@@ -4,6 +4,7 @@ module Wasp.Analyzer.Evaluator.EvaluationError
   )
 where
 
+import Text.Parsec (ParseError)
 import Wasp.Analyzer.Type (Type)
 
 data EvaluationError
@@ -19,6 +20,8 @@ data EvaluationError
     InvalidEnumVariant String String
   | -- | "MissingField fieldName"
     MissingField String
+  | -- | In case when evaluation includes parsing with Parsec and it fails.
+    ParseError ParseError
   | WithContext EvaluationErrorContext EvaluationError
   deriving (Show, Eq)
 

waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs

@@ -6,6 +6,7 @@ module Wasp.Analyzer.StdTypeDefinitions
   )
 where
 
+import Wasp.Analyzer.StdTypeDefinitions.Entity ()
 import qualified Wasp.Analyzer.TypeDefinitions as TD
 import Wasp.Analyzer.TypeDefinitions.TH (makeDeclType, makeEnumType)
 import Wasp.AppSpec.Action (Action)
@@ -19,7 +20,6 @@ import Wasp.AppSpec.Route (Route)
 
 makeEnumType ''AuthMethod
 makeEnumType ''DbSystem
-makeDeclType ''Entity
 makeDeclType ''App
 makeDeclType ''Page
 makeDeclType ''Route

waspc/src/Wasp/Analyzer/StdTypeDefinitions/Entity.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Wasp.Analyzer.StdTypeDefinitions.Entity () where
+
+import Control.Arrow (left)
+import qualified Text.Parsec as Parsec
+import qualified Wasp.Analyzer.Evaluator.EvaluationError as EvaluationError
+import qualified Wasp.Analyzer.Type as Type
+import qualified Wasp.Analyzer.TypeChecker.AST as TC.AST
+import Wasp.Analyzer.TypeDefinitions (DeclType (..), IsDeclType (..))
+import qualified Wasp.AppSpec.Core.Decl as Decl
+import Wasp.AppSpec.Entity (Entity, makeEntity)
+import qualified Wasp.Psl.Parser.Model
+
+instance IsDeclType Entity where
+  declType =
+    DeclType
+      { dtName = "entity",
+        dtBodyType = Type.QuoterType "psl",
+        dtEvaluate = \typeDefinitions bindings declName expr ->
+          Decl.makeDecl @Entity declName <$> declEvaluate typeDefinitions bindings expr
+      }
+
+  declEvaluate _ _ expr = case expr of
+    TC.AST.PSL pslString ->
+      left EvaluationError.ParseError $
+        makeEntity <$> Parsec.parse Wasp.Psl.Parser.Model.body "" pslString
+    _ -> Left $ EvaluationError.ExpectedType (Type.QuoterType "psl") (TC.AST.exprType expr)

waspc/src/Wasp/Analyzer/TypeDefinitions/TH/Decl.hs

@@ -17,7 +17,6 @@ import Wasp.Analyzer.TypeDefinitions (DeclType (..), EnumType (..), IsDeclType (
 import Wasp.Analyzer.TypeDefinitions.TH.Common
 import Wasp.AppSpec.Core.Decl (makeDecl)
 import Wasp.AppSpec.Core.Ref (Ref)
-import qualified Wasp.AppSpec.Entity as AppSpec.Entity
 import qualified Wasp.AppSpec.ExtImport as AppSpec.ExtImport
 import qualified Wasp.AppSpec.JSON as AppSpec.JSON
 
@@ -201,7 +200,6 @@ genWaspTypeFromHaskellType typ =
     KList elemType -> [|T.ListType $(genWaspTypeFromHaskellType elemType)|]
     KImport -> [|T.ExtImportType|]
     KJSON -> [|T.QuoterType "json"|]
-    KPSL -> [|T.QuoterType "psl"|]
     KDeclRef t -> [|T.DeclType $ dtName $ declType @ $(pure t)|]
     KEnum -> [|T.EnumType $ etName $ enumType @ $(pure typ)|]
     KOptional _ -> fail "Maybe is only allowed in record fields"
@@ -219,7 +217,6 @@ genEvaluationExprForHaskellType typ =
     KList elemType -> [|list $(genEvaluationExprForHaskellType elemType)|]
     KImport -> [|extImport|]
     KJSON -> [|json|]
-    KPSL -> [|psl|]
     KDeclRef t -> [|declRef @ $(pure t)|]
     KEnum -> [|enum @ $(pure typ)|]
     KOptional _ -> fail "Maybe is only allowed in record fields"
@@ -244,7 +241,6 @@ waspKindOfType typ = do
           | name == ''Bool -> pure KBool
           | name == ''AppSpec.ExtImport.ExtImport -> pure KImport
           | name == ''AppSpec.JSON.JSON -> pure KJSON
-          | name == ''AppSpec.Entity.PSL -> pure KPSL
         ListT `AppT` elemType -> pure (KList elemType)
         ConT name `AppT` elemType | name == ''Maybe -> pure (KOptional elemType)
         _ -> Nothing
@@ -280,7 +276,6 @@ data WaspKind
   | KList Type
   | KImport
   | KJSON
-  | KPSL
   | -- | Reference to a declaration type @Type@.
     KDeclRef Type
   | KEnum

waspc/src/Wasp/AppSpec/App.hs

@@ -5,9 +5,9 @@ module Wasp.AppSpec.App (App (..)) where
 import Data.Data (Data)
 import Wasp.AppSpec.App.Auth (Auth)
 import Wasp.AppSpec.App.Db (Db)
+import Wasp.AppSpec.App.Dependency (Dependency)
 import Wasp.AppSpec.App.Server (Server)
 import Wasp.AppSpec.Core.Decl (IsDecl)
-import Wasp.AppSpec.JSON (JSON)
 
 data App = App
   { title :: String,
@@ -16,11 +16,21 @@ data App = App
     server :: Maybe Server, -- NOTE: This is new. Before, `server` was a standalone declaration.
     db :: Maybe Db, -- NOTE: This is new. Before, `db` was a standalone declaration.
 
-    -- | TODO: In current Wasp, we have a more sophisticated AST here: not just JSON, but [NpmDependency].
-    -- We should look into this here, figure out how we can go about it and also have such more advanced
-    -- representation here. Question is, where does this parsing from JSON to [NpmDependency] happen?
-    -- Or is it just Dependency? Should we have NpmDependencies below instead of Dependencies?
-    dependencies :: Maybe JSON -- NOTE: This is new. Before, `dependencies` was a standalone declaration.
+    -- | NOTE: This is new. Before, `dependencies` was a standalone declaration and it was a {=json json=},
+    -- while now it is a [{ name :: String, version :: String }].
+    -- TODO: We might want to look into making this nicer in the future
+    -- -> maybe change how it is represented in the wasp lang, e.g. make it just a list of strings,
+    -- while here it would still be what it is or it would be parsed even more.
+    -- We could make this work by supporting manual definition of how Dependency evaluates / what is its type.
+    -- So, similar like we have IsDeclType instance for declarations, we could have similar abstraction for
+    -- sub-types like these, and we would inject it into Analyzer and it would be defined manually.
+    -- A way this might work: in Evaluator, we would check when the type matches the one we have this custom logic for,
+    -- probably in the function that figures out the Kind of the type, and then we would based on that use
+    -- evaluator provided for that type. This means we can provide this custom sort of logic per specific type from
+    -- AppSpec, but not for type + context in which it is. However, that should be enough, I don't think that is a problem.
+    -- If knowledge of context is important then it is best to just manually define the parent type's evaluation.
+    --   TODO: Make a github issue for this (TODO above)?
+    dependencies :: Maybe [Dependency]
   }
   deriving (Show, Eq, Data)
 

waspc/src/Wasp/AppSpec/App/Dependency.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Wasp.AppSpec.App.Dependency
+  ( Dependency (..),
+  )
+where
+
+import Data.Data (Data)
+
+data Dependency = Dependency
+  { name :: String,
+    version :: String
+  }
+  deriving (Show, Eq, Data)

waspc/src/Wasp/AppSpec/Entity.hs

@@ -1,19 +1,40 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
-module Wasp.AppSpec.Entity (Entity (..), PSL (..)) where
+module Wasp.AppSpec.Entity
+  ( makeEntity,
+    Entity,
+    getFields,
+    getPslModelBody,
+  )
+where
 
 import Data.Data (Data)
 import Wasp.AppSpec.Core.Decl (IsDecl)
+import Wasp.AppSpec.Entity.Field (Field)
+import qualified Wasp.AppSpec.Entity.Field as Field
+import qualified Wasp.Psl.Ast.Model as PslModel
 
--- | TODO: Entity should be much more complex, it should not be just String, instead it should be
--- whole AST that describes the entity schema.
--- We should take a look at what entity looks like Wasp.Wasp.Entity and replicate that.
--- Most challenging part will be parsing PSL from string into PSL.Ast.Model and then
--- building Entity based on that. We actually have all that logic already, we just need to plug it in
--- in the right places and that should be it.
-data Entity = Entity PSL
+data Entity = Entity
+  { fields :: ![Field],
+    pslModelBody :: !PslModel.Body
+  }
   deriving (Show, Eq, Data)
 
 instance IsDecl Entity
 
-newtype PSL = PSL String deriving (Eq, Show, Data)
+makeEntity :: PslModel.Body -> Entity
+makeEntity body =
+  Entity
+    { fields = makeEntityFieldsFromPslModelBody body,
+      pslModelBody = body
+    }
+  where
+    makeEntityFieldsFromPslModelBody :: PslModel.Body -> [Field]
+    makeEntityFieldsFromPslModelBody (PslModel.Body pslElements) =
+      Field.pslModelFieldToEntityField <$> [field | (PslModel.ElementField field) <- pslElements]
+
+getFields :: Entity -> [Field]
+getFields = fields
+
+getPslModelBody :: Entity -> PslModel.Body
+getPslModelBody = pslModelBody

waspc/src/Wasp/AppSpec/Entity/Field.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Wasp.AppSpec.Entity.Field
+  ( Field (..),
+    FieldType (..),
+    Composite (..),
+    Scalar (..),
+    pslModelFieldToEntityField,
+  )
+where
+
+import Data.Data (Data)
+import qualified Wasp.Psl.Ast.Model as PslModel
+
+data Field = Field
+  { fieldName :: !String,
+    fieldType :: !FieldType
+  }
+  deriving (Show, Eq, Data)
+
+data FieldType = FieldTypeScalar Scalar | FieldTypeComposite Composite
+  deriving (Show, Eq, Data)
+
+data Composite = Optional Scalar | List Scalar
+  deriving (Show, Eq, Data)
+
+data Scalar
+  = String
+  | Boolean
+  | Int
+  | BigInt
+  | Float
+  | Decimal
+  | DateTime
+  | Json
+  | Bytes
+  | -- | Name of the user-defined type.
+    -- This could be another entity, or maybe an enum,
+    -- we don't know here yet.
+    UserType String
+  | Unsupported String
+  deriving (Show, Eq, Data)
+
+pslModelFieldToEntityField :: PslModel.Field -> Field
+pslModelFieldToEntityField pslField =
+  Field
+    { fieldName = PslModel._name pslField,
+      fieldType =
+        pslFieldTypeToEntityFieldType
+          (PslModel._type pslField)
+          (PslModel._typeModifiers pslField)
+    }
+  where
+    pslFieldTypeToEntityFieldType :: PslModel.FieldType -> [PslModel.FieldTypeModifier] -> FieldType
+    pslFieldTypeToEntityFieldType fType fTypeModifiers =
+      let scalar = pslFieldTypeToScalar fType
+       in case fTypeModifiers of
+            [] -> FieldTypeScalar scalar
+            [PslModel.List] -> FieldTypeComposite $ List scalar
+            [PslModel.Optional] -> FieldTypeComposite $ Optional scalar
+            _ -> error "Not a valid list of modifiers."
+
+    pslFieldTypeToScalar :: PslModel.FieldType -> Scalar
+    pslFieldTypeToScalar fType = case fType of
+      PslModel.String -> String
+      PslModel.Boolean -> Boolean
+      PslModel.Int -> Int
+      PslModel.BigInt -> BigInt
+      PslModel.Float -> Float
+      PslModel.Decimal -> Decimal
+      PslModel.DateTime -> DateTime
+      PslModel.Json -> Json
+      PslModel.Bytes -> Bytes
+      PslModel.UserType typeName -> UserType typeName
+      PslModel.Unsupported typeName -> Unsupported typeName

waspc/src/Wasp/Psl/Ast/Model.hs

@@ -1,5 +1,9 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
 module Wasp.Psl.Ast.Model where
 
+import Data.Data (Data)
+
 data Model
   = Model
       String
@@ -8,10 +12,10 @@ data Model
   deriving (Show, Eq)
 
 newtype Body = Body [Element]
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 data Element = ElementField Field | ElementBlockAttribute Attribute
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 -- TODO: To support attributes before the field,
 --   we could just have `attrsBefore :: [[Attr]]`,
@@ -22,7 +26,7 @@ data Field = Field
     _typeModifiers :: [FieldTypeModifier],
     _attrs :: [Attribute]
   }
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 data FieldType
   = String
@@ -36,10 +40,10 @@ data FieldType
   | Bytes
   | Unsupported String
   | UserType String
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 data FieldTypeModifier = List | Optional
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 -- NOTE: We don't differentiate "native database type" attributes from normal attributes right now,
 --   they are all represented with `data Attribute`.
@@ -50,10 +54,10 @@ data Attribute = Attribute
   { _attrName :: String,
     _attrArgs :: [AttributeArg]
   }
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 data AttributeArg = AttrArgNamed String AttrArgValue | AttrArgUnnamed AttrArgValue
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 data AttrArgValue
   = AttrArgString String
@@ -62,4 +66,4 @@ data AttrArgValue
   | AttrArgFieldRefList [String]
   | AttrArgNumber String
   | AttrArgUnknown String
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)

waspc/test/Analyzer/EvaluatorTest.hs

@@ -14,7 +14,6 @@ import qualified Wasp.Analyzer.TypeDefinitions as TD
 import Wasp.Analyzer.TypeDefinitions.TH
 import Wasp.AppSpec.Core.Decl (IsDecl)
 import Wasp.AppSpec.Core.Ref (Ref (..))
-import Wasp.AppSpec.Entity (PSL (..))
 import Wasp.AppSpec.ExtImport (ExtImport (..), ExtImportName (..))
 import Wasp.AppSpec.JSON (JSON (..))
 
@@ -44,7 +43,7 @@ data BusinessType = Manufacturer | Seller | Store deriving (Eq, Show, Data)
 
 makeEnumType ''BusinessType
 
-data Special = Special {imps :: [ExtImport], json :: JSON, psl :: PSL} deriving (Eq, Show)
+data Special = Special {imps :: [ExtImport], json :: JSON} deriving (Eq, Show)
 
 instance IsDecl Special
 
@@ -105,13 +104,12 @@ spec_Evaluator = do
                   }
               )
             ]
-      it "Evaluates ExtImports, JSON, and PSL" $ do
+      it "Evaluates ExtImports and JSON" $ do
         let typeDefs = TD.addDeclType @Special $ TD.empty
         let source =
               [ "special Test {",
                 "  imps: [import { field } from \"main.js\", import main from \"main.js\"],",
-                "  json: {=json \"key\": 1 json=},",
-                "  psl: {=psl ID Int psl=}",
+                "  json: {=json \"key\": 1 json=}",
                 "}"
               ]
         fmap takeDecls (eval typeDefs source)
@@ -120,6 +118,5 @@ spec_Evaluator = do
                 Special
                   [ExtImport (ExtImportField "field") "main.js", ExtImport (ExtImportModule "main") "main.js"]
                   (JSON " \"key\": 1 ")
-                  (PSL " ID Int ")
               )
             ]

waspc/test/AnalyzerTest.hs

@@ -12,18 +12,19 @@ import Wasp.AppSpec.App (App)
 import qualified Wasp.AppSpec.App as App
 import qualified Wasp.AppSpec.App.Auth as Auth
 import qualified Wasp.AppSpec.App.Db as Db
+import qualified Wasp.AppSpec.App.Dependency as Dependency
 import qualified Wasp.AppSpec.App.Server as Server
 import Wasp.AppSpec.Core.Ref (Ref (..))
 import Wasp.AppSpec.Entity (Entity)
 import qualified Wasp.AppSpec.Entity as Entity
 import Wasp.AppSpec.ExtImport (ExtImport (..), ExtImportName (..))
-import Wasp.AppSpec.JSON (JSON (..))
 import Wasp.AppSpec.Page (Page)
 import qualified Wasp.AppSpec.Page as Page
 import Wasp.AppSpec.Query (Query)
 import qualified Wasp.AppSpec.Query as Query
 import Wasp.AppSpec.Route (Route)
 import qualified Wasp.AppSpec.Route as Route
+import qualified Wasp.Psl.Ast.Model as PslModel
 
 spec_Analyzer :: Spec
 spec_Analyzer = do
@@ -38,9 +39,9 @@ spec_Analyzer = do
                 "    userEntity: User,",
                 "    methods: [EmailAndPassword],",
                 "  },",
-                "  dependencies: {=json",
-                "    \"redux\": \"^4.0.5\"",
-                "  json=},",
+                "  dependencies: [",
+                "    { name: \"redux\", version: \"^4.0.5\" }",
+                "  ],",
                 "  server: {",
                 "    setupFn: import { setupServer } from \"@ext/bar.js\"",
                 "  },",
@@ -49,7 +50,9 @@ spec_Analyzer = do
                 "  }",
                 "}",
                 "",
-                "entity User {=psl test psl=}",
+                "entity User {=psl",
+                "  description String",
+                "psl=}",
                 "",
                 "page HomePage {",
                 "  component: import Home from \"@ext/pages/Main\"",
@@ -88,7 +91,10 @@ spec_Analyzer = do
                             Auth.methods = [Auth.EmailAndPassword],
                             Auth.onAuthFailedRedirectTo = Nothing
                           },
-                    App.dependencies = Just $ JSON "\n    \"redux\": \"^4.0.5\"\n  ",
+                    App.dependencies =
+                      Just
+                        [ Dependency.Dependency {Dependency.name = "redux", Dependency.version = "^4.0.5"}
+                        ],
                     App.server =
                       Just
                         Server.Server
@@ -118,7 +124,16 @@ spec_Analyzer = do
 
       let expectedEntities =
             [ ( "User",
-                Entity.Entity (Entity.PSL " test ")
+                Entity.makeEntity $
+                  PslModel.Body
+                    [ PslModel.ElementField $
+                        PslModel.Field
+                          { PslModel._name = "description",
+                            PslModel._type = PslModel.String,
+                            PslModel._typeModifiers = [],
+                            PslModel._attrs = []
+                          }
+                    ]
               )
             ]
       takeDecls @Entity <$> decls `shouldBe` Right expectedEntities