From aea13d35b7d3a4c97dde2593df9865fc63fae95d Mon Sep 17 00:00:00 2001 From: Mihovil Ilakovac Date: Sat, 25 May 2024 07:52:40 +0200 Subject: [PATCH] Inject Prisma models into the Wasp AST --- .../Wasp/AI/GenerateNewProject/WaspFile.hs | 5 ++- waspc/src/Wasp/Analyzer.hs | 14 +++--- .../Analyzer/Evaluator/EvaluationError.hs | 3 -- waspc/src/Wasp/Analyzer/Prisma.hs | 30 +++++++++++++ waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs | 2 + .../Analyzer/StdTypeDefinitions/Entity.hs | 13 ++++-- waspc/src/Wasp/Analyzer/TypeChecker.hs | 5 +-- waspc/src/Wasp/Analyzer/TypeChecker/AST.hs | 2 + .../src/Wasp/Analyzer/TypeChecker/Internal.hs | 24 +++-------- waspc/src/Wasp/AppSpec.hs | 9 +--- waspc/src/Wasp/AppSpec/Valid.hs | 41 +----------------- waspc/src/Wasp/Generator/DbGenerator.hs | 5 +-- waspc/src/Wasp/Project/Analyze.hs | 37 +++++----------- waspc/src/Wasp/Psl/Ast/Schema.hs | 20 +++++++++ waspc/src/Wasp/Psl/Generator/ConfigBlock.hs | 29 ++++++------- waspc/src/Wasp/Psl/Generator/Schema.hs | 1 + waspc/test/Analyzer/EvaluatorTest.hs | 2 +- .../test/Analyzer/TypeChecker/InternalTest.hs | 2 +- waspc/test/Analyzer/TypeCheckerTest.hs | 10 ++--- waspc/test/AnalyzerTest.hs | 43 +++++++++---------- waspc/test/AppSpec/ValidTest.hs | 1 - waspc/test/Generator/WebAppGeneratorTest.hs | 1 - waspc/waspc.cabal | 1 + waspc/waspls/src/Wasp/LSP/Analysis.hs | 6 +-- waspc/waspls/src/Wasp/LSP/DynamicHandlers.hs | 2 +- waspc/waspls/src/Wasp/LSP/Prisma/Analyze.hs | 14 +++--- waspc/waspls/src/Wasp/LSP/Prisma/Util.hs | 12 +++--- waspc/waspls/src/Wasp/LSP/Server.hs | 5 ++- waspc/waspls/src/Wasp/LSP/ServerState.hs | 8 ++-- 29 files changed, 163 insertions(+), 184 deletions(-) create mode 100644 waspc/src/Wasp/Analyzer/Prisma.hs diff --git a/waspc/src/Wasp/AI/GenerateNewProject/WaspFile.hs b/waspc/src/Wasp/AI/GenerateNewProject/WaspFile.hs index 7cfe10a14c..c4164bf990 100644 --- a/waspc/src/Wasp/AI/GenerateNewProject/WaspFile.hs +++ b/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 diff --git a/waspc/src/Wasp/Analyzer.hs b/waspc/src/Wasp/Analyzer.hs index a3f7792991..5dd06ca79d 100644 --- a/waspc/src/Wasp/Analyzer.hs +++ b/waspc/src/Wasp/Analyzer.hs @@ -126,14 +126,16 @@ import Wasp.Analyzer.AnalyzeError ) 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) diff --git a/waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs b/waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs index 273dcea294..0186baf656 100644 --- a/waspc/src/Wasp/Analyzer/Evaluator/EvaluationError.hs +++ b/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) diff --git a/waspc/src/Wasp/Analyzer/Prisma.hs b/waspc/src/Wasp/Analyzer/Prisma.hs new file mode 100644 index 0000000000..0864b02171 --- /dev/null +++ b/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 + ] diff --git a/waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs b/waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs index 3bc365c7ce..7e005d89f0 100644 --- a/waspc/src/Wasp/Analyzer/StdTypeDefinitions.hs +++ b/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 $ diff --git a/waspc/src/Wasp/Analyzer/StdTypeDefinitions/Entity.hs b/waspc/src/Wasp/Analyzer/StdTypeDefinitions/Entity.hs index 5ec1f333b0..d452399cc2 100644 --- a/waspc/src/Wasp/Analyzer/StdTypeDefinitions/Entity.hs +++ b/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) diff --git a/waspc/src/Wasp/Analyzer/TypeChecker.hs b/waspc/src/Wasp/Analyzer/TypeChecker.hs index cfd87997f6..d0265cf80b 100644 --- a/waspc/src/Wasp/Analyzer/TypeChecker.hs +++ b/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 diff --git a/waspc/src/Wasp/Analyzer/TypeChecker/AST.hs b/waspc/src/Wasp/Analyzer/TypeChecker/AST.hs index d457163c2c..2e8af7e642 100644 --- a/waspc/src/Wasp/Analyzer/TypeChecker/AST.hs +++ b/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" diff --git a/waspc/src/Wasp/Analyzer/TypeChecker/Internal.hs b/waspc/src/Wasp/Analyzer/TypeChecker/Internal.hs index 64619d8931..b7f563b534 100644 --- a/waspc/src/Wasp/Analyzer/TypeChecker/Internal.hs +++ b/waspc/src/Wasp/Analyzer/TypeChecker/Internal.hs @@ -39,7 +39,6 @@ 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 @@ -47,32 +46,18 @@ 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. diff --git a/waspc/src/Wasp/AppSpec.hs b/waspc/src/Wasp/AppSpec.hs index d051494990..3203935d0c 100644 --- a/waspc/src/Wasp/AppSpec.hs +++ b/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 = diff --git a/waspc/src/Wasp/AppSpec/Valid.hs b/waspc/src/Wasp/AppSpec/Valid.hs index 64d72cbb13..e9f46c406b 100644 --- a/waspc/src/Wasp/AppSpec/Valid.hs +++ b/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 diff --git a/waspc/src/Wasp/Generator/DbGenerator.hs b/waspc/src/Wasp/Generator/DbGenerator.hs index 463dd010b9..ba6ba0859f 100644 --- a/waspc/src/Wasp/Generator/DbGenerator.hs +++ b/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. diff --git a/waspc/src/Wasp/Project/Analyze.hs b/waspc/src/Wasp/Project/Analyze.hs index 0f94d5ccf5..210e38706a 100644 --- a/waspc/src/Wasp/Project/Analyze.hs +++ b/waspc/src/Wasp/Project/Analyze.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TypeApplications #-} - module Wasp.Project.Analyze ( analyzeWaspProject, readPackageJsonFile, @@ -18,8 +16,6 @@ import qualified Wasp.Analyzer as Analyzer import Wasp.Analyzer.AnalyzeError (getErrorMessageAndCtx) import Wasp.Analyzer.Parser.Ctx (Ctx) import qualified Wasp.AppSpec as AS -import qualified Wasp.AppSpec.Core.Decl as Decl -import Wasp.AppSpec.Entity (Entity, makeEntity) import Wasp.AppSpec.PackageJson (PackageJson) import Wasp.AppSpec.Valid (isValidationError, isValidationWarning, validateAppSpec) import Wasp.CompileOptions (CompileOptions) @@ -58,34 +54,33 @@ analyzeWaspProject waspDir options = do Right waspFilePath -> analyzePrismaSchema waspDir >>= \case Left errors -> return (Left errors, []) - Right (parsedPrismaSchema, entities) -> - analyzeWaspFile waspFilePath entities >>= \case + Right prismaSchemaAst -> + analyzeWaspFile waspFilePath prismaSchemaAst >>= \case Left errors -> return (Left errors, []) Right declarations -> analyzePackageJsonContent waspDir >>= \case Left errors -> return (Left errors, []) - Right packageJsonContent -> constructAppSpec waspDir options packageJsonContent declarations entities parsedPrismaSchema + Right packageJsonContent -> constructAppSpec waspDir options packageJsonContent declarations prismaSchemaAst where fileNotFoundMessage = "Couldn't find the *.wasp file in the " ++ toFilePath waspDir ++ " directory" -analyzeWaspFile :: Path' Abs File' -> [AS.Decl] -> IO (Either [CompileError] [AS.Decl]) -analyzeWaspFile waspFilePath entities = do +analyzeWaspFile :: Path' Abs File' -> Psl.Ast.Schema -> IO (Either [CompileError] [AS.Decl]) +analyzeWaspFile waspFilePath prismaSchemaAst = do waspFileContent <- IOUtil.readFile waspFilePath left (map $ showCompilerErrorForTerminal (waspFilePath, waspFileContent)) - <$> analyzeWaspFileContent entities waspFileContent + <$> analyzeWaspFileContent prismaSchemaAst waspFileContent -analyzeWaspFileContent :: [AS.Decl] -> String -> IO (Either [(String, Ctx)] [AS.Decl]) -analyzeWaspFileContent entities = return . left (map getErrorMessageAndCtx) . Analyzer.analyze entities +analyzeWaspFileContent :: Psl.Ast.Schema -> String -> IO (Either [(String, Ctx)] [AS.Decl]) +analyzeWaspFileContent prismaSchemaAst = return . left (map getErrorMessageAndCtx) . Analyzer.analyze prismaSchemaAst constructAppSpec :: Path' Abs (Dir WaspProjectDir) -> CompileOptions -> PackageJson -> [AS.Decl] -> - [AS.Decl] -> Psl.Ast.Schema -> IO (Either [CompileError] AS.AppSpec, [CompileWarning]) -constructAppSpec waspDir options packageJson decls entities parsedPrismaSchema = do +constructAppSpec waspDir options packageJson decls parsedPrismaSchema = do externalCodeFiles <- ExternalFiles.readCodeFiles waspDir externalPublicFiles <- ExternalFiles.readPublicFiles waspDir customViteConfigPath <- findCustomViteConfigPath waspDir @@ -100,7 +95,6 @@ constructAppSpec waspDir options packageJson decls entities parsedPrismaSchema = let appSpec = AS.AppSpec { AS.decls = decls, - AS.entities = entities, AS.prismaSchema = parsedPrismaSchema, AS.packageJson = packageJson, AS.waspProjectDir = waspDir, @@ -151,7 +145,7 @@ readPackageJsonFile packageJsonFile = do byteString <- IOUtil.readFileBytes packageJsonFile return $ maybeToEither ["Error parsing the package.json file"] $ Aeson.decode byteString -analyzePrismaSchema :: Path' Abs (Dir WaspProjectDir) -> IO (Either [CompileError] (Psl.Ast.Schema, [AS.Decl])) +analyzePrismaSchema :: Path' Abs (Dir WaspProjectDir) -> IO (Either [CompileError] Psl.Ast.Schema) analyzePrismaSchema waspProjectDir = do prismaSchemaFile <- findPrismaSchemaFile waspProjectDir case prismaSchemaFile of @@ -161,17 +155,8 @@ analyzePrismaSchema waspProjectDir = do case Psl.Parser.parsePrismaSchema prismaSchemaContent of Left err -> return $ Left [err] Right parsedPrismaSchema -> do - let entities = getEntitiesFromPrismaSchema parsedPrismaSchema - return $ Right (parsedPrismaSchema, entities) + return $ Right parsedPrismaSchema Nothing -> return $ Left ["Couldn't find the Prisma schema file in the " ++ toFilePath waspProjectDir ++ " directory"] - where - getEntitiesFromPrismaSchema :: Psl.Ast.Schema -> [AS.Decl] - getEntitiesFromPrismaSchema (Psl.Ast.Schema elements) = - let models = [model | Psl.Ast.SchemaModel model <- elements] - in parsedModelToDecl <$> models - - parsedModelToDecl :: Psl.Ast.Model -> AS.Decl - parsedModelToDecl (Psl.Ast.Model name body) = Decl.makeDecl @Entity name $ makeEntity body findPrismaSchemaFile :: Path' Abs (Dir WaspProjectDir) -> IO (Maybe (Path' Abs File')) findPrismaSchemaFile waspProjectDir = findFileInWaspProjectDir waspProjectDir prismaSchemaFileInWaspProjectDir diff --git a/waspc/src/Wasp/Psl/Ast/Schema.hs b/waspc/src/Wasp/Psl/Ast/Schema.hs index e2bc9719e9..85e9c468a4 100644 --- a/waspc/src/Wasp/Psl/Ast/Schema.hs +++ b/waspc/src/Wasp/Psl/Ast/Schema.hs @@ -47,6 +47,14 @@ data Generator -- ^ Content of the generator deriving (Show, Eq) +-- | Represents a key-value pair in a config block. +-- For example, in the following config block: +-- ``` +-- generator client { +-- provider = "prisma-client-js" +-- } +-- ``` +-- The key-value pair would be `ConfigBlockKeyValue "provider" "prisma-client-js"`. data ConfigBlockKeyValue = ConfigBlockKeyValue String String deriving (Show, Eq) @@ -100,3 +108,15 @@ data AttrArgValue | AttrArgNumber String | AttrArgUnknown String deriving (Show, Eq, Data) + +getModels :: Schema -> [Model] +getModels (Schema elements) = [model | SchemaModel model <- elements] + +getEnums :: Schema -> [PrismaEnum] +getEnums (Schema elements) = [enum | SchemaEnum enum <- elements] + +getDatasources :: Schema -> [Datasource] +getDatasources (Schema elements) = [datasource | SchemaDatasource datasource <- elements] + +getGenerators :: Schema -> [Generator] +getGenerators (Schema elements) = [generator | SchemaGenerator generator <- elements] diff --git a/waspc/src/Wasp/Psl/Generator/ConfigBlock.hs b/waspc/src/Wasp/Psl/Generator/ConfigBlock.hs index 77b8521440..2d91242866 100644 --- a/waspc/src/Wasp/Psl/Generator/ConfigBlock.hs +++ b/waspc/src/Wasp/Psl/Generator/ConfigBlock.hs @@ -10,23 +10,20 @@ import qualified Wasp.AppSpec as AS import qualified Wasp.Psl.Ast.Schema as Psl.Ast showPrismaDbExtensions :: AppSpec -> Maybe String -showPrismaDbExtensions spec = findPrismaConfigBlockKeyValue "extensions" keyValues - where - (Psl.Ast.Schema prismaSchemaElements) = AS.getPrismaSchema spec - datasources = [datasource | Psl.Ast.SchemaDatasource datasource <- prismaSchemaElements] - -- We are looking through all datasources - keyValues = concatMap (\(Psl.Ast.Datasource _ kv) -> kv) datasources +showPrismaDbExtensions = + findPrismaConfigBlockKeyValue "extensions" + . concatMap (\(Psl.Ast.Datasource _ keyValues) -> keyValues) + . Psl.Ast.getDatasources + . AS.getPrismaSchema showPrismaPreviewFeatures :: AppSpec -> Maybe String -showPrismaPreviewFeatures spec = findPrismaConfigBlockKeyValue "previewFeatures" keyValues - where - (Psl.Ast.Schema prismaSchemaElements) = AS.getPrismaSchema spec - generators = [generator | Psl.Ast.SchemaGenerator generator <- prismaSchemaElements] - -- We are looking through all generators - keyValues = concatMap (\(Psl.Ast.Generator _ kv) -> kv) generators +showPrismaPreviewFeatures = + findPrismaConfigBlockKeyValue "previewFeatures" + . concatMap (\(Psl.Ast.Generator _ keyValues) -> keyValues) + . Psl.Ast.getGenerators + . AS.getPrismaSchema findPrismaConfigBlockKeyValue :: String -> [Psl.Ast.ConfigBlockKeyValue] -> Maybe String -findPrismaConfigBlockKeyValue key keyValues = do - keyValue <- find (\(Psl.Ast.ConfigBlockKeyValue key' _) -> key' == key) keyValues - case keyValue of - Psl.Ast.ConfigBlockKeyValue _ value -> Just value +findPrismaConfigBlockKeyValue needle = + fmap (\(Psl.Ast.ConfigBlockKeyValue _ value) -> value) + . find (\(Psl.Ast.ConfigBlockKeyValue key _) -> key == needle) diff --git a/waspc/src/Wasp/Psl/Generator/Schema.hs b/waspc/src/Wasp/Psl/Generator/Schema.hs index 15cce674a7..94448b9501 100644 --- a/waspc/src/Wasp/Psl/Generator/Schema.hs +++ b/waspc/src/Wasp/Psl/Generator/Schema.hs @@ -1,5 +1,6 @@ module Wasp.Psl.Generator.Schema ( generateSchemaElement, + generateModelBody, ) where diff --git a/waspc/test/Analyzer/EvaluatorTest.hs b/waspc/test/Analyzer/EvaluatorTest.hs index 93b4dabe23..69bed7acb6 100644 --- a/waspc/test/Analyzer/EvaluatorTest.hs +++ b/waspc/test/Analyzer/EvaluatorTest.hs @@ -153,7 +153,7 @@ instance IsDecl AllJson makeDeclType ''AllJson eval :: TD.TypeDefinitions -> [String] -> Either EvaluationError [Decl] -eval typeDefs source = evaluate typeDefs . fromRight . typeCheck typeDefs [] . fromRight . parseStatements $ unlines source +eval typeDefs source = evaluate typeDefs . fromRight . typeCheck typeDefs . fromRight . parseStatements $ unlines source spec_Evaluator :: Spec spec_Evaluator = do diff --git a/waspc/test/Analyzer/TypeChecker/InternalTest.hs b/waspc/test/Analyzer/TypeChecker/InternalTest.hs index 7b80e53928..57871b50d9 100644 --- a/waspc/test/Analyzer/TypeChecker/InternalTest.hs +++ b/waspc/test/Analyzer/TypeChecker/InternalTest.hs @@ -84,7 +84,7 @@ spec_Internal = do [ wctx1 $ P.Decl "person" "John" $ wctx2 $ P.Dict [("favoritePet", wctx3 $ P.Var "Riu")], wctx4 $ P.Decl "pet" "Riu" $ wctx5 $ P.Dict [] ] - let actual = run typeDefs $ check ast [] + let actual = run typeDefs $ check ast let expected = Right $ TypedAST diff --git a/waspc/test/Analyzer/TypeCheckerTest.hs b/waspc/test/Analyzer/TypeCheckerTest.hs index 77ca752405..2776fc4e97 100644 --- a/waspc/test/Analyzer/TypeCheckerTest.hs +++ b/waspc/test/Analyzer/TypeCheckerTest.hs @@ -50,7 +50,7 @@ spec_TypeChecker = do ], TD.enumTypes = H.empty } - let actual = typeCheck typeDefs [] ast + let actual = typeCheck typeDefs ast actual `shouldSatisfy` isRight it "Fails to type check a simple, ill-typed example" $ do let ast = P.AST [wctx1 $ P.Decl "string" "App" $ wctx2 $ P.IntegerLiteral 5] @@ -59,7 +59,7 @@ spec_TypeChecker = do { TD.declTypes = H.singleton "string" (TD.DeclType "string" StringType undefined), TD.enumTypes = H.empty } - let actual = typeCheck typeDefs [] ast + let actual = typeCheck typeDefs ast let expectedError = mkTypeError ctx1 $ CoercionError $ @@ -78,7 +78,7 @@ spec_TypeChecker = do { TD.declTypes = H.singleton "llnode" (TD.DeclType "llnode" llnodeArgType undefined), TD.enumTypes = H.empty } - let actual = typeCheck typeDefs [] ast + let actual = typeCheck typeDefs ast actual `shouldSatisfy` isRight it "Type checks an existing enum value" $ do let ast = P.AST [wctx1 $ P.Decl "food" "Cucumber" $ wctx2 $ P.Var "Dill"] @@ -87,7 +87,7 @@ spec_TypeChecker = do { TD.declTypes = H.singleton "food" (TD.DeclType "food" (EnumType "flavor") undefined), TD.enumTypes = H.singleton "flavor" (TD.EnumType "flavor" ["Fresh", "Dill"]) } - let actual = typeCheck typeDefs [] ast + let actual = typeCheck typeDefs ast let expected = Right $ TypedAST @@ -101,7 +101,7 @@ spec_TypeChecker = do { TD.declTypes = H.singleton "rooms" (TD.DeclType "rooms" (ListType StringType) undefined), TD.enumTypes = H.empty } - let actual = typeCheck typeDefs [] ast + let actual = typeCheck typeDefs ast let expected = Right $ TypedAST diff --git a/waspc/test/AnalyzerTest.hs b/waspc/test/AnalyzerTest.hs index 40c0431b3a..350419c9c6 100644 --- a/waspc/test/AnalyzerTest.hs +++ b/waspc/test/AnalyzerTest.hs @@ -20,10 +20,8 @@ import qualified Wasp.AppSpec.App.Db as Db import qualified Wasp.AppSpec.App.EmailSender as EmailSender import qualified Wasp.AppSpec.App.Server as Server import qualified Wasp.AppSpec.App.Wasp as Wasp -import qualified Wasp.AppSpec.Core.Decl as Decl 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 qualified Wasp.AppSpec.JSON as JSON import qualified Wasp.AppSpec.Job as Job @@ -37,19 +35,20 @@ import qualified Wasp.Version as WV spec_Analyzer :: Spec spec_Analyzer = do describe "Analyzer" $ do - let entitiesFromPrisma = - [ Decl.makeDecl @Entity "User" $ - Entity.makeEntity $ - Psl.Ast.Body - [ Psl.Ast.ElementField $ - Psl.Ast.Field - { Psl.Ast._name = "description", - Psl.Ast._type = Psl.Ast.String, - Psl.Ast._typeModifiers = [], - Psl.Ast._attrs = [] - } - ] - ] + let prismaSchemaAst = + Psl.Ast.Schema + [ Psl.Ast.SchemaModel $ + Psl.Ast.Model "User" $ + Psl.Ast.Body + [ Psl.Ast.ElementField $ + Psl.Ast.Field + { Psl.Ast._name = "description", + Psl.Ast._type = Psl.Ast.String, + Psl.Ast._typeModifiers = [], + Psl.Ast._attrs = [] + } + ] + ] it "Analyzes a well-typed example" $ do let source = @@ -130,7 +129,7 @@ spec_Analyzer = do "}" ] - let decls = analyze entitiesFromPrisma source + let decls = analyze prismaSchemaAst source let expectedApps = [ ( "Todo", @@ -303,7 +302,7 @@ spec_Analyzer = do unlines [ "route HomeRoute { path: \"/\", to: NonExistentPage }" ] - takeDecls @Route <$> analyze entitiesFromPrisma source + takeDecls @Route <$> analyze prismaSchemaAst source `shouldBe` Left [TypeError $ TC.mkTypeError (ctx (1, 34) (1, 48)) $ TC.UndefinedIdentifier "NonExistentPage"] it "Returns a type error if referenced declaration is of wrong type" $ do @@ -311,7 +310,7 @@ spec_Analyzer = do unlines [ "route HomeRoute { path: \"/\", to: HomeRoute }" ] - analyze entitiesFromPrisma source + analyze prismaSchemaAst source `errorMessageShouldBe` ( ctx (1, 35) (1, 43), intercalate "\n" @@ -329,7 +328,7 @@ spec_Analyzer = do [ "route HomeRoute { path: \"/\", to: HomePage }", "page HomePage { component: import Home from \"@src/HomePage.js\" }" ] - isRight (analyze entitiesFromPrisma source) `shouldBe` True + isRight (analyze prismaSchemaAst source) `shouldBe` True describe "Returns correct error message" $ do it "For nested unexpected type error" $ do @@ -342,7 +341,7 @@ spec_Analyzer = do " }", "}" ] - analyze entitiesFromPrisma source + analyze prismaSchemaAst source `errorMessageShouldBe` ( ctx (4, 14) (4, 27), intercalate "\n" @@ -366,7 +365,7 @@ spec_Analyzer = do " }", "}" ] - analyze entitiesFromPrisma source + analyze prismaSchemaAst source `errorMessageShouldBe` ( ctx (4, 18) (4, 22), intercalate "\n" @@ -384,7 +383,7 @@ spec_Analyzer = do " ttle: \"My app\",", "}" ] - analyze entitiesFromPrisma source + analyze prismaSchemaAst source `errorMessageShouldBe` ( ctx (1, 11) (3, 1), intercalate "\n" diff --git a/waspc/test/AppSpec/ValidTest.hs b/waspc/test/AppSpec/ValidTest.hs index 98acf02cbe..4d17c0aafa 100644 --- a/waspc/test/AppSpec/ValidTest.hs +++ b/waspc/test/AppSpec/ValidTest.hs @@ -422,7 +422,6 @@ spec_AppSpecValid = do basicAppSpec = AS.AppSpec { AS.decls = [basicAppDecl], - AS.entities = [], AS.prismaSchema = Psl.Ast.Schema [], AS.waspProjectDir = systemSPRoot SP. [SP.reldir|test/|], AS.externalCodeFiles = [], diff --git a/waspc/test/Generator/WebAppGeneratorTest.hs b/waspc/test/Generator/WebAppGeneratorTest.hs index 93f1b83fd8..9251e6a0e4 100644 --- a/waspc/test/Generator/WebAppGeneratorTest.hs +++ b/waspc/test/Generator/WebAppGeneratorTest.hs @@ -47,7 +47,6 @@ spec_WebAppGenerator = do AS.App.webSocket = Nothing } ], - AS.entities = [], AS.prismaSchema = Psl.Ast.Schema [], AS.waspProjectDir = systemSPRoot SP. [SP.reldir|test/|], AS.externalCodeFiles = [], diff --git a/waspc/waspc.cabal b/waspc/waspc.cabal index 9989b00d3d..e6ed409f79 100644 --- a/waspc/waspc.cabal +++ b/waspc/waspc.cabal @@ -217,6 +217,7 @@ library Wasp.Analyzer.TypeDefinitions.TH.Common Wasp.Analyzer.TypeDefinitions.TH.Decl Wasp.Analyzer.TypeDefinitions.TH.Enum + Wasp.Analyzer.Prisma Wasp.AppSpec Wasp.AppSpec.Action Wasp.AppSpec.Api diff --git a/waspc/waspls/src/Wasp/LSP/Analysis.hs b/waspc/waspls/src/Wasp/LSP/Analysis.hs index bf8d3ecfc2..8436eca54c 100644 --- a/waspc/waspls/src/Wasp/LSP/Analysis.hs +++ b/waspc/waspls/src/Wasp/LSP/Analysis.hs @@ -35,7 +35,7 @@ diagnoseWaspFile uri = do when prismaSchemaWatchingEnabled $ do case getWaspDirFromWaspFileUri uri of Nothing -> logM $ "Couldn't get wasp dir from wasp file uri " ++ show uri - Just waspDir -> Prisma.analyzePrismaSchemaFileAndSetEntities waspDir + Just waspDir -> Prisma.analyzeAndSetPrismaSchema waspDir analyzeWaspFile uri @@ -74,7 +74,7 @@ analyzeWaspFile :: LSP.Uri -> ServerM () analyzeWaspFile uri = do modify (State.waspFileUri ?~ uri) - prismaEntities <- handler $ asks (^. State.prismaEntities) + prismaSchemaAst <- handler $ asks (^. State.prismaSchemaAst) -- NOTE: we have to be careful to keep CST and source string in sync at all -- times for all threads, so we update them both atomically (via one call to @@ -89,7 +89,7 @@ analyzeWaspFile uri = do modify ((State.currentWaspSource .~ srcString) . (State.cst ?~ concreteSyntax)) if not $ null concreteErrorMessages then storeCSTErrors concreteErrorMessages - else runWaspAnalyzer prismaEntities srcString + else runWaspAnalyzer prismaSchemaAst srcString where readSourceString = fmap T.unpack <$> readVFSFile uri diff --git a/waspc/waspls/src/Wasp/LSP/DynamicHandlers.hs b/waspc/waspls/src/Wasp/LSP/DynamicHandlers.hs index f53c3a43cd..d23c86ebc2 100644 --- a/waspc/waspls/src/Wasp/LSP/DynamicHandlers.hs +++ b/waspc/waspls/src/Wasp/LSP/DynamicHandlers.hs @@ -168,7 +168,7 @@ prismaSchemaFileChangeHandler msg = do case getWaspDirFromWaspFileUri $ head uris of Nothing -> logM "[prismaSchemaFileChangeHandler] Could not get waspDir from file URI" Just waspDir -> do - Prisma.analyzePrismaSchemaFileAndSetEntities waspDir + Prisma.analyzeAndSetPrismaSchema waspDir handler $ asks (^. State.waspFileUri) >>= \case Just uri -> do diff --git a/waspc/waspls/src/Wasp/LSP/Prisma/Analyze.hs b/waspc/waspls/src/Wasp/LSP/Prisma/Analyze.hs index a87770241c..5bcfece4cb 100644 --- a/waspc/waspls/src/Wasp/LSP/Prisma/Analyze.hs +++ b/waspc/waspls/src/Wasp/LSP/Prisma/Analyze.hs @@ -4,17 +4,17 @@ import Control.Lens ((.~)) import Control.Monad.Cont (liftIO) import Control.Monad.Log.Class (logM) import StrongPath (Abs, Dir, Path') -import Wasp.LSP.Prisma.Util (showEntities) +import Wasp.LSP.Prisma.Util (showModels) import Wasp.LSP.ServerMonads (ServerM, modify) import qualified Wasp.LSP.ServerState as State import Wasp.Project (WaspProjectDir) import Wasp.Project.Analyze (analyzePrismaSchema) -analyzePrismaSchemaFileAndSetEntities :: Path' Abs (Dir WaspProjectDir) -> ServerM () -analyzePrismaSchemaFileAndSetEntities waspDir = do +analyzeAndSetPrismaSchema :: Path' Abs (Dir WaspProjectDir) -> ServerM () +analyzeAndSetPrismaSchema waspDir = do liftIO (analyzePrismaSchema waspDir) >>= \case - Left err -> logM $ "[analyzePrismaSchemaFileAndSetEntities] Error analyzing Prisma schema: " ++ show err - Right (_, entities) -> do - logM $ "[analyzePrismaSchemaFileAndSetEntities] Analyzed Prisma schema: " ++ showEntities entities - modify (State.prismaEntities .~ entities) + Left err -> logM $ "[analyzeAndSetPrismaSchema] Error analyzing Prisma schema: " ++ show err + Right prismaSchemaAst -> do + logM $ "[analyzeAndSetPrismaSchema] Got the following entities: " ++ showModels prismaSchemaAst + modify (State.prismaSchemaAst .~ prismaSchemaAst) diff --git a/waspc/waspls/src/Wasp/LSP/Prisma/Util.hs b/waspc/waspls/src/Wasp/LSP/Prisma/Util.hs index 1572a103b9..b6ddfc0b2a 100644 --- a/waspc/waspls/src/Wasp/LSP/Prisma/Util.hs +++ b/waspc/waspls/src/Wasp/LSP/Prisma/Util.hs @@ -1,11 +1,9 @@ module Wasp.LSP.Prisma.Util where -import Wasp.Analyzer (takeDecls) -import qualified Wasp.AppSpec as AS -import qualified Wasp.AppSpec.Entity as AS.Entity +import qualified Wasp.Psl.Ast.Schema as Psl.Ast -showEntities :: [AS.Decl] -> String -showEntities = unwords . map fst . getEntities +showModels :: Psl.Ast.Schema -> String +showModels = unwords . getModelNames -getEntities :: [AS.Decl] -> [(String, AS.Entity.Entity)] -getEntities = takeDecls +getModelNames :: Psl.Ast.Schema -> [String] +getModelNames = fmap (\(Psl.Ast.Model name _) -> name) . Psl.Ast.getModels diff --git a/waspc/waspls/src/Wasp/LSP/Server.hs b/waspc/waspls/src/Wasp/LSP/Server.hs index 9a6ac06870..0aa34b3818 100644 --- a/waspc/waspls/src/Wasp/LSP/Server.hs +++ b/waspc/waspls/src/Wasp/LSP/Server.hs @@ -33,7 +33,7 @@ import Wasp.LSP.ServerState _currentWaspSource, _debouncer, _latestDiagnostics, - _prismaEntities, + _prismaSchemaAst, _reactorIn, _regTokens, _tsExports, @@ -41,6 +41,7 @@ import Wasp.LSP.ServerState ), ) import Wasp.LSP.SignatureHelp (signatureHelpRetriggerCharacters, signatureHelpTriggerCharacters) +import qualified Wasp.Psl.Ast.Schema as Psl.Ast lspServerHandlers :: IO () -> LSP.Handlers ServerM lspServerHandlers stopReactor = @@ -73,7 +74,7 @@ serve maybeLogFile = do let defaultServerState = ServerState { _waspFileUri = Nothing, - _prismaEntities = [], + _prismaSchemaAst = Psl.Ast.Schema [], _currentWaspSource = "", _latestDiagnostics = [], _cst = Nothing, diff --git a/waspc/waspls/src/Wasp/LSP/ServerState.hs b/waspc/waspls/src/Wasp/LSP/ServerState.hs index 934b6f9bc5..cc8fb22312 100644 --- a/waspc/waspls/src/Wasp/LSP/ServerState.hs +++ b/waspc/waspls/src/Wasp/LSP/ServerState.hs @@ -17,7 +17,7 @@ module Wasp.LSP.ServerState watchPrismaSchemaToken, reactorIn, debouncer, - prismaEntities, + prismaSchemaAst, ) where @@ -29,11 +29,11 @@ import GHC.Generics (Generic) import qualified Language.LSP.Server as LSP import qualified Language.LSP.Types as LSP import Wasp.Analyzer.Parser.CST (SyntaxNode) -import qualified Wasp.AppSpec as AS import Wasp.LSP.Debouncer (Debouncer) import Wasp.LSP.Diagnostic (WaspDiagnostic) import Wasp.LSP.ExtImport.Path (ExtFileCachePath) import Wasp.LSP.Reactor (ReactorInput) +import qualified Wasp.Psl.Ast.Schema as Psl.Ast import Wasp.TypeScript.Inspect.Exports (TsExport) -- | LSP State preserved between handlers. @@ -53,8 +53,8 @@ data ServerState = ServerState _cst :: Maybe [SyntaxNode], -- | Cache of source file export lists. _tsExports :: TsExportCache, - -- | Cache of Prisma schema entities. - _prismaEntities :: [AS.Decl], + -- | Cache of Prisma schema AST. + _prismaSchemaAst :: Psl.Ast.Schema, -- | Registration tokens for dynamic capabilities. _regTokens :: RegistrationTokens, -- | Thread safe channel for sending actions to the LSP reactor thread.