diff --git a/waspc/cli/src/Wasp/Cli/Command.hs b/waspc/cli/src/Wasp/Cli/Command.hs index 9af303d31..38d24297e 100644 --- a/waspc/cli/src/Wasp/Cli/Command.hs +++ b/waspc/cli/src/Wasp/Cli/Command.hs @@ -1,24 +1,35 @@ +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Wasp.Cli.Command ( Command, runCommand, CommandError (..), + + -- * Requirements + + -- See "Wasp.Cli.Command.Requires" for documentation. + require, + Requirable (checkRequirement), ) where -import Control.Monad.Except (ExceptT, MonadError, runExceptT) +import Control.Monad.Error.Class (MonadError) +import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Class (MonadIO) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) +import Data.Data (Typeable, cast) +import Data.Maybe (mapMaybe) import System.Exit (exitFailure) import Wasp.Cli.Message (cliSendMessage) import qualified Wasp.Message as Msg -newtype Command a = Command {_runCommand :: ExceptT CommandError IO a} +newtype Command a = Command {_runCommand :: StateT [Requirement] (ExceptT CommandError IO) a} deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError) runCommand :: Command a -> IO () runCommand cmd = do - runExceptT (_runCommand cmd) >>= \case + runExceptT (flip evalStateT [] $ _runCommand cmd) >>= \case Left cmdError -> do cliSendMessage $ Msg.Failure (_errorTitle cmdError) (_errorMsg cmdError) exitFailure @@ -27,3 +38,33 @@ runCommand cmd = do -- TODO: What if we want to recognize errors in order to handle them? -- Should we add _commandErrorType? Should CommandError be parametrized by it, is that even possible? data CommandError = CommandError {_errorTitle :: !String, _errorMsg :: !String} + +data Requirement where + Requirement :: Requirable r => r -> Requirement + +class Typeable r => Requirable r where + -- | Check if the requirement is met and return a value representing that + -- requirement. + -- + -- This function must always return a value: if the requirement is not met, + -- throw a 'CommandError'. + checkRequirement :: Command r + +-- | Assert that a requirement is met and receive information about that +-- requirement, if any is offered. +-- +-- To use, pattern match on the result, e.g. +-- +-- @ +-- do +-- HasDbConnection <- require +-- @ +require :: Requirable r => Command r +require = + Command (gets (mapMaybe cast)) >>= \case + (req : _) -> return req + [] -> do + -- Requirement hasn't been met, so run the check + req <- checkRequirement + Command $ modify (Requirement req :) + return req diff --git a/waspc/cli/src/Wasp/Cli/Command/Build.hs b/waspc/cli/src/Wasp/Cli/Command/Build.hs index 906de11f0..1f3b6e8d2 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Build.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Build.hs @@ -13,11 +13,9 @@ import System.Directory removeDirectoryRecursive, ) import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common - ( findWaspProjectRootDirFromCwd, - ) import Wasp.Cli.Command.Compile (compileIOWithOptions, printCompilationResult) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import Wasp.Cli.Message (cliSendMessage) import Wasp.CompileOptions (CompileOptions (..)) @@ -35,7 +33,7 @@ import Wasp.Project (CompileError, CompileWarning) -- Very similar to 'compile'. build :: Command () build = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let buildDir = waspProjectDir Common.dotWaspDirInWaspProjectDir Common.buildDirInDotWaspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Clean.hs b/waspc/cli/src/Wasp/Cli/Command/Clean.hs index b2ead91e7..87a3b1346 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Clean.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Clean.hs @@ -10,14 +10,14 @@ import System.Directory removeDirectoryRecursive, ) import Wasp.Cli.Command (Command) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import qualified Wasp.Message as Msg clean :: Command () clean = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP. Common.dotWaspDirInWaspProjectDir cliSendMessageC $ Msg.Start "Deleting .wasp/ directory..." doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp diff --git a/waspc/cli/src/Wasp/Cli/Command/Common.hs b/waspc/cli/src/Wasp/Cli/Command/Common.hs index a7642711a..8f40ab724 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Common.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Common.hs @@ -1,52 +1,20 @@ module Wasp.Cli.Command.Common - ( findWaspProjectRootDirFromCwd, - findWaspProjectRoot, - readWaspCompileInfo, + ( readWaspCompileInfo, throwIfExeIsNotAvailable, ) where import Control.Monad.Except import qualified Control.Monad.Except as E -import Data.Maybe (fromJust) import StrongPath (Abs, Dir, Path') -import qualified StrongPath as SP import StrongPath.Operations -import System.Directory (doesFileExist, doesPathExist, findExecutable, getCurrentDirectory) -import qualified System.FilePath as FP +import System.Directory (findExecutable) import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Common (dotWaspRootFileInWaspProjectDir) import qualified Wasp.Cli.Common as Cli.Common import Wasp.Project (WaspProjectDir) import Wasp.Util (ifM) import qualified Wasp.Util.IO as IOUtil -findWaspProjectRoot :: Path' Abs (Dir ()) -> Command (Path' Abs (Dir WaspProjectDir)) -findWaspProjectRoot currentDir = do - let absCurrentDirFp = SP.fromAbsDir currentDir - doesCurrentDirExist <- liftIO $ doesPathExist absCurrentDirFp - unless doesCurrentDirExist (throwError notFoundError) - let dotWaspRootFilePath = absCurrentDirFp FP. SP.fromRelFile dotWaspRootFileInWaspProjectDir - isCurrentDirRoot <- liftIO $ doesFileExist dotWaspRootFilePath - if isCurrentDirRoot - then return $ SP.castDir currentDir - else do - let parentDir = SP.parent currentDir - when (parentDir == currentDir) (throwError notFoundError) - findWaspProjectRoot parentDir - where - notFoundError = - CommandError - "Wasp command failed" - ( "Couldn't find wasp project root - make sure" - ++ " you are running this command from a Wasp project." - ) - -findWaspProjectRootDirFromCwd :: Command (Path' Abs (Dir WaspProjectDir)) -findWaspProjectRootDirFromCwd = do - absCurrentDir <- liftIO getCurrentDirectory - findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir) - readWaspCompileInfo :: Path' Abs (Dir WaspProjectDir) -> IO String readWaspCompileInfo waspDir = ifM diff --git a/waspc/cli/src/Wasp/Cli/Command/Compile.hs b/waspc/cli/src/Wasp/Cli/Command/Compile.hs index 8c6c62010..e26127b09 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Compile.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Compile.hs @@ -18,10 +18,8 @@ import Data.List (intercalate) import StrongPath (Abs, Dir, Path', ()) import qualified Wasp.AppSpec as AS import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common - ( findWaspProjectRootDirFromCwd, - ) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import Wasp.Cli.Message (cliSendMessage) import Wasp.CompileOptions (CompileOptions (..)) @@ -36,7 +34,7 @@ compile = do -- TODO: Consider a way to remove the redundancy of finding the project root -- here and in compileWithOptions. One option could be to add this to defaultCompileOptions -- add make externalCodeDirPath a helper function, along with any others we typically need. - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require compileWithOptions $ defaultCompileOptions waspProjectDir -- | Compiles Wasp project that the current working directory is part of. @@ -47,7 +45,7 @@ compile = do -- Finally, throws if there was a compile error, otherwise returns any compile warnings. compileWithOptions :: CompileOptions -> Command [CompileWarning] compileWithOptions options = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let outDir = waspProjectDir Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Db.hs b/waspc/cli/src/Wasp/Cli/Command/Db.hs index 66abe13d9..3178723b9 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Db.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Db.hs @@ -4,8 +4,8 @@ module Wasp.Cli.Command.Db where import Wasp.Cli.Command (Command, runCommand) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (compileWithOptions, defaultCompileOptions) +import Wasp.Cli.Command.Require (DbConnectionEstablished (DbConnectionEstablished), InWaspProject (InWaspProject), require) import Wasp.CompileOptions (CompileOptions (generatorWarningsFilter)) import Wasp.Generator.Monad (GeneratorWarning (GeneratorNeedsMigrationWarning)) @@ -19,8 +19,9 @@ runDbCommand = runCommand . makeDbCommand makeDbCommand :: Command a -> Command a makeDbCommand cmd = do -- Ensure code is generated and npm dependencies are installed. - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require _ <- compileWithOptions $ compileOptions waspProjectDir + DbConnectionEstablished <- require cmd where compileOptions waspProjectDir = diff --git a/waspc/cli/src/Wasp/Cli/Command/Db/Migrate.hs b/waspc/cli/src/Wasp/Cli/Command/Db/Migrate.hs index d1cd7d802..ee6bc64d7 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Db/Migrate.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Db/Migrate.hs @@ -8,10 +8,8 @@ import Control.Monad.Except (ExceptT (ExceptT), liftEither, runExceptT, throwErr import Control.Monad.IO.Class (liftIO) import StrongPath (Abs, Dir, Path', ()) import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common - ( findWaspProjectRootDirFromCwd, - ) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Cli.Common import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.DbGenerator.Common (MigrateArgs (..), defaultMigrateArgs) @@ -24,7 +22,7 @@ import Wasp.Project.Db.Migrations (DbMigrationsDir, dbMigrationsDirInWaspProject -- The migrate function takes care of copying migrations from the generated project back to the source code. migrateDev :: [String] -> Command () migrateDev optionalMigrateArgs = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let waspDbMigrationsDir = waspProjectDir dbMigrationsDirInWaspProjectDir let projectRootDir = waspProjectDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Db/Reset.hs b/waspc/cli/src/Wasp/Cli/Command/Db/Reset.hs index bf5154720..9220a671d 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Db/Reset.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Db/Reset.hs @@ -6,15 +6,15 @@ where import Control.Monad.IO.Class (liftIO) import StrongPath (()) import Wasp.Cli.Command (Command) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import Wasp.Generator.DbGenerator.Operations (dbReset) import qualified Wasp.Message as Msg reset :: Command () reset = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let genProjectDir = waspProjectDir Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Db/Seed.hs b/waspc/cli/src/Wasp/Cli/Command/Db/Seed.hs index bfa8daa27..ee7dfb85d 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Db/Seed.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Db/Seed.hs @@ -16,16 +16,16 @@ import qualified Wasp.AppSpec.App.Db as AS.Db import qualified Wasp.AppSpec.ExtImport as AS.ExtImport import qualified Wasp.AppSpec.Valid as ASV import Wasp.Cli.Command (Command, CommandError (CommandError)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (analyze) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import Wasp.Generator.DbGenerator.Operations (dbSeed) import qualified Wasp.Message as Msg seed :: Maybe String -> Command () seed maybeUserProvidedSeedName = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let genProjectDir = waspProjectDir Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Db/Studio.hs b/waspc/cli/src/Wasp/Cli/Command/Db/Studio.hs index 02cab075c..708f2c31f 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Db/Studio.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Db/Studio.hs @@ -8,8 +8,8 @@ import Control.Concurrent.Async (concurrently) import Control.Monad.IO.Class (liftIO) import StrongPath (()) import Wasp.Cli.Command (Command) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Cli.Common as Common import Wasp.Generator.DbGenerator.Jobs (runStudio) import Wasp.Generator.Job.IO (readJobMessagesAndPrintThemPrefixed) @@ -17,7 +17,7 @@ import qualified Wasp.Message as Msg studio :: Command () studio = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require let genProjectDir = waspProjectDir Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Deploy.hs b/waspc/cli/src/Wasp/Cli/Command/Deploy.hs index 4a07d64a5..cfaf02771 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Deploy.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Deploy.hs @@ -7,12 +7,12 @@ import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import System.Environment (getExecutablePath) import Wasp.Cli.Command (Command, CommandError (CommandError)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import qualified Wasp.Project.Deployment deploy :: [String] -> Command () deploy cmdArgs = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require deployResult <- liftIO $ do -- `getExecutablePath` has some caveats: -- https://frasertweedale.github.io/blog-fp/posts/2022-05-10-improved-executable-path-queries.html diff --git a/waspc/cli/src/Wasp/Cli/Command/Deps.hs b/waspc/cli/src/Wasp/Cli/Command/Deps.hs index 18d0bad11..e911b2a25 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Deps.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Deps.hs @@ -8,8 +8,8 @@ import Control.Monad.IO.Class (liftIO) import Wasp.AppSpec (AppSpec) import qualified Wasp.AppSpec.App.Dependency as AS.Dependency import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (defaultCompileOptions) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Cli.Terminal (title) import qualified Wasp.Generator.NpmDependencies as N import qualified Wasp.Generator.ServerGenerator as ServerGenerator @@ -19,7 +19,7 @@ import qualified Wasp.Util.Terminal as Term deps :: Command () deps = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require appSpecOrAnalyzerErrors <- liftIO $ analyzeWaspProject waspProjectDir (defaultCompileOptions waspProjectDir) appSpec <- either diff --git a/waspc/cli/src/Wasp/Cli/Command/Dockerfile.hs b/waspc/cli/src/Wasp/Cli/Command/Dockerfile.hs index 84461398d..743c99820 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Dockerfile.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Dockerfile.hs @@ -7,13 +7,13 @@ import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import qualified Data.Text.IO as T.IO import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (defaultCompileOptions) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Project (compileAndRenderDockerfile) printDockerfile :: Command () printDockerfile = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require dockerfileContentOrCompileErrors <- liftIO $ compileAndRenderDockerfile waspProjectDir (defaultCompileOptions waspProjectDir) either (throwError . CommandError "Displaying Dockerfile failed due to a compilation error in your Wasp project" . unwords) diff --git a/waspc/cli/src/Wasp/Cli/Command/Info.hs b/waspc/cli/src/Wasp/Cli/Command/Info.hs index a623502dd..481478d81 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Info.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Info.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TypeApplications #-} - module Wasp.Cli.Command.Info ( info, ) @@ -12,9 +10,10 @@ import StrongPath.Operations () import System.Directory (getFileSize) import qualified Wasp.AppSpec.Valid as ASV import Wasp.Cli.Command (Command) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd, readWaspCompileInfo) +import Wasp.Cli.Command.Common (readWaspCompileInfo) import Wasp.Cli.Command.Compile (analyze) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Cli.Command.Start.Db (getDbSystem) import Wasp.Cli.Terminal (title) import qualified Wasp.Message as Msg @@ -24,7 +23,7 @@ import qualified Wasp.Util.Terminal as Term info :: Command () info = do - waspDir <- findWaspProjectRootDirFromCwd + InWaspProject waspDir <- require compileInfo <- liftIO $ readWaspCompileInfo waspDir projectSize <- liftIO $ readDirectorySizeMB waspDir diff --git a/waspc/cli/src/Wasp/Cli/Command/Require.hs b/waspc/cli/src/Wasp/Cli/Command/Require.hs new file mode 100644 index 000000000..63670db1c --- /dev/null +++ b/waspc/cli/src/Wasp/Cli/Command/Require.hs @@ -0,0 +1,98 @@ +module Wasp.Cli.Command.Require + ( -- * Asserting Requirements + + -- There are some requirements we want to assert in command code, such as + -- ensuring the command is being run inside a wasp project directory. We + -- might end up wanting to check each requirement multiple times, especially + -- if we want the value from it (like getting the wasp project directory), + -- but we also want to avoid duplicating work. Using 'require' results in + -- checked requirements being stored so they can be immediately retrieved + -- when checking the same requirements additional times. + -- + -- For example, you can check if you are in a wasp project by doing + -- + -- @ + -- do + -- InWaspProject waspProjectDir <- require + -- @ + -- + -- See instances of 'Requirable' for what kinds of requirements are + -- supported. To implement a new requirable type, give your type an instance + -- of 'Requirable'. + require, + + -- * Requirables + Requirable (checkRequirement), + DbConnectionEstablished (DbConnectionEstablished), + InWaspProject (InWaspProject), + ) +where + +import Control.Monad (unless, when) +import Control.Monad.Error.Class (throwError) +import Control.Monad.IO.Class (liftIO) +import Data.Data (Typeable) +import Data.Maybe (fromJust) +import qualified StrongPath as SP +import System.Directory (doesFileExist, doesPathExist, getCurrentDirectory) +import qualified System.FilePath as FP +import Wasp.Cli.Command (CommandError (CommandError), Requirable (checkRequirement), require) +import Wasp.Cli.Common (WaspProjectDir) +import qualified Wasp.Cli.Common as Cli.Common +import Wasp.Generator.DbGenerator.Operations (isDbRunning) + +data DbConnectionEstablished = DbConnectionEstablished deriving (Typeable) + +instance Requirable DbConnectionEstablished where + checkRequirement = do + -- NOTE: 'InWaspProject' does not depend on this requirement, so this + -- call to 'require' will not result in an infinite loop. + InWaspProject waspProjectDir <- require + let outDir = waspProjectDir SP. Cli.Common.dotWaspDirInWaspProjectDir SP. Cli.Common.generatedCodeDirInDotWaspDir + dbIsRunning <- liftIO $ isDbRunning outDir + if dbIsRunning + then return DbConnectionEstablished + else throwError noDbError + where + noDbError = + CommandError + "Can not connect to database" + ( "The database needs to be running in order to execute this command." + ++ " You can easily start a managed dev database with `wasp start db`." + ) + +-- | Require a Wasp project to exist near the current directory. Get the +-- project directory by pattern matching on the result of 'require': +-- +-- @ +-- do +-- InWaspProject waspProjectDir <- require +-- @ +newtype InWaspProject = InWaspProject (SP.Path' SP.Abs (SP.Dir WaspProjectDir)) deriving (Typeable) + +instance Requirable InWaspProject where + checkRequirement = do + -- Recursively searches up from CWD until @.wasproot@ file is found, or + -- throw an error if it is never found. + currentDir <- fromJust . SP.parseAbsDir <$> liftIO getCurrentDirectory + findWaspProjectRoot currentDir + where + findWaspProjectRoot currentDir = do + let absCurrentDirFp = SP.fromAbsDir currentDir + doesCurrentDirExist <- liftIO $ doesPathExist absCurrentDirFp + unless doesCurrentDirExist (throwError notFoundError) + let dotWaspRootFilePath = absCurrentDirFp FP. SP.fromRelFile Cli.Common.dotWaspRootFileInWaspProjectDir + isCurrentDirRoot <- liftIO $ doesFileExist dotWaspRootFilePath + if isCurrentDirRoot + then return $ InWaspProject $ SP.castDir currentDir + else do + let parentDir = SP.parent currentDir + when (parentDir == currentDir) (throwError notFoundError) + findWaspProjectRoot parentDir + + notFoundError = + CommandError + "Wasp command failed" + ( "Couldn't find wasp project root - make sure" + ++ " you are running this command from a Wasp project." + ) diff --git a/waspc/cli/src/Wasp/Cli/Command/Start.hs b/waspc/cli/src/Wasp/Cli/Command/Start.hs index 83dd41569..b1cc33f38 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Start.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Start.hs @@ -10,9 +10,9 @@ import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import StrongPath (()) import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (compile, printWarningsAndErrorsIfAny) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (DbConnectionEstablished (DbConnectionEstablished), InWaspProject (InWaspProject), require) import Wasp.Cli.Command.Watch (watch) import qualified Wasp.Cli.Common as Common import qualified Wasp.Generator @@ -23,13 +23,15 @@ import Wasp.Project (CompileError, CompileWarning) -- It also listens for any file changes and recompiles and restarts generated project accordingly. start :: Command () start = do - waspRoot <- findWaspProjectRootDirFromCwd + InWaspProject waspRoot <- require let outDir = waspRoot Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir cliSendMessageC $ Msg.Start "Starting compilation and setup phase. Hold tight..." warnings <- compile + DbConnectionEstablished <- require + cliSendMessageC $ Msg.Start "Listening for file changes..." cliSendMessageC $ Msg.Start "Starting up generated project..." diff --git a/waspc/cli/src/Wasp/Cli/Command/Start/Db.hs b/waspc/cli/src/Wasp/Cli/Command/Start/Db.hs index 061dba746..eb2b3baaa 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Start/Db.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Start/Db.hs @@ -18,9 +18,10 @@ import qualified Wasp.AppSpec.App as AS.App import qualified Wasp.AppSpec.App.Db as AS.App.Db import qualified Wasp.AppSpec.Valid as ASV import Wasp.Cli.Command (Command, CommandError (CommandError)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd, throwIfExeIsNotAvailable) +import Wasp.Cli.Command.Common (throwIfExeIsNotAvailable) import Wasp.Cli.Command.Compile (analyze) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Cli.Common (WaspProjectDir) import qualified Wasp.Message as Msg import Wasp.Project.Db (databaseUrlEnvVarName) @@ -36,7 +37,7 @@ import qualified Wasp.Util.Network.Socket as Socket -- in Wasp configuration and spins up a database of appropriate type. start :: Command () start = do - waspProjectDir <- findWaspProjectRootDirFromCwd + InWaspProject waspProjectDir <- require appSpec <- analyze waspProjectDir throwIfCustomDbAlreadyInUse appSpec diff --git a/waspc/cli/src/Wasp/Cli/Command/Telemetry/Project.hs b/waspc/cli/src/Wasp/Cli/Command/Telemetry/Project.hs index 521a1564b..0726794c5 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Telemetry/Project.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Telemetry/Project.hs @@ -31,7 +31,7 @@ import qualified System.Environment as ENV import qualified System.Info import Wasp.Cli.Command (Command) import qualified Wasp.Cli.Command.Call as Command.Call -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Cli.Command.Telemetry.Common (TelemetryCacheDir) import Wasp.Cli.Command.Telemetry.User (UserSignature (..)) import Wasp.Util (ifM) @@ -100,7 +100,9 @@ checkIfEnvValueIsTruthy (Just v) newtype ProjectHash = ProjectHash {_projectHashValue :: String} deriving (Show) getWaspProjectPathHash :: Command ProjectHash -getWaspProjectPathHash = ProjectHash . take 16 . sha256 . SP.toFilePath <$> findWaspProjectRootDirFromCwd +getWaspProjectPathHash = do + InWaspProject waspRoot <- require + return . ProjectHash . take 16 . sha256 . SP.toFilePath $ waspRoot where sha256 :: String -> String sha256 = show . hashWith SHA256 . ByteStringUTF8.fromString diff --git a/waspc/cli/src/Wasp/Cli/Command/Test.hs b/waspc/cli/src/Wasp/Cli/Command/Test.hs index bc263cdbf..2e8a761aa 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Test.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Test.hs @@ -10,9 +10,9 @@ import Control.Monad.IO.Class (liftIO) import StrongPath (Abs, Dir, ()) import StrongPath.Types (Path') import Wasp.Cli.Command (Command, CommandError (..)) -import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd) import Wasp.Cli.Command.Compile (compile) import Wasp.Cli.Command.Message (cliSendMessageC) +import Wasp.Cli.Command.Require (InWaspProject (InWaspProject), require) import Wasp.Cli.Command.Watch (watch) import qualified Wasp.Cli.Common as Common import qualified Wasp.Generator @@ -27,7 +27,7 @@ test _ = throwError $ CommandError "Invalid arguments" "Expected: wasp test clie watchAndTest :: (Path' Abs (Dir ProjectRootDir) -> IO (Either String ())) -> Command () watchAndTest testRunner = do - waspRoot <- findWaspProjectRootDirFromCwd + InWaspProject waspRoot <- require let outDir = waspRoot Common.dotWaspDirInWaspProjectDir Common.generatedCodeDirInDotWaspDir cliSendMessageC $ Msg.Start "Starting compilation and setup phase. Hold tight..." diff --git a/waspc/examples/todoApp/todoApp.wasp b/waspc/examples/todoApp/todoApp.wasp index e2f62e75d..6e2683918 100644 --- a/waspc/examples/todoApp/todoApp.wasp +++ b/waspc/examples/todoApp/todoApp.wasp @@ -46,7 +46,7 @@ app todoApp { }, server: { setupFn: import setup from "@server/serverSetup.js", - middlewareConfigFn: import { serverMiddlewareFn } from "@server/serverSetup.js" + middlewareConfigFn: import { serverMiddlewareFn } from "@server/serverSetup.js", }, client: { rootComponent: import { App } from "@client/App.tsx", diff --git a/waspc/headless-test/README.md b/waspc/headless-test/README.md index a494edc81..6827e4aa2 100644 --- a/waspc/headless-test/README.md +++ b/waspc/headless-test/README.md @@ -23,4 +23,4 @@ npm run example-app:start ### How to run in CI -We set up a GitHub Action to run the test in CI. See `.github/workflows/ci.yml` for details. \ No newline at end of file +We set up a GitHub Action to run the test in CI. See `.github/workflows/ci.yml` for details. diff --git a/waspc/headless-test/package-lock.json b/waspc/headless-test/package-lock.json index 147145155..e7df87936 100644 --- a/waspc/headless-test/package-lock.json +++ b/waspc/headless-test/package-lock.json @@ -9,27 +9,15 @@ "version": "1.0.0", "license": "ISC", "dependencies": { - "@prisma/client": "^4.12.0" + "@prisma/client": "^4.12.0", + "linebyline": "^1.3.0" }, "devDependencies": { "@playwright/test": "^1.33.0", - "concurrently": "^8.0.1", "prisma": "^4.12.0", "wait-port": "^1.0.4" } }, - "node_modules/@babel/runtime": { - "version": "7.21.5", - "resolved": "https://registry.npmjs.org/@babel/runtime/-/runtime-7.21.5.tgz", - "integrity": "sha512-8jI69toZqqcsnqGGqwGS4Qb1VwLOEp4hz+CXPywcvjs60u3B4Pom/U/7rm4W8tMOYEB+E9wgD0mW1l3r8qlI9Q==", - "dev": true, - "dependencies": { - "regenerator-runtime": "^0.13.11" - }, - "engines": { - "node": ">=6.9.0" - } - }, "node_modules/@playwright/test": { "version": "1.33.0", "resolved": "https://registry.npmjs.org/@playwright/test/-/test-1.33.0.tgz", @@ -87,15 +75,6 @@ "integrity": "sha512-OPs5WnnT1xkCBiuQrZA4+YAV4HEJejmHneyraIaxsbev5yCEr6KMwINNFP9wQeFIw8FWcoTqF3vQsa5CDaI+8Q==", "dev": true }, - "node_modules/ansi-regex": { - "version": "5.0.1", - "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-5.0.1.tgz", - "integrity": "sha512-quJQXlTSUGL2LH9SUXo8VwsY4soanhgo6LNSm84E1LBcE8s3O0wpdiRzyR9z/ZZJMlMWv37qOOb9pdJlMUEKFQ==", - "dev": true, - "engines": { - "node": ">=8" - } - }, "node_modules/ansi-styles": { "version": "4.3.0", "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-4.3.0.tgz", @@ -139,20 +118,6 @@ "node": ">=8" } }, - "node_modules/cliui": { - "version": "8.0.1", - "resolved": "https://registry.npmjs.org/cliui/-/cliui-8.0.1.tgz", - "integrity": "sha512-BSeNnyus75C4//NQ9gQt1/csTXyo/8Sb+afLAkzAptFuMsod9HFokGNudZpi/oQV73hnVK+sR+5PVRMd+Dr7YQ==", - "dev": true, - "dependencies": { - "string-width": "^4.2.0", - "strip-ansi": "^6.0.1", - "wrap-ansi": "^7.0.0" - }, - "engines": { - "node": ">=12" - } - }, "node_modules/color-convert": { "version": "2.0.1", "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-2.0.1.tgz", @@ -180,49 +145,6 @@ "node": "^12.20.0 || >=14" } }, - "node_modules/concurrently": { - "version": "8.0.1", - "resolved": "https://registry.npmjs.org/concurrently/-/concurrently-8.0.1.tgz", - "integrity": "sha512-Sh8bGQMEL0TAmAm2meAXMjcASHZa7V0xXQVDBLknCPa9TPtkY9yYs+0cnGGgfdkW0SV1Mlg+hVGfXcoI8d3MJA==", - "dev": true, - "dependencies": { - "chalk": "^4.1.2", - "date-fns": "^2.29.3", - "lodash": "^4.17.21", - "rxjs": "^7.8.0", - "shell-quote": "^1.8.0", - "spawn-command": "0.0.2-1", - "supports-color": "^8.1.1", - "tree-kill": "^1.2.2", - "yargs": "^17.7.1" - }, - "bin": { - "conc": "dist/bin/concurrently.js", - "concurrently": "dist/bin/concurrently.js" - }, - "engines": { - "node": "^14.13.0 || >=16.0.0" - }, - "funding": { - "url": "https://github.com/open-cli-tools/concurrently?sponsor=1" - } - }, - "node_modules/date-fns": { - "version": "2.30.0", - "resolved": "https://registry.npmjs.org/date-fns/-/date-fns-2.30.0.tgz", - "integrity": "sha512-fnULvOpxnC5/Vg3NCiWelDsLiUc9bRwAPs/+LfTLNvetFCtCTN+yQz15C/fs4AwX1R9K5GLtLfn8QW+dWisaAw==", - "dev": true, - "dependencies": { - "@babel/runtime": "^7.21.0" - }, - "engines": { - "node": ">=0.11" - }, - "funding": { - "type": "opencollective", - "url": "https://opencollective.com/date-fns" - } - }, "node_modules/debug": { "version": "4.3.4", "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.4.tgz", @@ -240,21 +162,6 @@ } } }, - "node_modules/emoji-regex": { - "version": "8.0.0", - "resolved": "https://registry.npmjs.org/emoji-regex/-/emoji-regex-8.0.0.tgz", - "integrity": "sha512-MSjYzcWNOA0ewAHpz0MxpYFvwg6yjy1NG3xteoqz644VCo/RPgnr1/GGt+ic3iJTzQ8Eu3TdM14SawnVUmGE6A==", - "dev": true - }, - "node_modules/escalade": { - "version": "3.1.1", - "resolved": "https://registry.npmjs.org/escalade/-/escalade-3.1.1.tgz", - "integrity": "sha512-k0er2gUkLf8O0zKJiAhmkTnJlTvINGv7ygDNPbeIsX/TJjGJZHuh9B2UxbsaEkmlEo9MfhrSzmhIlhRlI2GXnw==", - "dev": true, - "engines": { - "node": ">=6" - } - }, "node_modules/fsevents": { "version": "2.3.2", "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz", @@ -269,15 +176,6 @@ "node": "^8.16.0 || ^10.6.0 || >=11.0.0" } }, - "node_modules/get-caller-file": { - "version": "2.0.5", - "resolved": "https://registry.npmjs.org/get-caller-file/-/get-caller-file-2.0.5.tgz", - "integrity": "sha512-DyFP3BM/3YHTQOCUL/w0OZHR0lpKeGrxotcHWcqNEdnltqFwXVfhEBQ94eIo34AfQpo0rGki4cyIiftY06h2Fg==", - "dev": true, - "engines": { - "node": "6.* || 8.* || >= 10.*" - } - }, "node_modules/has-flag": { "version": "4.0.0", "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", @@ -287,20 +185,10 @@ "node": ">=8" } }, - "node_modules/is-fullwidth-code-point": { - "version": "3.0.0", - "resolved": "https://registry.npmjs.org/is-fullwidth-code-point/-/is-fullwidth-code-point-3.0.0.tgz", - "integrity": "sha512-zymm5+u+sCsSWyD9qNaejV3DFvhCKclKdizYaJUuHA83RLjb7nSuGnddCHGv0hk+KY7BMAlsWeK4Ueg6EV6XQg==", - "dev": true, - "engines": { - "node": ">=8" - } - }, - "node_modules/lodash": { - "version": "4.17.21", - "resolved": "https://registry.npmjs.org/lodash/-/lodash-4.17.21.tgz", - "integrity": "sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg==", - "dev": true + "node_modules/linebyline": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/linebyline/-/linebyline-1.3.0.tgz", + "integrity": "sha512-3fpIYMrSU77OCf89hjXKuCx6vGwgWEu4N5DDCGqgZ1BF0HYy9V8IbQb/3+VWIU17iBQ83qQoUokH0AhPMOTi7w==" }, "node_modules/ms": { "version": "2.1.2", @@ -337,101 +225,6 @@ "node": ">=14.17" } }, - "node_modules/regenerator-runtime": { - "version": "0.13.11", - "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.13.11.tgz", - "integrity": "sha512-kY1AZVr2Ra+t+piVaJ4gxaFaReZVH40AKNo7UCX6W+dEwBo/2oZJzqfuN1qLq1oL45o56cPaTXELwrTh8Fpggg==", - "dev": true - }, - "node_modules/require-directory": { - "version": "2.1.1", - "resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz", - "integrity": "sha512-fGxEI7+wsG9xrvdjsrlmL22OMTTiHRwAMroiEeMgq8gzoLC/PQr7RsRDSTLUg/bZAZtF+TVIkHc6/4RIKrui+Q==", - "dev": true, - "engines": { - "node": ">=0.10.0" - } - }, - "node_modules/rxjs": { - "version": "7.8.1", - "resolved": "https://registry.npmjs.org/rxjs/-/rxjs-7.8.1.tgz", - "integrity": "sha512-AA3TVj+0A2iuIoQkWEK/tqFjBq2j+6PO6Y0zJcvzLAFhEFIO3HL0vls9hWLncZbAAbK0mar7oZ4V079I/qPMxg==", - "dev": true, - "dependencies": { - "tslib": "^2.1.0" - } - }, - "node_modules/shell-quote": { - "version": "1.8.1", - "resolved": "https://registry.npmjs.org/shell-quote/-/shell-quote-1.8.1.tgz", - "integrity": "sha512-6j1W9l1iAs/4xYBI1SYOVZyFcCis9b4KCLQ8fgAGG07QvzaRLVVRQvAy85yNmmZSjYjg4MWh4gNvlPujU/5LpA==", - "dev": true, - "funding": { - "url": "https://github.com/sponsors/ljharb" - } - }, - "node_modules/spawn-command": { - "version": "0.0.2-1", - "resolved": "https://registry.npmjs.org/spawn-command/-/spawn-command-0.0.2-1.tgz", - "integrity": "sha512-n98l9E2RMSJ9ON1AKisHzz7V42VDiBQGY6PB1BwRglz99wpVsSuGzQ+jOi6lFXBGVTCrRpltvjm+/XA+tpeJrg==", - "dev": true - }, - "node_modules/string-width": { - "version": "4.2.3", - "resolved": "https://registry.npmjs.org/string-width/-/string-width-4.2.3.tgz", - "integrity": "sha512-wKyQRQpjJ0sIp62ErSZdGsjMJWsap5oRNihHhu6G7JVO/9jIB6UyevL+tXuOqrng8j/cxKTWyWUwvSTriiZz/g==", - "dev": true, - "dependencies": { - "emoji-regex": "^8.0.0", - "is-fullwidth-code-point": "^3.0.0", - "strip-ansi": "^6.0.1" - }, - "engines": { - "node": ">=8" - } - }, - "node_modules/strip-ansi": { - "version": "6.0.1", - "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-6.0.1.tgz", - "integrity": "sha512-Y38VPSHcqkFrCpFnQ9vuSXmquuv5oXOKpGeT6aGrr3o3Gc9AlVa6JBfUSOCnbxGGZF+/0ooI7KrPuUSztUdU5A==", - "dev": true, - "dependencies": { - "ansi-regex": "^5.0.1" - }, - "engines": { - "node": ">=8" - } - }, - "node_modules/supports-color": { - "version": "8.1.1", - "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-8.1.1.tgz", - "integrity": "sha512-MpUEN2OodtUzxvKQl72cUF7RQ5EiHsGvSsVG0ia9c5RbWGL2CI4C7EpPS8UTBIplnlzZiNuV56w+FuNxy3ty2Q==", - "dev": true, - "dependencies": { - "has-flag": "^4.0.0" - }, - "engines": { - "node": ">=10" - }, - "funding": { - "url": "https://github.com/chalk/supports-color?sponsor=1" - } - }, - "node_modules/tree-kill": { - "version": "1.2.2", - "resolved": "https://registry.npmjs.org/tree-kill/-/tree-kill-1.2.2.tgz", - "integrity": "sha512-L0Orpi8qGpRG//Nd+H90vFB+3iHnue1zSSGmNOOCh1GLJ7rUKVwV2HvijphGQS2UmhUZewS9VgvxYIdgr+fG1A==", - "dev": true, - "bin": { - "tree-kill": "cli.js" - } - }, - "node_modules/tslib": { - "version": "2.5.0", - "resolved": "https://registry.npmjs.org/tslib/-/tslib-2.5.0.tgz", - "integrity": "sha512-336iVw3rtn2BUK7ORdIAHTyxHGRIHVReokCR3XjbckJMK7ms8FysBfhLR8IXnAgy7T0PTPNBWKiH514FOW/WSg==", - "dev": true - }, "node_modules/wait-port": { "version": "1.0.4", "resolved": "https://registry.npmjs.org/wait-port/-/wait-port-1.0.4.tgz", @@ -448,59 +241,6 @@ "engines": { "node": ">=10" } - }, - "node_modules/wrap-ansi": { - "version": "7.0.0", - "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-7.0.0.tgz", - "integrity": "sha512-YVGIj2kamLSTxw6NsZjoBxfSwsn0ycdesmc4p+Q21c5zPuZ1pl+NfxVdxPtdHvmNVOQ6XSYG4AUtyt/Fi7D16Q==", - "dev": true, - "dependencies": { - "ansi-styles": "^4.0.0", - "string-width": "^4.1.0", - "strip-ansi": "^6.0.0" - }, - "engines": { - "node": ">=10" - }, - "funding": { - "url": "https://github.com/chalk/wrap-ansi?sponsor=1" - } - }, - "node_modules/y18n": { - "version": "5.0.8", - "resolved": "https://registry.npmjs.org/y18n/-/y18n-5.0.8.tgz", - "integrity": "sha512-0pfFzegeDWJHJIAmTLRP2DwHjdF5s7jo9tuztdQxAhINCdvS+3nGINqPd00AphqJR/0LhANUS6/+7SCb98YOfA==", - "dev": true, - "engines": { - "node": ">=10" - } - }, - "node_modules/yargs": { - "version": "17.7.2", - "resolved": "https://registry.npmjs.org/yargs/-/yargs-17.7.2.tgz", - "integrity": "sha512-7dSzzRQ++CKnNI/krKnYRV7JKKPUXMEh61soaHKg9mrWEhzFWhFnxPxGl+69cD1Ou63C13NUPCnmIcrvqCuM6w==", - "dev": true, - "dependencies": { - "cliui": "^8.0.1", - "escalade": "^3.1.1", - "get-caller-file": "^2.0.5", - "require-directory": "^2.1.1", - "string-width": "^4.2.3", - "y18n": "^5.0.5", - "yargs-parser": "^21.1.1" - }, - "engines": { - "node": ">=12" - } - }, - "node_modules/yargs-parser": { - "version": "21.1.1", - "resolved": "https://registry.npmjs.org/yargs-parser/-/yargs-parser-21.1.1.tgz", - "integrity": "sha512-tVpsJW7DdjecAiFpbIB1e3qxIQsE6NoPc5/eTdrbbIC4h0LVsWhnoa3g+m2HclBIujHzsxZ4VJVA+GUuc2/LBw==", - "dev": true, - "engines": { - "node": ">=12" - } } } } diff --git a/waspc/headless-test/package.json b/waspc/headless-test/package.json index e6106802d..f7a25b95d 100644 --- a/waspc/headless-test/package.json +++ b/waspc/headless-test/package.json @@ -4,7 +4,7 @@ "description": "", "main": "index.js", "scripts": { - "example-app:start": "concurrently \"npm:example-app:start-db\" \"npm:example-app:start-app\" --kill-others-on-fail", + "example-app:start": "node start.js", "example-app:start-db": "npm run example-app:cleanup-db && cd ./examples/todoApp && cabal run wasp-cli start db", "example-app:start-app": "npm run example-app:wait-for-db && cd ./examples/todoApp && cabal run wasp-cli db migrate-dev && cabal run wasp-cli start", "example-app:wait-for-db": "sleep 5 && ./node_modules/.bin/wait-port 5432", @@ -15,9 +15,9 @@ "license": "ISC", "devDependencies": { "@playwright/test": "^1.33.0", - "concurrently": "^8.0.1", "prisma": "^4.12.0", - "wait-port": "^1.0.4" + "wait-port": "^1.0.4", + "linebyline": "^1.3.0" }, "dependencies": { "@prisma/client": "^4.12.0" diff --git a/waspc/headless-test/start.js b/waspc/headless-test/start.js new file mode 100644 index 000000000..58585e9a6 --- /dev/null +++ b/waspc/headless-test/start.js @@ -0,0 +1,31 @@ +const cp = require('child_process'); +const readline = require('linebyline'); + +function spawn(name, cmd, args, done) { + const spawnOptions = { + detached: true, + }; + const proc = cp.spawn(cmd, args, spawnOptions); + + // We close stdin stream on the new process because otherwise the start-app + // process hangs. + // See https://github.com/wasp-lang/wasp/pull/1218#issuecomment-1599098272. + proc.stdin.destroy(); + + readline(proc.stdout).on('line', data => { + console.log(`\x1b[0m\x1b[33m[${name}][out]\x1b[0m ${data}`); + }); + readline(proc.stderr).on('line', data => { + console.log(`\x1b[0m\x1b[33m[${name}][err]\x1b[0m ${data}`); + }); + proc.on('exit', done); +} + +// Exit if either child fails +const cb = (code) => { + if (code !== 0) { + process.exit(code); + } +} +spawn('app', 'npm', ['run', 'example-app:start-app'], cb); +spawn('db', 'npm', ['run', 'example-app:start-db'], cb) diff --git a/waspc/src/Wasp/Generator/DbGenerator/Jobs.hs b/waspc/src/Wasp/Generator/DbGenerator/Jobs.hs index ea544d379..82e277add 100644 --- a/waspc/src/Wasp/Generator/DbGenerator/Jobs.hs +++ b/waspc/src/Wasp/Generator/DbGenerator/Jobs.hs @@ -7,6 +7,7 @@ module Wasp.Generator.DbGenerator.Jobs runStudio, reset, seed, + dbExecuteTest, migrateStatus, asPrismaCliArgs, ) @@ -113,6 +114,19 @@ seed projectDir seedName = projectDir (const ["db", "seed"]) +-- | Checks if the DB is running and connectable by running +-- `prisma db execute --stdin --schema `. +-- Runs the command in the generated server code directory so it has access to the database URL. +-- +-- Since nothing is passed to stdin, `prisma db execute` just runs an empty +-- SQL command, which works perfectly for checking if the database is running. +dbExecuteTest :: Path' Abs (Dir ProjectRootDir) -> J.Job +dbExecuteTest projectDir = + let absSchemaPath = projectDir dbSchemaFileInProjectRootDir + in runPrismaCommandAsDbJob + projectDir + (const ["db", "execute", "--stdin", "--schema", SP.fromAbsFile absSchemaPath]) + -- | Runs `prisma studio` - Prisma's db inspector. runStudio :: Path' Abs (Dir ProjectRootDir) -> J.Job runStudio projectDir = runPrismaCommandAsDbJob projectDir $ \schema -> diff --git a/waspc/src/Wasp/Generator/DbGenerator/Operations.hs b/waspc/src/Wasp/Generator/DbGenerator/Operations.hs index 30c97a22a..20696af04 100644 --- a/waspc/src/Wasp/Generator/DbGenerator/Operations.hs +++ b/waspc/src/Wasp/Generator/DbGenerator/Operations.hs @@ -6,6 +6,7 @@ module Wasp.Generator.DbGenerator.Operations areAllMigrationsAppliedToDb, dbReset, dbSeed, + isDbRunning, ) where @@ -134,6 +135,16 @@ dbSeed genProjectDir seedName = do ExitSuccess -> Right () ExitFailure c -> Left $ "Failed with exit code " <> show c +isDbRunning :: + Path' Abs (Dir ProjectRootDir) -> + IO Bool +isDbRunning genProjectDir = do + chan <- newChan + exitCode <- DbJobs.dbExecuteTest genProjectDir chan + -- NOTE: We only care if the command succeeds or fails, so we don't look at + -- the exit code or stdout/stderr for the process. + return $ exitCode == ExitSuccess + generatePrismaClients :: Path' Abs (Dir ProjectRootDir) -> IO (Either String ()) generatePrismaClients projectRootDir = do generateResult <- liftA2 (>>) generatePrismaClientForServer generatePrismaClientForWebApp projectRootDir diff --git a/waspc/waspc.cabal b/waspc/waspc.cabal index 4f95f2fc3..0499439a7 100644 --- a/waspc/waspc.cabal +++ b/waspc/waspc.cabal @@ -354,8 +354,13 @@ library waspls Wasp.LSP.Handlers Wasp.LSP.Diagnostic Wasp.LSP.Completion - Wasp.LSP.Util + Wasp.LSP.Completions.Common + Wasp.LSP.Completions.DictKeyCompletion + Wasp.LSP.Completions.ExprCompletion + Wasp.LSP.SignatureHelp Wasp.LSP.Syntax + Wasp.LSP.TypeInference + Wasp.LSP.Util build-depends: base , aeson @@ -370,6 +375,7 @@ library waspls , text , transformers ^>=0.5.6.2 , utf8-string + , unordered-containers , waspc library cli-lib @@ -434,6 +440,7 @@ library cli-lib Wasp.Cli.Command.Deploy Wasp.Cli.Command.Dockerfile Wasp.Cli.Command.Info + Wasp.Cli.Command.Require Wasp.Cli.Command.Start Wasp.Cli.Command.Start.Db Wasp.Cli.Command.Telemetry diff --git a/waspc/waspls/src/Wasp/LSP/Completion.hs b/waspc/waspls/src/Wasp/LSP/Completion.hs index 95c56a62f..3a610adfe 100644 --- a/waspc/waspls/src/Wasp/LSP/Completion.hs +++ b/waspc/waspls/src/Wasp/LSP/Completion.hs @@ -3,18 +3,18 @@ module Wasp.LSP.Completion ) where -import Control.Lens ((?~), (^.)) +import Control.Lens ((^.)) import Control.Monad.Log.Class (MonadLog (logM)) import Control.Monad.State.Class (MonadState, gets) -import Data.Maybe (maybeToList) -import qualified Data.Text as Text +import Data.List (sortOn) import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Lens as LSP -import Wasp.Analyzer.Parser.CST (SyntaxNode) -import qualified Wasp.Analyzer.Parser.CST as S -import Wasp.Analyzer.Parser.CST.Traverse -import Wasp.LSP.ServerState -import Wasp.LSP.Syntax (findChild, isAtExprPlace, lexemeAt, lspPositionToOffset, showNeighborhood, toOffset) +import Wasp.Analyzer.Parser.CST.Traverse (fromSyntaxForest) +import Wasp.LSP.Completions.Common (CompletionContext (..), CompletionProvider) +import qualified Wasp.LSP.Completions.DictKeyCompletion as DictKeyCompletion +import qualified Wasp.LSP.Completions.ExprCompletion as ExprCompletion +import Wasp.LSP.ServerState (ServerState, cst, currentWaspSource) +import Wasp.LSP.Syntax (locationAtOffset, lspPositionToOffset, showNeighborhood) -- | Get the list of completions at a (line, column) position in the source. getCompletionsAtPosition :: @@ -30,76 +30,18 @@ getCompletionsAtPosition position = do Just syntax -> do let offset = lspPositionToOffset src position -- 'location' is a traversal through the syntax tree that points to 'position' - let location = toOffset offset (fromSyntaxForest syntax) + let location = locationAtOffset offset (fromSyntaxForest syntax) + logM $ "[getCompletionsAtPosition] position=" ++ show position ++ " offset=" ++ show offset logM $ "[getCompletionsAtPosition] neighborhood=\n" ++ showNeighborhood location - exprCompletions <- - if isAtExprPlace location - then do - logM $ "[getCompletionsAtPosition] offset=" ++ show offset ++ " position=" ++ show position ++ " atExpr=True" - getExprCompletions src syntax - else do - logM $ "[getCompletionsAtPosition] offset=" ++ show offset ++ " position=" ++ show position ++ " atExpr=False" - return [] - let completions = exprCompletions - return completions + let completionContext = CompletionContext {_src = src, _cst = syntax} + let runCompletionProvider = \cp -> cp completionContext location + completionItems <- concat <$> mapM runCompletionProvider completionProviders + return $ sortOn (^. LSP.label) completionItems --- | If the location is at an expression, find declaration names in the file --- and return them as autocomplete suggestions --- --- TODO: include completions for enum variants (use standard type defs from waspc) -getExprCompletions :: - (MonadLog m) => - String -> - [SyntaxNode] -> - m [LSP.CompletionItem] -getExprCompletions src syntax = do - let declNames = findDeclNames src syntax - logM $ "[getExprCompletions] declnames=" ++ show declNames - return $ - map - ( \(name, typ) -> - makeBasicCompletionItem (Text.pack name) - & (LSP.kind ?~ LSP.CiVariable) - & (LSP.detail ?~ Text.pack (":: " ++ typ ++ " (declaration type)")) - ) - declNames - --- | Search through the CST and collect all @(declName, declType)@ pairs. -findDeclNames :: String -> [SyntaxNode] -> [(String, String)] -findDeclNames src syntax = traverseForDeclNames $ fromSyntaxForest syntax - where - traverseForDeclNames :: Traversal -> [(String, String)] - traverseForDeclNames t = case kindAt t of - S.Program -> maybe [] traverseForDeclNames $ down t - S.Decl -> - let declNameAndType = maybeToList $ getDeclNameAndType t - in declNameAndType ++ maybe [] traverseForDeclNames (right t) - _ -> maybe [] traverseForDeclNames $ right t - getDeclNameAndType :: Traversal -> Maybe (String, String) - getDeclNameAndType t = do - nameT <- findChild S.DeclName t - typeT <- findChild S.DeclType t - return (lexemeAt src nameT, lexemeAt src typeT) - --- | Create a completion item containing only a label. -makeBasicCompletionItem :: Text.Text -> LSP.CompletionItem -makeBasicCompletionItem name = - LSP.CompletionItem - { _label = name, - _kind = Nothing, - _tags = Nothing, - _detail = Nothing, - _documentation = Nothing, - _deprecated = Nothing, - _preselect = Nothing, - _sortText = Nothing, - _filterText = Nothing, - _insertText = Nothing, - _insertTextFormat = Nothing, - _insertTextMode = Nothing, - _textEdit = Nothing, - _additionalTextEdits = Nothing, - _commitCharacters = Nothing, - _command = Nothing, - _xdata = Nothing - } +-- | List of all 'CompletionProvider's to use. We break this up into separate +-- modules because the code for each can be pretty unrelated. +completionProviders :: (MonadLog m) => [CompletionProvider m] +completionProviders = + [ ExprCompletion.getCompletions, + DictKeyCompletion.getCompletions + ] diff --git a/waspc/waspls/src/Wasp/LSP/Completions/Common.hs b/waspc/waspls/src/Wasp/LSP/Completions/Common.hs new file mode 100644 index 000000000..f0238b0cd --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Completions/Common.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wasp.LSP.Completions.Common + ( CompletionProvider, + CompletionContext (..), + src, + cst, + makeBasicCompletionItem, + ) +where + +import Control.Lens (makeClassy) +import qualified Data.Text as Text +import qualified Language.LSP.Types as LSP +import Wasp.Analyzer.Parser.CST (SyntaxNode) +import Wasp.Analyzer.Parser.CST.Traverse (Traversal) + +-- | A function that providers 'LSP.CompletionItems' at a location. +type CompletionProvider m = CompletionContext -> Traversal -> m [LSP.CompletionItem] + +data CompletionContext = CompletionContext + { _src :: String, + _cst :: [SyntaxNode] + } + deriving (Eq, Show) + +makeClassy 'CompletionContext + +-- | Create a completion item containing only a label. Use lenses and 'Control.Lens.(?~)' +-- to set more fields, if desired. +makeBasicCompletionItem :: Text.Text -> LSP.CompletionItem +makeBasicCompletionItem name = + LSP.CompletionItem + { _label = name, + _kind = Nothing, + _tags = Nothing, + _detail = Nothing, + _documentation = Nothing, + _deprecated = Nothing, + _preselect = Nothing, + _sortText = Nothing, + _filterText = Nothing, + _insertText = Nothing, + _insertTextFormat = Nothing, + _insertTextMode = Nothing, + _textEdit = Nothing, + _additionalTextEdits = Nothing, + _commitCharacters = Nothing, + _command = Nothing, + _xdata = Nothing + } diff --git a/waspc/waspls/src/Wasp/LSP/Completions/DictKeyCompletion.hs b/waspc/waspls/src/Wasp/LSP/Completions/DictKeyCompletion.hs new file mode 100644 index 000000000..a2335ad90 --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Completions/DictKeyCompletion.hs @@ -0,0 +1,74 @@ +module Wasp.LSP.Completions.DictKeyCompletion + ( getCompletions, + ) +where + +import Control.Lens ((?~), (^.)) +import Control.Monad.Log.Class (MonadLog (logM)) +import Data.Bifunctor (Bifunctor (second)) +import qualified Data.HashMap.Strict as M +import qualified Data.Text as Text +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as LSP +import qualified Wasp.Analyzer.Parser.CST as S +import Wasp.Analyzer.Parser.CST.Traverse (Traversal) +import qualified Wasp.Analyzer.Parser.CST.Traverse as T +import Wasp.Analyzer.Type (Type) +import qualified Wasp.Analyzer.Type as Type +import Wasp.LSP.Completions.Common (CompletionProvider, makeBasicCompletionItem) +import qualified Wasp.LSP.Completions.Common as Ctx +import Wasp.LSP.Syntax (hasLeft, parentIs) +import Wasp.LSP.TypeInference (inferTypeAtLocation) +import Wasp.LSP.Util (allP, anyP) + +-- | If the location is at a place where a dictionary key is expected, find +-- the list of keys that are allowed in the dictionary around the location and +-- return them as completion items. +-- +-- The allowed keys are found by determining the expected type for the +-- dictionary and getting the keys from that, assuming it is a 'Type.DictType'. +-- No completions are made if there is no expected type or if the expected type +-- is not a 'Type.DictType'. +-- +-- See 'Wasp.LSP.TypeHint' for how the expected type for the dictionary is +-- determined. +getCompletions :: (MonadLog m) => CompletionProvider m +getCompletions context location = + if not $ isDictKeyExpectedAtLocation location + then do + logM "[DictKeyCompletion] not at dict key" + return [] + else do + logM "[DictKeyCompletion] at dict key" + getCompletionsAtDictKey + where + getCompletionsAtDictKey = case inferTypeAtLocation (context ^. Ctx.src) location of + Nothing -> do + logM "[DictKeyCompletion] no type hint, can not suggest keys" + return [] + Just (Type.DictType fieldMap) -> do + logM "[DictKeyCompletion] found dict type hint" + return $ map completionItemFromDictField $ listDictFields fieldMap + Just _ -> do + logM "[DictKeyCompletion] found non-dict type hint, no keys to suggest" + return [] + + completionItemFromDictField (key, keyType) = + -- The user sees "key", but when they accept the completion "key: " is + -- inserted, via the @insertText@ field. + makeBasicCompletionItem (Text.pack key) + T.& (LSP.kind ?~ LSP.CiField) + T.& (LSP.detail ?~ Text.pack (":: " ++ show keyType)) + T.& (LSP.insertText ?~ Text.pack (key ++ ": ")) + +isDictKeyExpectedAtLocation :: Traversal -> Bool +isDictKeyExpectedAtLocation = + anyP + [ parentIs S.Dict, + allP [parentIs S.DictEntry, not . hasLeft S.DictKey] + ] + +-- | List the (key, valuetype) pairs for a type. Returns an empty list for +-- everything except a 'Type.DictType'. +listDictFields :: M.HashMap String Type.DictEntryType -> [(String, Type)] +listDictFields fieldMap = map (second Type.dictEntryType) $ M.toList fieldMap diff --git a/waspc/waspls/src/Wasp/LSP/Completions/ExprCompletion.hs b/waspc/waspls/src/Wasp/LSP/Completions/ExprCompletion.hs new file mode 100644 index 000000000..009d350c0 --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/Completions/ExprCompletion.hs @@ -0,0 +1,60 @@ +module Wasp.LSP.Completions.ExprCompletion + ( getCompletions, + ) +where + +import Control.Lens ((?~), (^.)) +import Control.Monad.Log.Class (MonadLog (logM)) +import Data.Maybe (maybeToList) +import qualified Data.Text as Text +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Lens as LSP +import Wasp.Analyzer.Parser.CST (SyntaxNode) +import qualified Wasp.Analyzer.Parser.CST as S +import Wasp.Analyzer.Parser.CST.Traverse +import Wasp.LSP.Completions.Common (CompletionProvider, makeBasicCompletionItem) +import qualified Wasp.LSP.Completions.Common as Ctx +import Wasp.LSP.Syntax (findChild, isAtExprPlace, lexemeAt) + +-- | If the location is at an expression, find declaration names in the file +-- and return them as completion items. +-- +-- TODO: include completions for enum variants (use standard type defs from waspc) +getCompletions :: (MonadLog m) => CompletionProvider m +getCompletions context location = + if not (isAtExprPlace location) + then do + logM "[ExprCompletion] not at expression" + return [] + else do + logM "[ExprCompletion] at expression" + let declNames = getDeclNamesAndTypes (context ^. Ctx.src) (context ^. Ctx.cst) + logM $ "[ExprCompletion] declnames=" ++ show declNames + return $ + map + ( \(name, typ) -> + makeBasicCompletionItem (Text.pack name) + & (LSP.kind ?~ LSP.CiVariable) + & (LSP.detail ?~ Text.pack (":: " ++ typ ++ " (declaration type)")) + ) + declNames + +-- | Search through the CST and collect all @(declName, declType)@ pairs. +getDeclNamesAndTypes :: String -> [SyntaxNode] -> [(String, String)] +getDeclNamesAndTypes src syntax = traverseForDeclNames $ fromSyntaxForest syntax + where + traverseForDeclNames :: Traversal -> [(String, String)] + traverseForDeclNames t = case kindAt t of + S.Program -> maybe [] traverseForDeclNames $ down t + S.Decl -> + let declNameAndType = maybeToList $ getDeclNameAndType t + in declNameAndType ++ maybe [] traverseForDeclNames (right t) + _ -> maybe [] traverseForDeclNames $ right t + + -- @getDeclNameAndType t@ expects 't' to be at a 'S.Decl' node. It finds the + -- lexemes for the 'S.DeclName' and 'S.DeclType'. + getDeclNameAndType :: Traversal -> Maybe (String, String) + getDeclNameAndType t = do + nameT <- findChild S.DeclName t + typeT <- findChild S.DeclType t + return (lexemeAt src nameT, lexemeAt src typeT) diff --git a/waspc/waspls/src/Wasp/LSP/Handlers.hs b/waspc/waspls/src/Wasp/LSP/Handlers.hs index f605f44a4..aff4d91f3 100644 --- a/waspc/waspls/src/Wasp/LSP/Handlers.hs +++ b/waspc/waspls/src/Wasp/LSP/Handlers.hs @@ -4,6 +4,7 @@ module Wasp.LSP.Handlers didChangeHandler, didSaveHandler, completionHandler, + signatureHelpHandler, ) where @@ -22,6 +23,7 @@ import Wasp.LSP.Completion (getCompletionsAtPosition) import Wasp.LSP.Diagnostic (concreteParseErrorToDiagnostic, waspErrorToDiagnostic) import Wasp.LSP.ServerM (ServerError (..), ServerM, Severity (..), gets, liftLSP, modify, throwError) import Wasp.LSP.ServerState (cst, currentWaspSource, latestDiagnostics) +import Wasp.LSP.SignatureHelp (getSignatureHelpAtPosition) -- LSP notification and request handlers @@ -65,6 +67,15 @@ completionHandler = completions <- getCompletionsAtPosition $ request ^. LSP.params . LSP.position respond $ Right $ LSP.InL $ LSP.List completions +signatureHelpHandler :: Handlers ServerM +signatureHelpHandler = + LSP.requestHandler LSP.STextDocumentSignatureHelp $ \request respond -> do + -- NOTE: lsp-types 1.4.0.1 forgot to add lenses for SignatureHelpParams so + -- we have to get the position out the painful way. + let LSP.SignatureHelpParams {_position = position} = request ^. LSP.params + signatureHelp <- getSignatureHelpAtPosition position + respond $ Right signatureHelp + -- | Does not directly handle a notification or event, but should be run when -- text document content changes. -- diff --git a/waspc/waspls/src/Wasp/LSP/Server.hs b/waspc/waspls/src/Wasp/LSP/Server.hs index d22b2122b..02e895e2c 100644 --- a/waspc/waspls/src/Wasp/LSP/Server.hs +++ b/waspc/waspls/src/Wasp/LSP/Server.hs @@ -20,6 +20,7 @@ import Wasp.LSP.Handlers import Wasp.LSP.ServerConfig (ServerConfig) import Wasp.LSP.ServerM (ServerError (..), ServerM, Severity (..), runServerM) import Wasp.LSP.ServerState (ServerState) +import Wasp.LSP.SignatureHelp (signatureHelpRetriggerCharacters, signatureHelpTriggerCharacters) lspServerHandlers :: LSP.Handlers ServerM lspServerHandlers = @@ -28,7 +29,8 @@ lspServerHandlers = didOpenHandler, didSaveHandler, didChangeHandler, - completionHandler + completionHandler, + signatureHelpHandler ] serve :: Maybe FilePath -> IO () @@ -100,7 +102,9 @@ lspServerOptions :: LSP.Options lspServerOptions = (def :: LSP.Options) { LSP.textDocumentSync = Just syncOptions, - LSP.completionTriggerCharacters = Just [':'] + LSP.completionTriggerCharacters = Just [':', ' '], + LSP.signatureHelpTriggerCharacters = signatureHelpTriggerCharacters, + LSP.signatureHelpRetriggerCharacters = signatureHelpRetriggerCharacters } -- | Options to tell the client how to update the server about the state of text diff --git a/waspc/waspls/src/Wasp/LSP/SignatureHelp.hs b/waspc/waspls/src/Wasp/LSP/SignatureHelp.hs new file mode 100644 index 000000000..e423c71ba --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/SignatureHelp.hs @@ -0,0 +1,257 @@ +module Wasp.LSP.SignatureHelp + ( getSignatureHelpAtPosition, + signatureHelpTriggerCharacters, + signatureHelpRetriggerCharacters, + ) +where + +import Control.Applicative ((<|>)) +import Control.Lens ((^.)) +import Control.Monad (guard) +import Control.Monad.Log.Class (MonadLog, logM) +import Control.Monad.State.Class (MonadState, gets) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (runMaybeT)) +import qualified Data.HashMap.Strict as M +import Data.List (elemIndex, foldl', intersperse) +import Data.Maybe (mapMaybe) +import Data.String (IsString (fromString)) +import qualified Data.Text as Text +import qualified Language.LSP.Types as LSP +import Text.Printf (printf) +import Wasp.Analyzer.Parser.CST.Traverse (Traversal, fromSyntaxForest) +import Wasp.Analyzer.Type (Type) +import qualified Wasp.Analyzer.Type as Type +import Wasp.LSP.ServerState (ServerState, cst, currentWaspSource) +import Wasp.LSP.Syntax (locationAtOffset, lspPositionToOffset) +import Wasp.LSP.TypeInference (ExprPathStep (DictKey, List, Tuple), findExprPathToLocation, findTypeForPath) +import Wasp.LSP.Util (hoistMaybe) + +-- | Configuration for 'LSP.Options', used in "Wasp.LSP.Server". +-- +-- When the client types one of these characters, it will send a SignatureHelp +-- request. It is configured so that signatures will display when starting a +-- dictionary, list, tuple, or starting a new field/value in the container. +signatureHelpTriggerCharacters :: Maybe [Char] +signatureHelpTriggerCharacters = Just "{[(:," + +-- | Configuration for 'LSP.Options', used in "Wasp.LSP.Server". +-- +-- When a client is already displaying signature help, typing one of these +-- characters will cause it to update the displayed signature by sending a new +-- SignatureHelp request. It is configured so that signatures will update when +-- ending a dictionary, list, or tuple. +-- +-- NOTE: 'signatureHelpTriggerCharacters' are also counted as retrigger characters. +signatureHelpRetriggerCharacters :: Maybe [Char] +signatureHelpRetriggerCharacters = Just "}])" + +-- | Get 'LSP.SignatureHelp' at a position in the wasp file. The signature +-- displays the type of the "container" that the position is in, if any. +-- +-- SignatureHelp is usually displayed as a popup near the text you are typing, +-- and highlights the part of the signature you are writing. +-- +-- A container is an expression that holds other values, such as dictionaries +-- and lists. +-- +-- The parameter field of the signature is used for which part of the container +-- the position is within, such as a key for a dictionary. +getSignatureHelpAtPosition :: + (MonadState ServerState m, MonadLog m) => + LSP.Position -> + m LSP.SignatureHelp +getSignatureHelpAtPosition position = do + src <- gets (^. currentWaspSource) + gets (^. cst) >>= \case + Nothing -> + -- No CST in the server state, can't create a signature. + return emptyHelp + Just syntax -> + let offset = lspPositionToOffset src position + location = locationAtOffset offset (fromSyntaxForest syntax) + in getSignatureHelpAtLocation src location + where + getSignatureHelpAtLocation src location = + findSignatureAtLocation src location >>= \case + Nothing -> do + logM "[getSignatureHelpAtPosition] no signature found" + return emptyHelp + Just signature -> do + logM "[getSignatureHelpAtPosition] found a signature" + getLspSignatureFromSignature signature + + getLspSignatureFromSignature signature = do + let signatureFragments = signatureToFragments signature + let params = getLspParamsInfoFromFragments signatureFragments + let activeParam = signatureParam signature >>= findActiveParameterIndex signatureFragments + logM $ "[getSignatureHelpAtPosition] at param idx = " ++ show activeParam ++ " params = " ++ show params + let signatureInformation = + LSP.SignatureInformation + { _label = Text.pack $ showFragments signatureFragments, + _parameters = Just $ LSP.List params, + -- NOTE: VSCode highlights the 0th parameter if activeParameter, so + -- it's set to -1 when we don't want any parameter highlighted. + _activeParameter = activeParam <|> Just (-1), + _documentation = Nothing + } + return $ + LSP.SignatureHelp + { _signatures = LSP.List [signatureInformation], + _activeSignature = Just 0, + _activeParameter = Nothing + } + + emptyHelp = + LSP.SignatureHelp + { _signatures = LSP.List [], + _activeSignature = Nothing, + _activeParameter = Nothing + } + +-- | 'Signature' describes the expected type at a specific location inside of +-- a container in a wasp file. Every signature includes the type of the container +-- surrounding the location. For example, the container type for a cursor +-- positioned inside of a dictionary would be the type of the dictionary. +-- +-- When the location is at a more specific place inside of the container--for +-- example, immediately after @key: @ in a dictionary--then we say the location +-- is at a parameter, and the parameter is described in relation to the container +-- with an 'ExprPathStep'. +data Signature = Signature + { signatureType :: !Type, + signatureParam :: !(Maybe ExprPathStep) + } + deriving (Eq, Show) + +-- | @'findSignatureAtLocation' sourceCode location@ runs type inference at the +-- given location to try to find a 'Signature'. +-- +-- To do this, two types are inferred: the /location type/ and the +-- /container type/. The location type is the type expected exactly at the given +-- location and the container type is the type of that contains the location +-- type. For example, if the cursor is at the 2nd entry of a tuple with type +-- @(string, number)@, then the tip type is @number@ and the parent type is +-- that tuple type. +-- +-- Then we check if the cursor is just inside a container or at a parameter +-- inside a container. It's in a container when the location type is a container +-- or if there is no container type. +findSignatureAtLocation :: + (MonadLog m) => + String -> + Traversal -> + m (Maybe Signature) +findSignatureAtLocation src location = runMaybeT $ do + exprPath <- hoistMaybe $ findExprPathToLocation src location + lift $ logM $ "[SignatureHelp] at expr path " ++ show exprPath + guard $ not $ null exprPath + case exprPath of + [path] -> do + containerType <- hoistMaybe (findTypeForPath [path]) + return $ Signature containerType Nothing + path -> do + -- Using init/last here is OK since we know @path@ has at least 2 elements. + locationType <- hoistMaybe $ findTypeForPath path + if isContainerType locationType + then return $ Signature locationType Nothing + else do + containerType <- hoistMaybe $ findTypeForPath $ init path + return $ Signature containerType (Just $ last path) + where + isContainerType :: Type -> Bool + isContainerType (Type.DictType _) = True + isContainerType (Type.ListType _) = True + isContainerType Type.TupleType {} = True + isContainerType _ = False + +-- | A fragment of the text representation of a signature, with information +-- for finding the spans of parameters inside of the text representation. +-- +-- This is used as an intermediate form between 'Signature' and the response +-- format that the LSP specifies. +data SignatureFragment + = -- | A plaintext fragment of a signature. + PlaintextFragment !String + | -- | A fragment that contains the text for a parameter of the signature. The + -- parameter is identified by the 'ExprPathStep'. + ParamFragment !ExprPathStep !String + deriving (Eq, Show) + +fragmentText :: SignatureFragment -> String +fragmentText (PlaintextFragment text) = text +fragmentText (ParamFragment _ text) = text + +fragmentParam :: SignatureFragment -> Maybe ExprPathStep +fragmentParam (PlaintextFragment _) = Nothing +fragmentParam (ParamFragment key _) = Just key + +instance IsString SignatureFragment where + fromString string = PlaintextFragment string + +-- | Convert the container type of a signature to a list of fragments. +-- +-- To avoid unreadably long signatures, dictionary types inside of the container +-- type are written as @{ ... }@. +signatureToFragments :: Signature -> [SignatureFragment] +signatureToFragments signature = case signatureType signature of + Type.DictType fieldMap + | M.null fieldMap -> ["{}"] + | otherwise -> + let fields = intersperse ",\n " (map fieldToFragment (M.toList fieldMap)) + in concat [["{\n "], fields, ["\n}"]] + Type.ListType inner -> ["[", ParamFragment List (showInnerType inner), "]"] + Type.TupleType (a, b, cs) -> + let fieldTypes = a : b : cs + fields = intersperse ", " (zipWith (\n -> ParamFragment (Tuple n) . showInnerType) [0 ..] fieldTypes) + in concat [["("], fields, [")"]] + typ -> [fromString (show typ)] + where + showInnerType :: IsString s => Type -> s + showInnerType (Type.DictType _) = "{ ... }" + showInnerType typ = fromString (show typ) + + fieldToFragment :: (String, Type.DictEntryType) -> SignatureFragment + fieldToFragment (key, Type.DictRequired typ) = + ParamFragment (DictKey key) $ printf "%s: %s" key (showInnerType typ :: String) + fieldToFragment (key, Type.DictOptional typ) = + ParamFragment (DictKey key) $ printf "%s?: %s" key (showInnerType typ :: String) + +-- | Convert a list of fragments to a string by concatenating the text of each +-- fragment. +showFragments :: [SignatureFragment] -> String +showFragments = concatMap fragmentText + +-- | Search through a list of fragments to find the parameters. +-- +-- The LSP wants the starting and ending offset of each parameter in the signature +-- help text (computed in 'showFragments'), so this function also has to keep +-- track of the 0-based offset into the final text. +getLspParamsInfoFromFragments :: [SignatureFragment] -> [LSP.ParameterInformation] +getLspParamsInfoFromFragments fragments = + reverse $ map labelToInfo $ snd $ foldl' go (0, []) fragments + where + -- A left fold is used because offset needs to increase as you go right across + -- the list. This means the parameter list needs to be reversed after the fold + -- so that they are in the same order as the parameters in the fragments. + go :: (LSP.UInt, [LSP.ParameterLabel]) -> SignatureFragment -> (LSP.UInt, [LSP.ParameterLabel]) + go (offset, labels) (PlaintextFragment text) = (offset + fromIntegral (length text), labels) + go (offset, labels) (ParamFragment _ text) = + let end = offset + fromIntegral (length text) + in (end, LSP.ParameterLabelOffset offset end : labels) + + labelToInfo :: LSP.ParameterLabel -> LSP.ParameterInformation + labelToInfo label = + LSP.ParameterInformation + { _label = label, + _documentation = Nothing + } + +-- | Find the index of the active parameter in a list of fragments. +-- +-- NOTE: This function computes the index into the parameter list, not the +-- fragment list. This is why 'PlaintextFragment's are filtered out of the +-- list before indexing (via @mapMaybe fragmentParam@). +findActiveParameterIndex :: [SignatureFragment] -> ExprPathStep -> Maybe LSP.UInt +findActiveParameterIndex fragments key = + fromIntegral <$> elemIndex key (mapMaybe fragmentParam fragments) diff --git a/waspc/waspls/src/Wasp/LSP/Syntax.hs b/waspc/waspls/src/Wasp/LSP/Syntax.hs index 0b0fb91fb..38e4e9134 100644 --- a/waspc/waspls/src/Wasp/LSP/Syntax.hs +++ b/waspc/waspls/src/Wasp/LSP/Syntax.hs @@ -3,7 +3,9 @@ module Wasp.LSP.Syntax -- | Module with utilities for working with/looking for patterns in CSTs lspPositionToOffset, - toOffset, + locationAtOffset, + parentIs, + hasLeft, isAtExprPlace, lexemeAt, findChild, @@ -16,6 +18,7 @@ import Data.List (find, intercalate) import qualified Language.LSP.Types as J import qualified Wasp.Analyzer.Parser.CST as S import Wasp.Analyzer.Parser.CST.Traverse +import Wasp.LSP.Util (allP, anyP) -- | @lspPositionToOffset srcString position@ returns 0-based offset from the -- start of @srcString@ to the specified line and column. @@ -27,21 +30,31 @@ lspPositionToOffset srcString (J.Position l c) = -- | Move to the node containing the offset. -- --- This tries to prefer non-trivia tokens where possible. If the offset falls --- exactly between two tokens, it choses the left-most non-trivia token. -toOffset :: Int -> Traversal -> Traversal -toOffset targetOffset start = go $ bottom start +-- If the offset falls on the border between two nodes, it tries to first choose +-- the leftmost non-trivia token, and then the leftmost token. +locationAtOffset :: Int -> Traversal -> Traversal +locationAtOffset targetOffset start = go $ bottom start where go :: Traversal -> Traversal go at | offsetAt at == targetOffset = at | offsetAfter at > targetOffset = at - | offsetAfter at == targetOffset && not (S.syntaxKindIsTrivia (kindAt at)) = - at + | offsetAfter at == targetOffset = + if not $ S.syntaxKindIsTrivia $ kindAt at + then at + else case at & next of + Just at' | not (S.syntaxKindIsTrivia (kindAt at')) -> at' + _ -> at -- If @at & next@ fails, the input doesn't contain the offset, so just -- return the last node instead. | otherwise = maybe at go $ at & next +parentIs :: S.SyntaxKind -> Traversal -> Bool +parentIs k t = Just k == parentKind t + +hasLeft :: S.SyntaxKind -> Traversal -> Bool +hasLeft k t = k `elem` map kindAt (leftSiblings t) + -- | Check whether a position in a CST is somewhere an expression belongs. These -- locations (as of now) are: -- @@ -50,14 +63,13 @@ toOffset targetOffset start = go $ bottom start -- - Parent is a List -- - Parent is a Tuple isAtExprPlace :: Traversal -> Bool -isAtExprPlace t = - (parentIs S.DictEntry && hasLeft S.DictKey) - || parentIs S.List - || (parentIs S.Decl && hasLeft S.DeclType && hasLeft S.DeclName) - || parentIs S.Tuple - where - parentIs k = Just k == parentKind t - hasLeft k = k `elem` map kindAt (leftSiblings t) +isAtExprPlace = + anyP + [ allP [parentIs S.DictEntry, hasLeft S.DictKey], + allP [parentIs S.Decl, hasLeft S.DeclType, hasLeft S.DeclName], + parentIs S.List, + parentIs S.Tuple + ] -- | Show the nodes around the current position -- diff --git a/waspc/waspls/src/Wasp/LSP/TypeInference.hs b/waspc/waspls/src/Wasp/LSP/TypeInference.hs new file mode 100644 index 000000000..ad5ec5f25 --- /dev/null +++ b/waspc/waspls/src/Wasp/LSP/TypeInference.hs @@ -0,0 +1,124 @@ +module Wasp.LSP.TypeInference + ( -- * Inferred types for CST locations + inferTypeAtLocation, + + -- * Lower level pieces + ExprPath, + ExprPathStep (..), + findExprPathToLocation, + findTypeForPath, + ) +where + +import Control.Monad (guard) +import Data.Foldable (find) +import qualified Data.HashMap.Strict as M +import qualified Wasp.Analyzer.Parser.CST as S +import Wasp.Analyzer.Parser.CST.Traverse (Traversal) +import qualified Wasp.Analyzer.Parser.CST.Traverse as T +import Wasp.Analyzer.StdTypeDefinitions (stdTypes) +import Wasp.Analyzer.Type (Type) +import qualified Wasp.Analyzer.Type as Type +import Wasp.Analyzer.TypeDefinitions (DeclType (dtBodyType), getDeclType) +import Wasp.LSP.Syntax (lexemeAt) + +inferTypeAtLocation :: String -> Traversal -> Maybe Type +inferTypeAtLocation src location = findExprPathToLocation src location >>= findTypeForPath + +-- | A "path" through wasp expressions to a certain location. +-- +-- === __Example__ +-- For the code +-- +-- @ +-- app todoApp { +-- auth: { +-- usernameAndPassword: | +-- ^ +-- } +-- } +-- @ +-- +-- The path to the cursor would be @[Decl "app", DictKey "auth", DictKey "usernameAndPassword"]@. +type ExprPath = [ExprPathStep] + +data ExprPathStep + = -- | @Decl declType@. Enter a declaration of type @declType@. + Decl !String + | -- | @DictKey key@. Enter a dictionary *and* its key @key@. + DictKey !String + | -- | Enter a value inside a list. + List + | -- | @Tuple idx@. Enter the @idx@-th value inside of a tuple. + Tuple !Int + deriving (Eq, Show) + +-- | This function only depends on the syntax to the left of the location, and +-- tries to be as lenient as possible in finding paths. +findExprPathToLocation :: String -> Traversal -> Maybe ExprPath +findExprPathToLocation src location = reverse <$> go location + where + -- Recursively travel up the syntax tree, accumlating a path in reverse + -- order. Each recursion adds at most one new path component. + go :: Traversal -> Maybe ExprPath + go t = case T.up t of + Nothing -> Just [] -- Top level of the syntax reached. + Just t' -> case T.kindAt t' of + S.Program -> Just [] + S.Decl -> do + typLoc <- find ((== S.DeclType) . T.kindAt) $ T.leftSiblings t + let typ = lexemeAt src typLoc + -- Stop recursion after finding a Decl + return [Decl typ] + S.DictEntry -> case find ((== S.DictKey) . T.kindAt) $ T.leftSiblings t of + Just keyLoc -> do + -- There is a key to the left, so @t@ is the value for that key. + let key = lexemeAt src keyLoc + t'' <- T.up t' + guard $ T.kindAt t'' == S.Dict + (DictKey key :) <$> go t'' + Nothing -> go t' + S.List -> (List :) <$> go t' -- Inside a list. + S.Tuple -> do + -- Inside a tuple, number of expression nodes to the left is the tuple + -- index that @t@ is part of. + let nExprsBefore = length $ filter (S.syntaxKindIsExpr . T.kindAt) $ T.leftSiblings t + (Tuple nExprsBefore :) <$> go t' + _ -> go t' -- Found some other node, just ignore it and continue the tree. + +-- | Get the type in 'stdTypes' for the expression path. The path must start +-- with a 'Decl', otherwise 'Nothing' is returned. If the path's decl does not +-- exist in 'stdTypes', 'Nothing' is returned. +-- +-- === __Example__ +-- >>> findTypeForPath [Dict "app", Key "auth", Key "methods", Key "usernameAndPassword"] +-- Just (Type.DictType { fields = M.fromList [("configFn", Type.DictOptional { dictEntryType = Type.ExtImportType })] }) +findTypeForPath :: ExprPath -> Maybe Type +findTypeForPath (Decl declType : originalPath) = do + topType <- getDeclType declType stdTypes + go (dtBodyType topType) originalPath + where + -- @go parentType path@ returns the result of following @path@ starting at + -- @parentType@. + go :: Type -> ExprPath -> Maybe Type + go typ [] = Just typ + go _ (Decl _ : _) = Nothing -- Can't follow a decl in the middle of a path. + go typ (DictKey key : path) = + case typ of + Type.DictType fields -> do + -- Get the type of the field corresponding to the key. + typ' <- Type.dictEntryType <$> fields M.!? key + go typ' path + _ -> Nothing -- Not a dict type, can't use Key here. + go typ (List : path) = case typ of + Type.ListType typ' -> go typ' path -- Use the inner type of the list. + _ -> Nothing -- Not a list type, can't use List here. + go typ (Tuple idx : path) = case typ of + Type.TupleType (a, b, cs) -> case idx of + -- Follow the current type (by index) of the tuple. + 0 -> go a path + 1 -> go b path + n | n < length cs + 2 -> go (cs !! (n - 2)) path + _ -> Nothing -- Index is too large for the tuple type. + _ -> Nothing -- Not a tuple type, can't use Tuple here. +findTypeForPath _ = Nothing -- Doesn't start with a Decl. diff --git a/waspc/waspls/src/Wasp/LSP/Util.hs b/waspc/waspls/src/Wasp/LSP/Util.hs index 21e9a0691..3ec6d7e56 100644 --- a/waspc/waspls/src/Wasp/LSP/Util.hs +++ b/waspc/waspls/src/Wasp/LSP/Util.hs @@ -1,6 +1,14 @@ -module Wasp.LSP.Util (waspSourceRegionToLspRange, waspPositionToLspPosition) where +module Wasp.LSP.Util + ( allP, + anyP, + hoistMaybe, + waspSourceRegionToLspRange, + waspPositionToLspPosition, + ) +where import Control.Lens ((+~)) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) import Data.Function ((&)) import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Lens as LSP @@ -20,3 +28,15 @@ waspPositionToLspPosition (W.SourcePosition ln col) = { _line = fromIntegral ln - 1, _character = fromIntegral col - 1 } + +-- | Check if all the supplied predicates are true. +allP :: Foldable f => f (a -> Bool) -> a -> Bool +allP preds x = all ($ x) preds + +-- | Check if any of the supplied predicates are true. +anyP :: Foldable f => f (a -> Bool) -> a -> Bool +anyP preds x = any ($ x) preds + +-- | Lift a 'Maybe' into a 'MaybeT' monad transformer. +hoistMaybe :: Applicative m => Maybe a -> MaybeT m a +hoistMaybe = MaybeT . pure diff --git a/waspc/waspls/test/Wasp/LSP/CompletionTest.hs b/waspc/waspls/test/Wasp/LSP/CompletionTest.hs index fb019fc43..7e815a08e 100644 --- a/waspc/waspls/test/Wasp/LSP/CompletionTest.hs +++ b/waspc/waspls/test/Wasp/LSP/CompletionTest.hs @@ -106,12 +106,19 @@ runCompletionTest testInput = fmtedCompletionItems = map fmtCompletionItem completionItems fmtCompletionItem :: LSP.CompletionItem -> String - fmtCompletionItem item = - unwords - [ printf "label={%s}" (show $ item ^. LSP.label), - printf "kind={%s}" (show $ item ^. LSP.kind), - printf "detail={%s}" (show $ item ^. LSP.detail) - ] + fmtCompletionItem item = unwords fields + where + fields = + concat + [ field "label" LSP.label, + optionalField "kind" LSP.kind, + optionalField "detail" LSP.detail, + optionalField "insertText" LSP.insertText + ] + field label getter = [printf "%s={%s}" (label :: String) (show $ item ^. getter)] + optionalField label getter = case item ^. getter of + Nothing -> [] + Just v -> [printf "%s={%s}" (label :: String) (show v)] in "Completion items:\n" ++ unlines (map (" " <>) fmtedCompletionItems) -- | Parses a completion test case into a pair of the wasp source code to diff --git a/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.golden b/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.golden index be12a248f..508a02338 100644 --- a/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.golden +++ b/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.golden @@ -1 +1,3 @@ Completion items: + label={"path"} kind={CiField} detail={":: string"} insertText={"path: "} + label={"to"} kind={CiField} detail={":: page (declaration type)"} insertText={"to: "} diff --git a/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.wasp b/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.wasp index 13993840e..4a7a87b35 100644 --- a/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.wasp +++ b/waspc/waspls/test/Wasp/LSP/completionTests/at_dict_key.wasp @@ -6,8 +6,8 @@ app todoApp { title: "todo!", } -route MainRoute { path: "/", | } - ^ +route MainRoute { | } + ^ page MainPage { component: import { MainPage } from "@client/MainPage.jsx", } diff --git a/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.golden b/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.golden new file mode 100644 index 000000000..508a02338 --- /dev/null +++ b/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.golden @@ -0,0 +1,3 @@ +Completion items: + label={"path"} kind={CiField} detail={":: string"} insertText={"path: "} + label={"to"} kind={CiField} detail={":: page (declaration type)"} insertText={"to: "} diff --git a/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.wasp b/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.wasp new file mode 100644 index 000000000..f30881f31 --- /dev/null +++ b/waspc/waspls/test/Wasp/LSP/completionTests/dict_key_duplicate.wasp @@ -0,0 +1,14 @@ +//! test/completion +app todoApp { + wasp: { + version: "^0.10.5", + }, + title: "todo!", +} + +// we suggest all keys of a dictionary, even when some are already used +route MainRoute { path: "/", | } + ^ +page MainPage { + component: import { MainPage } from "@client/MainPage.jsx", +} diff --git a/waspc/waspls/test/Wasp/LSP/completionTests/route_to.golden b/waspc/waspls/test/Wasp/LSP/completionTests/route_to.golden index 24c62218b..8b313372a 100644 --- a/waspc/waspls/test/Wasp/LSP/completionTests/route_to.golden +++ b/waspc/waspls/test/Wasp/LSP/completionTests/route_to.golden @@ -1,4 +1,4 @@ Completion items: - label={"todoApp"} kind={Just CiVariable} detail={Just ":: app (declaration type)"} - label={"MainRoute"} kind={Just CiVariable} detail={Just ":: route (declaration type)"} - label={"MainPage"} kind={Just CiVariable} detail={Just ":: page (declaration type)"} + label={"MainPage"} kind={CiVariable} detail={":: page (declaration type)"} + label={"MainRoute"} kind={CiVariable} detail={":: route (declaration type)"} + label={"todoApp"} kind={CiVariable} detail={":: app (declaration type)"}