Inject Prisma models into the Wasp AST

waspc/src/Wasp/AI/GenerateNewProject/WaspFile.hs

@@ -29,6 +29,7 @@ import Wasp.AI.GenerateNewProject.Plan (Plan)
 import Wasp.AI.OpenAI.ChatGPT (ChatMessage (..), ChatRole (..))
 import Wasp.Analyzer.Parser.Ctx (Ctx (..))
 import Wasp.Project.Analyze (analyzeWaspFileContent)
+import qualified Wasp.Psl.Ast.Schema as Psl.Ast
 import qualified Wasp.Util.Aeson as Utils.Aeson
 
 fixWaspFile :: NewProjectDetails -> FilePath -> Plan -> CodeAgent ()
@@ -159,8 +160,8 @@ data ShouldContinueIfCompileErrors = OnlyIfCompileErrors | EvenIfNoCompileErrors
 
 getWaspFileCompileErrors :: Text -> IO [String]
 getWaspFileCompileErrors waspSource =
-  -- TODO: analyzeWaspFileContent should get the schema.prisma file from the project root
-  analyzeWaspFileContent [] (T.unpack waspSource)
+  -- TODO: analyzeWaspFileContent should receive the Prisma Schema AST
+  analyzeWaspFileContent (Psl.Ast.Schema []) (T.unpack waspSource)
     <&> either (map showCompileError) (const [])
   where
     showCompileError (errMsg, Ctx {ctxSourceRegion = loc}) = show loc <> ": " <> errMsg

waspc/src/Wasp/Analyzer.hs

@@ -121,19 +121,20 @@ import Control.Arrow (left)
 import Control.Monad ((>=>))
 import Wasp.Analyzer.AnalyzeError
   ( AnalyzeError (..),
-    SourcePosition (..),
     getErrorMessageAndCtx,
   )
 import Wasp.Analyzer.Evaluator (Decl, evaluate, takeDecls)
 import Wasp.Analyzer.Parser (parseStatements)
+import Wasp.Analyzer.Prisma (injectEntitiesFromPrismaSchema)
 import Wasp.Analyzer.StdTypeDefinitions (stdTypes)
 import Wasp.Analyzer.TypeChecker (typeCheck)
-import qualified Wasp.AppSpec as AS
+import qualified Wasp.Psl.Ast.Schema as Psl.Ast
 
 -- | Takes a Wasp source file and produces a list of declarations or a
 --   description of an error in the source file.
-analyze :: [AS.Decl] -> String -> Either [AnalyzeError] [Decl]
-analyze entities =
-  left (map ParseError) . parseStatements
-    >=> left ((: []) . TypeError) . typeCheck stdTypes entities
-    >=> left ((: []) . EvaluationError) . evaluate stdTypes
+analyze :: Psl.Ast.Schema -> String -> Either [AnalyzeError] [Decl]
+analyze prismaSchemaAst =
+  (left (map ParseError) . parseStatements)
+    >=> injectEntitiesFromPrismaSchema prismaSchemaAst
+    >=> (left ((: []) . TypeError) . typeCheck stdTypes)
+    >=> (left ((: []) . EvaluationError) . evaluate stdTypes)

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

@@ -38,8 +38,6 @@ data EvaluationError'
     ParseError         EvaluationParseError
   | -- | Not an actual error, but a wrapper that provides additional context.
     WithEvalErrorCtx   EvalErrorCtx EvaluationError
-  | -- | Defining Entities in Wasp file is not allowed.
-    EntitiesNotSupported
   deriving (Show, Eq)
 {- ORMOLU_ENABLE -}
 
@@ -110,7 +108,6 @@ getErrorMsgAndErrorCtxMsgsAndParsingCtx (EvaluationError (WithCtx ctx evalError)
   ParseError (EvaluationParseErrorParsec e) -> makeMainMsg ("Parse error:\n" ++ indent 2 (show e))
   ParseError (EvaluationParseError msg) -> makeMainMsg ("Parse error:\n" ++ indent 2 msg)
   WithEvalErrorCtx evalCtx subError -> second3 (evalCtxMsg evalCtx :) $ getErrorMsgAndErrorCtxMsgsAndParsingCtx subError
-  EntitiesNotSupported -> makeMainMsg "Defining Entities in Wasp file is not supported anymore."
   where
     makeMainMsg msg = (msg, [], ctx)
 

waspc/src/Wasp/Analyzer/Prisma.hs

@@ -0,0 +1,30 @@
+module Wasp.Analyzer.Prisma where
+
+import Wasp.Analyzer.Parser as Parser
+import qualified Wasp.Psl.Ast.Schema as Psl.Ast
+import qualified Wasp.Psl.Generator.Schema as Psl.Generator
+
+injectEntitiesFromPrismaSchema :: Psl.Ast.Schema -> Parser.AST -> Either a Parser.AST
+injectEntitiesFromPrismaSchema schema ast = Right $ ast {Parser.astStmts = stmts ++ entityStmts}
+  where
+    entityStmts = makeEntityStmt <$> generatePrismaModels schema
+    stmts = Parser.astStmts ast
+
+makeEntityStmt :: (String, String) -> WithCtx Parser.Stmt
+makeEntityStmt (name, body) = wrapWithCtx $ Parser.Decl "entity" name $ wrapWithCtx $ Parser.Quoter "psl" body
+  where
+    wrapWithCtx = WithCtx (Ctx mockSourceRegion)
+    -- Since we didn't parse the entities from the Wasp source file
+    -- we don't have a real source region.
+    -- TODO: In the future, it would be nice to have the source region
+    -- of the entity from the Prisma schema file.
+    mockSourceRegion = SourceRegion (SourcePosition 0 0) (SourcePosition 0 0)
+
+-- | Generates Prisma models source code so that it can be injected into Wasp AST.
+generatePrismaModels :: Psl.Ast.Schema -> [(String, String)]
+generatePrismaModels schema =
+  [ ( name,
+      Psl.Generator.generateModelBody body
+    )
+    | (Psl.Ast.Model name body) <- Psl.Ast.getModels schema
+  ]

waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs

@@ -17,6 +17,7 @@ import Wasp.AppSpec.App (App)
 import Wasp.AppSpec.App.Db (DbSystem)
 import Wasp.AppSpec.App.EmailSender (EmailProvider)
 import Wasp.AppSpec.Crud (Crud)
+import Wasp.AppSpec.Entity (Entity)
 import Wasp.AppSpec.Job (Job, JobExecutor)
 import Wasp.AppSpec.Page (Page)
 import Wasp.AppSpec.Query (Query)
@@ -48,6 +49,7 @@ stdTypes :: TD.TypeDefinitions
 stdTypes =
   TD.addDeclType @App $
   TD.addEnumType @DbSystem $
+  TD.addDeclType @Entity $
   TD.addDeclType @Page $
   TD.addDeclType @Route $
   TD.addDeclType @Query $

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

@@ -3,22 +3,27 @@
 
 module Wasp.Analyzer.StdTypeDefinitions.Entity () where
 
+import Control.Arrow (left)
 import Wasp.Analyzer.Evaluator.EvaluationError (mkEvaluationError)
 import qualified Wasp.Analyzer.Evaluator.EvaluationError as ER
 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)
+import Wasp.AppSpec.Entity (Entity, makeEntity)
+import qualified Wasp.Psl.Parser.Model
 
 instance IsDeclType Entity where
   declType =
     DeclType
       { dtName = "entity",
-        -- TODO: I'm not sure what should be do with this. I'm just returning BoolType for now.
-        dtBodyType = Type.BoolType,
+        dtBodyType = Type.QuoterType "psl",
         dtEvaluate = \typeDefinitions bindings declName expr ->
           Decl.makeDecl @Entity declName <$> declEvaluate typeDefinitions bindings expr
       }
 
-  declEvaluate _ _ (TC.AST.WithCtx ctx _) = Left $ mkEvaluationError ctx ER.EntitiesNotSupported
+  declEvaluate _ _ (TC.AST.WithCtx ctx expr) = case expr of
+    TC.AST.PSL pslString ->
+      left (ER.mkEvaluationError ctx . ER.ParseError . ER.EvaluationParseErrorParsec) $
+        makeEntity <$> Wasp.Psl.Parser.Model.parsePslBody pslString
+    _ -> Left $ mkEvaluationError ctx $ ER.ExpectedType (Type.QuoterType "psl") (TC.AST.exprType expr)

waspc/src/Wasp/Analyzer/TypeChecker.hs

@@ -25,7 +25,6 @@ module Wasp.Analyzer.TypeChecker
   )
 where
 
-import qualified Wasp.Analyzer.Evaluator as AS
 import Wasp.Analyzer.Parser.AST (AST)
 import Wasp.Analyzer.TypeChecker.AST
 import Wasp.Analyzer.TypeChecker.Internal (check)
@@ -35,5 +34,5 @@ import Wasp.Analyzer.TypeDefinitions (TypeDefinitions)
 
 -- | Checks that an AST conforms to the type rules of Wasp and produces
 --   an AST labelled with type information.
-typeCheck :: TypeDefinitions -> [AS.Decl] -> AST -> Either TypeError TypedAST
-typeCheck typeDefs entities ast = run typeDefs $ check ast entities
+typeCheck :: TypeDefinitions -> AST -> Either TypeError TypedAST
+typeCheck typeDefs ast = run typeDefs $ check ast

waspc/src/Wasp/Analyzer/TypeChecker/AST.hs

@@ -34,6 +34,7 @@ data TypedExpr
   | Var            Identifier Type
   | -- TODO: When adding quoters to TypeDefinitions, these JSON/PSL variants will have to be changed
     JSON           String
+  | PSL            String
   deriving (Eq, Show)
 {- ORMOLU_ENABLE -}
 
@@ -49,3 +50,4 @@ exprType (BoolLiteral _) = BoolType
 exprType (ExtImport _ _) = ExtImportType
 exprType (Var _ t) = t
 exprType (JSON _) = QuoterType "json"
+exprType (PSL _) = QuoterType "psl"

waspc/src/Wasp/Analyzer/TypeChecker/Internal.hs

@@ -39,40 +39,25 @@ import Control.Monad (foldM)
 import qualified Data.HashMap.Strict as M
 import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.Maybe (fromJust)
-import qualified Wasp.Analyzer.Evaluator as AS
 import Wasp.Analyzer.Parser (AST)
 import qualified Wasp.Analyzer.Parser as P
 import Wasp.Analyzer.Type
 import Wasp.Analyzer.TypeChecker.AST
 import Wasp.Analyzer.TypeChecker.Monad
 import Wasp.Analyzer.TypeChecker.TypeError
 import qualified Wasp.Analyzer.TypeDefinitions as TD
-import Wasp.AppSpec.Core.Decl (fromDecl)
-import qualified Wasp.AppSpec.Entity as AS.Entity
 import Wasp.Util.Control.Monad (foldMapM')
 
-check :: AST -> [AS.Decl] -> TypeChecker TypedAST
-check ast entities = hoistDeclarations ast entities >> checkAST ast
+check :: AST -> TypeChecker TypedAST
+check ast = hoistDeclarations ast >> checkAST ast
 
-hoistDeclarations :: AST -> [AS.Decl] -> TypeChecker ()
-hoistDeclarations (P.AST stmts) entities = do
-  mapM_ hoistDeclaration stmts
-  mapM_ setEntityAsType entities
+hoistDeclarations :: AST -> TypeChecker ()
+hoistDeclarations (P.AST stmts) = mapM_ hoistDeclaration stmts
   where
     hoistDeclaration :: P.WithCtx P.Stmt -> TypeChecker ()
     hoistDeclaration (P.WithCtx _ (P.Decl typeName ident _)) =
       setType ident $ DeclType typeName
 
-    setEntityAsType :: AS.Decl -> TypeChecker ()
-    setEntityAsType decl = setType (fst entity) entityDeclType
-      where
-        entity :: (String, AS.Entity.Entity)
-        entity = fromJust $ fromDecl decl
-
-    -- Ideally we would do this:
-    -- entityDeclType = DeclType $ TD.dtName $ TD.declType @Entity
-    entityDeclType = DeclType "entity"
-
 checkAST :: AST -> TypeChecker TypedAST
 checkAST (P.AST stmts) = TypedAST <$> mapM checkStmt stmts
 
@@ -104,6 +89,7 @@ inferExprType = P.withCtx $ \ctx -> \case
   -- For now, the two quoter types are hardcoded here, it is an error to use a different one
   -- TODO: this will change when quoters are added to "Analyzer.TypeDefinitions".
   P.Quoter "json" s -> return $ WithCtx ctx $ JSON s
+  P.Quoter "psl" s -> return $ WithCtx ctx $ PSL s
   P.Quoter tag _ -> throw $ mkTypeError ctx $ QuoterUnknownTag tag
   -- The type of a list is the unified type of its values.
   -- This poses a problem for empty lists, there is not enough information to choose a type.

waspc/src/Wasp/AppSpec.hs

@@ -61,8 +61,6 @@ import qualified Wasp.SemanticVersion as SV
 data AppSpec = AppSpec
   { -- | List of declarations like App, Page, Route, ... that describe the web app.
     decls :: [Decl],
-    -- | List of Prisma entities that are defined by the user.
-    entities :: [Decl],
     -- | Parsed Prisma schema file.
     prismaSchema :: Psl.Ast.Schema,
     -- | The contents of the package.json file found in the root directory of the wasp project.
@@ -98,11 +96,8 @@ data AppSpec = AppSpec
 getDecls :: IsDecl a => AppSpec -> [(String, a)]
 getDecls = takeDecls . decls
 
-getDeclsWithEntities :: IsDecl a => AppSpec -> [(String, a)]
-getDeclsWithEntities spec = takeDecls (decls spec ++ entities spec)
-
 getEntities :: AppSpec -> [(String, Entity)]
-getEntities = takeDecls . entities
+getEntities = getDecls
 
 getQueries :: AppSpec -> [(String, Query)]
 getQueries = getDecls
@@ -151,7 +146,7 @@ resolveRef spec ref =
           ++ " This should never happen, as Analyzer should ensure all references in AppSpec are valid."
     )
     $ find ((== refName ref) . fst) $
-      getDeclsWithEntities spec
+      getDecls spec
 
 doesConfigFileExist :: AppSpec -> Path' (Rel WaspProjectDir) File' -> Bool
 doesConfigFileExist spec file =

waspc/src/Wasp/AppSpec/Valid.hs

@@ -281,7 +281,7 @@ validateUniqueDeclarationNames spec =
       checkIfDeclarationsAreUnique "api" (AS.getApis spec),
       checkIfDeclarationsAreUnique "apiNamespace" (AS.getApiNamespaces spec),
       checkIfDeclarationsAreUnique "crud" (AS.getCruds spec),
-      -- checkIfDeclarationsAreUnique "entity" (AS.getEntities spec),
+      checkIfDeclarationsAreUnique "entity" (AS.getEntities spec),
       checkIfDeclarationsAreUnique "job" (AS.getJobs spec)
     ]
   where
@@ -341,45 +341,6 @@ validateDeclarationNames spec =
                     ++ "."
               ]
 
--- validatePrismaOptions :: AppSpec -> [ValidationError]
--- validatePrismaOptions spec =
---   concat
---     [ checkIfPostgresExtensionsAreUsedWithoutPostgresDbSystem,
---       checkIfDbExtensionsAreUsedWithoutPostgresDbSystem,
---       checkIfDbExtensionsAreUsedWithoutPostgresPreviewFlag
---     ]
---   where
---     checkIfPostgresExtensionsAreUsedWithoutPostgresDbSystem :: [ValidationError]
---     checkIfPostgresExtensionsAreUsedWithoutPostgresDbSystem = maybe [] check prismaClientPreviewFeatures
---       where
---         check :: [String] -> [ValidationError]
---         check previewFeatures =
---           if not isPostgresDbUsed && "postgresqlExtensions" `elem` previewFeatures
---             then [GenericValidationError "You enabled \"postgresqlExtensions\" in app.db.prisma.clientPreviewFeatures but your db system is not PostgreSQL."]
---             else []
-
---     checkIfDbExtensionsAreUsedWithoutPostgresDbSystem :: [ValidationError]
---     checkIfDbExtensionsAreUsedWithoutPostgresDbSystem = maybe [] check prismaDbExtensions
---       where
---         check :: [AS.Db.PrismaDbExtension] -> [ValidationError]
---         check value =
---           if not isPostgresDbUsed && not (null value)
---             then [GenericValidationError "If you are using app.db.prisma.dbExtensions you must use PostgreSQL as your db system."]
---             else []
-
---     checkIfDbExtensionsAreUsedWithoutPostgresPreviewFlag :: [ValidationError]
---     checkIfDbExtensionsAreUsedWithoutPostgresPreviewFlag = case (prismaDbExtensions, prismaClientPreviewFeatures) of
---       (Nothing, _) -> []
---       (Just _extensions, Just features) | "postgresqlExtensions" `elem` features -> []
---       (Just _extensions, _) -> [GenericValidationError extensionsNotEnabledMessage]
---       where
---         extensionsNotEnabledMessage = "You are using app.db.prisma.dbExtensions but you didn't enable \"postgresqlExtensions\" in app.db.prisma.clientPreviewFeatures."
-
---     isPostgresDbUsed = isPostgresUsed spec
---     prismaOptions = AS.Db.prisma =<< AS.App.db (snd $ getApp spec)
---     prismaClientPreviewFeatures = AS.Db.clientPreviewFeatures =<< prismaOptions
---     prismaDbExtensions = AS.Db.dbExtensions =<< prismaOptions
-
 validateWebAppBaseDir :: AppSpec -> [ValidationError]
 validateWebAppBaseDir spec = case maybeBaseDir of
   Just baseDir

waspc/src/Wasp/Generator/DbGenerator.hs

@@ -69,7 +69,7 @@ genPrismaSchema spec = do
   let templateData =
         object
           [ "modelSchemas" .= (entityToPslModelSchema <$> entities),
-            "enumSchemas" .= (Psl.Generator.Schema.generateSchemaElement <$> enums),
+            "enumSchemas" .= enumSchemas,
             "datasourceProvider" .= datasourceProvider,
             "datasourceUrl" .= datasourceUrl,
             "prismaPreviewFeatures" .= prismaPreviewFeatures,
@@ -90,8 +90,7 @@ genPrismaSchema spec = do
       Psl.Generator.Schema.generateSchemaElement $
         Psl.Ast.SchemaModel $ Psl.Ast.Model entityName (AS.Entity.getPslModelBody entity)
 
-    (Psl.Ast.Schema elements) = AS.getPrismaSchema spec
-    enums = [Psl.Ast.SchemaEnum enum | Psl.Ast.SchemaEnum enum <- elements]
+    enumSchemas = Psl.Generator.Schema.generateSchemaElement . Psl.Ast.SchemaEnum <$> (Psl.Ast.getEnums . AS.getPrismaSchema $ spec)
 
 -- | Returns a list of entities that should be included in the Prisma schema.
 -- We put user defined entities as well as inject auth entities into the Prisma schema.