diff --git a/waspc/cli/src/Wasp/Cli/Command/Watch.hs b/waspc/cli/src/Wasp/Cli/Command/Watch.hs index 54ffb6d0dc..6372d776f9 100644 --- a/waspc/cli/src/Wasp/Cli/Command/Watch.hs +++ b/waspc/cli/src/Wasp/Cli/Command/Watch.hs @@ -19,33 +19,50 @@ import Wasp.Cli.Message (cliSendMessage) import qualified Wasp.Generator.Common as Wasp.Generator import qualified Wasp.Message as Msg import Wasp.Project (CompileError, CompileWarning, WaspProjectDir) -import Wasp.Project.Common (extClientCodeDirInWaspProjectDir, extServerCodeDirInWaspProjectDir, extSharedCodeDirInWaspProjectDir) +import Wasp.Project.Common (srcDirInWaspProjectDir) -- TODO: Idea: Read .gitignore file, and ignore everything from it. This will then also cover the -- .wasp dir, and users can easily add any custom stuff they want ignored. But, we also have to -- be ready for the case when there is no .gitignore, that could be possible. --- | Forever listens for any file changes in waspProjectDir, and if there is a change, --- compiles Wasp source files in waspProjectDir and regenerates files in outDir. --- It will defer recompilation until no new change was detected in the last second. --- It also takes 'ongoingCompilationResultMVar' MVar, into which it stores the result --- (warnings, errors) of the latest (re)compile whenever it happens. If there is already --- something in the MVar, it will get overwritten. +-- | Forever listens for any file changes at the very top level of @waspProjectDir@, and also for +-- any changes at any depth in the @waspProjectDir@/src/ dir. If there is a change, compiles Wasp +-- source files in @waspProjectDir@ and regenerates files in @outDir@. It will defer recompilation +-- until no new change was detected in the last second. It also takes 'ongoingCompilationResultMVar' +-- MVar, into which it stores the result (warnings, errors) of the latest (re)compile whenever it +-- happens. If there is already something in the MVar, it will get overwritten. watch :: Path' Abs (Dir WaspProjectDir) -> Path' Abs (Dir Wasp.Generator.ProjectRootDir) -> MVar ([CompileWarning], [CompileError]) -> IO () watch waspProjectDir outDir ongoingCompilationResultMVar = FSN.withManager $ \mgr -> do - currentTime <- getCurrentTime chan <- newChan - _ <- FSN.watchDirChan mgr (SP.fromAbsDir waspProjectDir) eventFilter chan - let watchProjectSubdirTree path = FSN.watchTreeChan mgr (SP.fromAbsDir $ waspProjectDir path) eventFilter chan - _ <- watchProjectSubdirTree extClientCodeDirInWaspProjectDir - _ <- watchProjectSubdirTree extServerCodeDirInWaspProjectDir - _ <- watchProjectSubdirTree extSharedCodeDirInWaspProjectDir - listenForEvents chan currentTime + _ <- watchFilesAtTopLevelOfWaspProjectDir mgr chan + _ <- watchFilesAtAllLevelsOfSrcDirInWaspProjectDir mgr chan + listenForEvents chan =<< getCurrentTime where + watchFilesAtTopLevelOfWaspProjectDir mgr chan = + FSN.watchDirChan mgr (SP.fromAbsDir waspProjectDir) eventFilter chan + where + eventFilter :: FSN.Event -> Bool + eventFilter event = + -- TODO: Might be valuable to also filter out files from .gitignore. + not (isEditorTmpFile filename) + && filename /= "package-lock.json" + where + filename = FP.takeFileName $ FSN.eventPath event + + watchFilesAtAllLevelsOfSrcDirInWaspProjectDir mgr chan = + FSN.watchTreeChan mgr (SP.fromAbsDir $ waspProjectDir srcDirInWaspProjectDir) eventFilter chan + where + eventFilter :: FSN.Event -> Bool + eventFilter event = + -- TODO: Might be valuable to also filter out files from .gitignore. + not (isEditorTmpFile filename) + where + filename = FP.takeFileName $ FSN.eventPath event + listenForEvents :: Chan FSN.Event -> UTCTime -> IO () listenForEvents chan lastCompileTime = do event <- readChan chan @@ -114,12 +131,13 @@ watch waspProjectDir outDir ongoingCompilationResultMVar = FSN.withManager $ \mg -- create next to the source code. Bad thing here is that users can't modify this, -- so better approach would be probably to use information from .gitignore instead, or -- maybe combining the two somehow. - eventFilter :: FSN.Event -> Bool - eventFilter event = - let filename = FP.takeFileName $ FSN.eventPath event - in not (null filename) - && take 2 filename /= ".#" -- Ignore emacs lock files. - && not (head filename == '#' && last filename == '#') -- Ignore emacs auto-save files. - && last filename /= '~' -- Ignore emacs and vim backup files. - && not (head filename == '.' && ".swp" `isSuffixOf` filename) -- Ignore vim swp files. - && not (head filename == '.' && ".un~" `isSuffixOf` filename) -- Ignore vim undo files. + isEditorTmpFile :: String -> Bool + isEditorTmpFile "" = False + isEditorTmpFile filename = + or + [ take 2 filename == ".#", -- Emacs lock files. + head filename == '#' && last filename == '#', -- Emacs auto-save files. + last filename == '~', -- Emacs and vim backup files. + head filename == '.' && ".swp" `isSuffixOf` filename, -- Vim swp files. + head filename == '.' && ".un~" `isSuffixOf` filename -- Vim undo files. + ] diff --git a/waspc/src/Wasp/Generator/NpmDependencies.hs b/waspc/src/Wasp/Generator/NpmDependencies.hs index faaed68adb..243644fbfd 100644 --- a/waspc/src/Wasp/Generator/NpmDependencies.hs +++ b/waspc/src/Wasp/Generator/NpmDependencies.hs @@ -4,15 +4,16 @@ module Wasp.Generator.NpmDependencies ( DependencyConflictError (..), getDependenciesPackageJsonEntry, getDevDependenciesPackageJsonEntry, + getUserNpmDepsForPackage, combineNpmDepsForPackage, NpmDepsForPackage (..), NpmDepsForPackageError (..), conflictErrorToMessage, genNpmDepsForPackage, - NpmDepsForFullStack, + NpmDepsForFramework, NpmDepsForWasp (..), NpmDepsForUser (..), - buildNpmDepsForFullStack, + buildWaspFrameworkNpmDeps, ) where @@ -27,16 +28,15 @@ import qualified Wasp.AppSpec.App.Dependency as D import qualified Wasp.AppSpec.PackageJson as AS.PackageJson import Wasp.Generator.Monad (Generator, GeneratorError (..), logAndThrowGeneratorError) -data NpmDepsForFullStack = NpmDepsForFullStack +data NpmDepsForFramework = NpmDepsForFramework { npmDepsForServer :: NpmDepsForPackage, npmDepsForWebApp :: NpmDepsForPackage } deriving (Show, Eq, Generic) -instance ToJSON NpmDepsForFullStack where - toEncoding = genericToEncoding defaultOptions +instance ToJSON NpmDepsForFramework -instance FromJSON NpmDepsForFullStack +instance FromJSON NpmDepsForFramework data NpmDepsForPackage = NpmDepsForPackage { dependencies :: [D.Dependency], @@ -44,6 +44,10 @@ data NpmDepsForPackage = NpmDepsForPackage } deriving (Show, Generic) +instance ToJSON NpmDepsForPackage + +instance FromJSON NpmDepsForPackage + data NpmDepsForWasp = NpmDepsForWasp { waspDependencies :: [D.Dependency], waspDevDependencies :: [D.Dependency] @@ -54,12 +58,11 @@ data NpmDepsForUser = NpmDepsForUser { userDependencies :: [D.Dependency], userDevDependencies :: [D.Dependency] } - deriving (Show) + deriving (Show, Eq, Generic) -instance ToJSON NpmDepsForPackage where - toEncoding = genericToEncoding defaultOptions +instance ToJSON NpmDepsForUser -instance FromJSON NpmDepsForPackage +instance FromJSON NpmDepsForUser data NpmDepsForPackageError = NpmDepsForPackageError { dependenciesConflictErrors :: [DependencyConflictError], @@ -89,12 +92,12 @@ genNpmDepsForPackage spec npmDepsForWasp = ++ devDependenciesConflictErrors conflictErrorDeps ) -buildNpmDepsForFullStack :: AppSpec -> NpmDepsForWasp -> NpmDepsForWasp -> Either String NpmDepsForFullStack -buildNpmDepsForFullStack spec forServer forWebApp = +buildWaspFrameworkNpmDeps :: AppSpec -> NpmDepsForWasp -> NpmDepsForWasp -> Either String NpmDepsForFramework +buildWaspFrameworkNpmDeps spec forServer forWebApp = case (combinedServerDeps, combinedWebAppDeps) of (Right a, Right b) -> Right - NpmDepsForFullStack + NpmDepsForFramework { npmDepsForServer = a, npmDepsForWebApp = b } @@ -135,6 +138,12 @@ sortedDependencies a = (sort $ dependencies a, sort $ devDependencies a) -- to combine them together, returning (Right) a new NpmDepsForPackage -- that combines them, and on error (Left), returns a NpmDepsForPackageError -- which describes which dependencies are in conflict. +-- TODO: The comment above and function name are not exactly correct any more, +-- as user deps don't get combined with the wasp deps any more, instead user deps +-- are just checked against wasp deps to see if there are any conflicts, and then +-- wasp deps are more or less returned as they are (maybe with some changes? But certainly no user deps added). +-- This function deserves rewriting / rethinking. This should be addressed while solving +-- GH issue https://github.com/wasp-lang/wasp/issues/1644 . combineNpmDepsForPackage :: NpmDepsForWasp -> NpmDepsForUser -> Either NpmDepsForPackageError NpmDepsForPackage combineNpmDepsForPackage npmDepsForWasp npmDepsForUser = if null conflictErrors && null devConflictErrors diff --git a/waspc/src/Wasp/Generator/NpmInstall.hs b/waspc/src/Wasp/Generator/NpmInstall.hs index fd0cd2fa8a..c2da605128 100644 --- a/waspc/src/Wasp/Generator/NpmInstall.hs +++ b/waspc/src/Wasp/Generator/NpmInstall.hs @@ -1,177 +1,80 @@ module Wasp.Generator.NpmInstall - ( isNpmInstallNeeded, - installNpmDependenciesWithInstallRecord, + ( installNpmDependenciesWithInstallRecord, ) where import Control.Concurrent (Chan, newChan, readChan, threadDelay, writeChan) import Control.Concurrent.Async (concurrently) -import Control.Monad (when) +import Control.Monad.Except (MonadError (throwError), runExceptT) import Control.Monad.IO.Class (liftIO) -import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Lazy as B +import Data.Function ((&)) import Data.Functor ((<&>)) import qualified Data.Text as T -import StrongPath (Abs, Dir, File', Path', Rel, relfile, ()) +import Debug.Pretty.Simple (pTrace) +import StrongPath (Abs, Dir, Path') import qualified StrongPath as SP -import System.Directory (doesFileExist, removeFile) import System.Exit (ExitCode (..)) import UnliftIO (race) -import Wasp.AppSpec (AppSpec) +import Wasp.AppSpec (AppSpec (waspProjectDir)) import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.Job (Job, JobMessage, JobType) import qualified Wasp.Generator.Job as J import Wasp.Generator.Job.IO.PrefixedWriter (PrefixedWriter, printJobMessagePrefixed, runPrefixedWriter) -import Wasp.Generator.Monad (GeneratorError (..), GeneratorWarning (..)) -import qualified Wasp.Generator.NpmDependencies as N +import Wasp.Generator.Monad (GeneratorError (..)) +import Wasp.Generator.NpmInstall.Common (AllNpmDeps (..), getAllNpmDeps) +import Wasp.Generator.NpmInstall.InstalledNpmDepsLog (forgetInstalledNpmDepsLog, loadInstalledNpmDepsLog, saveInstalledNpmDepsLog) import qualified Wasp.Generator.SdkGenerator as SdkGenerator -import Wasp.Generator.ServerGenerator as SG import qualified Wasp.Generator.ServerGenerator.Setup as ServerSetup -import Wasp.Generator.WebAppGenerator as WG import qualified Wasp.Generator.WebAppGenerator.Setup as WebAppSetup import Wasp.Project.Common (WaspProjectDir) --- | Figure out if npm install is needed. --- --- Redundant npm installs can be avoided if the dependencies specified --- by the user and wasp have not changed since the last time this ran. --- --- Npm instal is needed only if the dependencies described in the user wasp file are --- different from the dependencies that we just installed. To this end, this --- code keeps track of the dependencies installed with a metadata file, which --- it updates after each install. --- --- NOTE: we assume that the dependencies in package.json are the same as the --- ones we derive from the AppSpec. We derive them the same way but it does --- involve different code paths. --- This module could work in an completely different way, independently --- from AppSpec at all. It could work by ensuring a `npm install` is --- consistent with a metadata file derived from `package.json` during its --- previous run. This would be more decoupled from the rest of the system. --- Npm conflict handling could be ignored in that case, because it would work --- from the record of what's in package.json. -isNpmInstallNeeded :: AppSpec -> Path' Abs (Dir ProjectRootDir) -> IO (Either String (Maybe N.NpmDepsForFullStack)) -isNpmInstallNeeded spec dstDir = do - let errorOrNpmDepsForFullStack = N.buildNpmDepsForFullStack spec (SG.npmDepsForWasp spec) (WG.npmDepsForWasp spec) - case errorOrNpmDepsForFullStack of - Left message -> return $ Left $ "determining npm deps to install failed: " ++ message - Right npmDepsForFullStack -> do - isInstallNeeded <- isNpmInstallDifferent npmDepsForFullStack dstDir - return $ - Right $ - if isInstallNeeded - then Just npmDepsForFullStack - else Nothing - --- Run npm install for desired AppSpec dependencies, recording what we installed --- Installation may fail, in which the installation record is removed. +-- Runs `npm install` for: +-- 1. User's Wasp project (based on their package.json): user deps. +-- 2. Wasp's generated webapp project: wasp deps. +-- 3. Wasp's generated server project: wasp deps. +-- (1) runs first, (2) and (3) run concurrently after it. +-- It collects the output produced by these commands to pass them along to IO with a prefix. installNpmDependenciesWithInstallRecord :: - N.NpmDepsForFullStack -> - Path' Abs (Dir WaspProjectDir) -> + AppSpec -> Path' Abs (Dir ProjectRootDir) -> - IO ([GeneratorWarning], [GeneratorError]) -installNpmDependenciesWithInstallRecord npmDepsForFullStack waspProjectDir dstDir = do - -- in case anything fails during installation that would leave node modules in - -- a broken state, we remove the file before we start npm install - fileExists <- doesFileExist dependenciesInstalledFp - when fileExists $ removeFile dependenciesInstalledFp - -- now actually do the installation - npmInstallResult <- installNpmDependencies waspProjectDir dstDir - case npmInstallResult of - Left npmInstallError -> do - return ([], [GenericGeneratorError $ "npm install failed: " ++ npmInstallError]) - Right () -> do - -- on successful npm install, record what we installed - B.writeFile dependenciesInstalledFp (Aeson.encode npmDepsForFullStack) - return ([], []) - where - dependenciesInstalledFp = SP.fromAbsFile $ dstDir installedFullStackNpmDependenciesFileInProjectRootDir + IO (Either GeneratorError ()) +installNpmDependenciesWithInstallRecord spec dstDir = runExceptT $ do + messagesChan <- liftIO newChan --- Returns True only if the stored full stack dependencies are different from the --- the full stack dependencies in the argument. If an installation record is missing --- then it's always different. -isNpmInstallDifferent :: N.NpmDepsForFullStack -> Path' Abs (Dir ProjectRootDir) -> IO Bool -isNpmInstallDifferent appSpecFullStackNpmDependencies dstDir = do - installedFullStackNpmDependencies <- loadInstalledFullStackNpmDependencies dstDir - return $ Just appSpecFullStackNpmDependencies /= installedFullStackNpmDependencies + allNpmDeps <- getAllNpmDeps spec & onLeftThrowError --- TODO: we probably want to put this in a `waspmeta` directory in the future -installedFullStackNpmDependenciesFileInProjectRootDir :: Path' (Rel ProjectRootDir) File' -installedFullStackNpmDependenciesFileInProjectRootDir = [relfile|installedFullStackNpmDependencies.json|] + liftIO (areThereNpmDepsToInstall allNpmDeps dstDir) >>= \case + False -> pure () + True -> do + -- In case anything fails during installation that would leave node modules in + -- a broken state, we remove the log of installed npm deps before we start npm install. + liftIO $ forgetInstalledNpmDepsLog dstDir --- Load the record of the dependencies we installed from disk. -loadInstalledFullStackNpmDependencies :: Path' Abs (Dir ProjectRootDir) -> IO (Maybe N.NpmDepsForFullStack) -loadInstalledFullStackNpmDependencies dstDir = do - let dependenciesInstalledFp = SP.fromAbsFile $ dstDir installedFullStackNpmDependenciesFileInProjectRootDir - fileExists <- doesFileExist dependenciesInstalledFp - if fileExists - then do - fileContents <- B.readFile dependenciesInstalledFp - return (Aeson.decode fileContents :: Maybe N.NpmDepsForFullStack) - else return Nothing + liftIO (installProjectNpmDependencies messagesChan (waspProjectDir spec)) + >>= onLeftThrowError -reportInstallationProgress :: Chan JobMessage -> JobType -> IO () -reportInstallationProgress chan jobType = reportPeriodically allPossibleMessages - where - reportPeriodically messages = do - threadDelay $ secToMicroSec 5 - writeChan chan $ J.JobMessage {J._data = J.JobOutput (T.append (head messages) "\n") J.Stdout, J._jobType = jobType} - threadDelay $ secToMicroSec 5 - reportPeriodically (if hasLessThan2Elems messages then messages else drop 1 messages) - secToMicroSec = (* 1000000) - hasLessThan2Elems = null . drop 1 - allPossibleMessages = - [ "Still installing npm dependencies!", - "Installation going great - we'll get there soon!", - "The installation is taking a while, but we'll get there!", - "Yup, still not done installing.", - "We're getting closer and closer, everything will be installed soon!", - "Still waiting for the installation to finish? You should! We got too far to give up now!", - "You've been waiting so patiently, just wait a little longer (for the installation to finish)..." - ] - -installNpmDependenciesAndReport :: Job -> Chan JobMessage -> JobType -> IO ExitCode -installNpmDependenciesAndReport installJob chan jobType = do - writeChan chan $ J.JobMessage {J._data = J.JobOutput "Starting npm install\n" J.Stdout, J._jobType = jobType} - result <- installJob chan `race` reportInstallationProgress chan jobType - case result of - Left exitCode -> return exitCode - Right _ -> error "This should never happen, reporting installation progress should run forever." + liftIO (installWebAppAndServerNpmDependencies messagesChan dstDir) + >>= onLeftThrowError -{- HLINT ignore installNpmDependencies "Redundant <$>" -} + liftIO $ saveInstalledNpmDepsLog allNpmDeps dstDir --- Run the individual `npm install` commands for both server and webapp projects --- It runs these concurrently, collects the output produced by these commands --- to pass them along to IO with a prefix -installNpmDependencies :: Path' Abs (Dir WaspProjectDir) -> Path' Abs (Dir ProjectRootDir) -> IO (Either String ()) -installNpmDependencies projectDir dstDir = do - messagesChan <- newChan - installProjectNpmDependencies messagesChan projectDir >>= \case - ExitFailure code -> return $ Left $ "Project setup failed with exit code " ++ show code ++ "." - _success -> do - installWebAppAndServerNpmDependencies messagesChan dstDir <&> \case - (ExitSuccess, ExitSuccess) -> Right () - exitCodes -> Left $ setupFailedMessage exitCodes + pure () where - setupFailedMessage (serverExitCode, webAppExitCode) = - let serverErrorMessage = case serverExitCode of - ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "." - _success -> "" - webAppErrorMessage = case webAppExitCode of - ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "." - _success -> "" - in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage + onLeftThrowError = + either (\e -> throwError $ GenericGeneratorError $ "npm install failed: " ++ e) pure +-- Installs npm dependencies from the user's package.json, by running `npm install` . installProjectNpmDependencies :: - Chan JobMessage -> SP.Path SP.System Abs (Dir WaspProjectDir) -> IO ExitCode + Chan JobMessage -> SP.Path SP.System Abs (Dir WaspProjectDir) -> IO (Either String ()) installProjectNpmDependencies messagesChan projectDir = - snd <$> handleProjectInstallMessages messagesChan `concurrently` installProjectDepsJob + handleProjectInstallMessages messagesChan `concurrently` installProjectDepsJob + <&> snd + <&> \case + ExitFailure code -> Left $ "Project setup failed with exit code " ++ show code ++ "." + _success -> Right () where installProjectDepsJob = - installNpmDependenciesAndReport - (SdkGenerator.installNpmDependencies projectDir) - messagesChan - J.Wasp + installNpmDependenciesAndReport (SdkGenerator.installNpmDependencies projectDir) messagesChan J.Wasp handleProjectInstallMessages :: Chan J.JobMessage -> IO () handleProjectInstallMessages = runPrefixedWriter . processMessages where @@ -182,10 +85,16 @@ installProjectNpmDependencies messagesChan projectDir = J.JobOutput {} -> printJobMessagePrefixed jobMsg >> processMessages chan J.JobExit {} -> return () +-- Install npm dependencies for the Wasp's generated webapp and server projects. installWebAppAndServerNpmDependencies :: - Chan JobMessage -> SP.Path SP.System Abs (Dir ProjectRootDir) -> IO (ExitCode, ExitCode) + Chan JobMessage -> SP.Path SP.System Abs (Dir ProjectRootDir) -> IO (Either String ()) installWebAppAndServerNpmDependencies messagesChan dstDir = - snd <$> handleSetupJobsMessages messagesChan `concurrently` (installServerDepsJob `concurrently` installWebAppDepsJob) + handleSetupJobsMessages messagesChan + `concurrently` (installServerDepsJob `concurrently` installWebAppDepsJob) + <&> snd + <&> \case + (ExitSuccess, ExitSuccess) -> Right () + exitCodes -> Left $ setupFailedMessage exitCodes where installServerDepsJob = installNpmDependenciesAndReport (ServerSetup.installNpmDependencies dstDir) messagesChan J.Server installWebAppDepsJob = installNpmDependenciesAndReport (WebAppSetup.installNpmDependencies dstDir) messagesChan J.WebApp @@ -205,3 +114,59 @@ installWebAppAndServerNpmDependencies messagesChan dstDir = J.Server -> processMessages (isWebAppDone, True) chan J.Db -> error "This should never happen. No Db job should be active." J.Wasp -> error "This should never happen. No Wasp job should be active." + + setupFailedMessage (serverExitCode, webAppExitCode) = + let serverErrorMessage = case serverExitCode of + ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "." + _success -> "" + webAppErrorMessage = case webAppExitCode of + ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "." + _success -> "" + in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage + +installNpmDependenciesAndReport :: Job -> Chan JobMessage -> JobType -> IO ExitCode +installNpmDependenciesAndReport installJob chan jobType = do + writeChan chan $ J.JobMessage {J._data = J.JobOutput "Starting npm install\n" J.Stdout, J._jobType = jobType} + result <- installJob chan `race` reportInstallationProgress chan jobType + case result of + Left exitCode -> return exitCode + Right _ -> error "This should never happen, reporting installation progress should run forever." + +reportInstallationProgress :: Chan JobMessage -> JobType -> IO () +reportInstallationProgress chan jobType = reportPeriodically allPossibleMessages + where + reportPeriodically messages = do + threadDelay $ secToMicroSec 5 + writeChan chan $ J.JobMessage {J._data = J.JobOutput (T.append (head messages) "\n") J.Stdout, J._jobType = jobType} + threadDelay $ secToMicroSec 5 + reportPeriodically (if hasLessThan2Elems messages then messages else drop 1 messages) + secToMicroSec = (* 1000000) + hasLessThan2Elems = null . drop 1 + allPossibleMessages = + [ "Still installing npm dependencies!", + "Installation going great - we'll get there soon!", + "The installation is taking a while, but we'll get there!", + "Yup, still not done installing.", + "We're getting closer and closer, everything will be installed soon!", + "Still waiting for the installation to finish? You should! We got too far to give up now!", + "You've been waiting so patiently, just wait a little longer (for the installation to finish)..." + ] + +-- | Figure out if installation of npm deps is needed, be it for user npm deps (top level +-- package.json), for wasp framework npm deps (web app, server), or for wasp sdk npm deps. +-- +-- To this end, this code keeps track of the dependencies installed with a metadata file, which +-- it updates after each install. +-- +-- TODO(martin): Here, we do a single check for all the deps. This means we don't know if user deps +-- or wasp sdk deps or wasp framework deps need installing, and so the user of this function will +-- likely run `npm install` for all of them, which means 3 times (for user npm deps (+ wasp sdk +-- deps, those are all done with single npm install), for wasp webapp npm deps, for wasp server +-- npm deps). We could, relatively easily, since we already differentiate all these deps, return +-- exact info on which deps need installation, and therefore run only needed npm installs. We +-- could return such info by either returning a triple (Bool, Bool, Bool) for (user+sdk, webapp, +-- server) deps, or we could return a list of enum which says which deps to install. +areThereNpmDepsToInstall :: AllNpmDeps -> Path' Abs (Dir ProjectRootDir) -> IO Bool +areThereNpmDepsToInstall allNpmDeps dstDir = do + installedNpmDeps <- loadInstalledNpmDepsLog dstDir + return $ installedNpmDeps /= Just allNpmDeps diff --git a/waspc/src/Wasp/Generator/NpmInstall/Common.hs b/waspc/src/Wasp/Generator/NpmInstall/Common.hs new file mode 100644 index 0000000000..c1a5d80555 --- /dev/null +++ b/waspc/src/Wasp/Generator/NpmInstall/Common.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Wasp.Generator.NpmInstall.Common + ( AllNpmDeps (..), + getAllNpmDeps, + ) +where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) +import Wasp.AppSpec (AppSpec) +import qualified Wasp.Generator.NpmDependencies as N +import qualified Wasp.Generator.SdkGenerator as SdkGenerator +import qualified Wasp.Generator.ServerGenerator as SG +import qualified Wasp.Generator.WebAppGenerator as WG + +data AllNpmDeps = AllNpmDeps + { _userNpmDeps :: !N.NpmDepsForUser, -- Deps coming from user's package.json . + _waspFrameworkNpmDeps :: !N.NpmDepsForFramework, -- Deps coming from Wasp's framework code (webapp, server) package.jsons. + _waspSdkNpmDeps :: !N.NpmDepsForPackage -- Deps coming from Wasp's SDK's package.json . + } + deriving (Eq, Show, Generic) + +instance ToJSON AllNpmDeps + +instance FromJSON AllNpmDeps + +getAllNpmDeps :: AppSpec -> Either String AllNpmDeps +getAllNpmDeps spec = + let userNpmDeps = N.getUserNpmDepsForPackage spec + errorOrWaspFrameworkNpmDeps = + N.buildWaspFrameworkNpmDeps spec (SG.npmDepsForWasp spec) (WG.npmDepsForWasp spec) + waspSdkNpmDeps = SdkGenerator.npmDepsForSdk spec + in case errorOrWaspFrameworkNpmDeps of + Left message -> Left $ "determining npm deps to install failed: " ++ message + Right waspFrameworkNpmDeps -> + Right $ + AllNpmDeps + { _userNpmDeps = userNpmDeps, + _waspFrameworkNpmDeps = waspFrameworkNpmDeps, + _waspSdkNpmDeps = waspSdkNpmDeps + } diff --git a/waspc/src/Wasp/Generator/NpmInstall/InstalledNpmDepsLog.hs b/waspc/src/Wasp/Generator/NpmInstall/InstalledNpmDepsLog.hs new file mode 100644 index 0000000000..33d1e15bf5 --- /dev/null +++ b/waspc/src/Wasp/Generator/NpmInstall/InstalledNpmDepsLog.hs @@ -0,0 +1,42 @@ +module Wasp.Generator.NpmInstall.InstalledNpmDepsLog + ( loadInstalledNpmDepsLog, + saveInstalledNpmDepsLog, + forgetInstalledNpmDepsLog, + ) +where + +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as B +import StrongPath (Abs, Dir, File', Path', Rel, relfile, ()) +import qualified StrongPath as SP +import System.Directory (doesFileExist) +import Wasp.Generator.Common (ProjectRootDir) +import Wasp.Generator.NpmInstall.Common (AllNpmDeps) +import Wasp.Util.IO (deleteFileIfExists) + +-- Load the log of the npm dependencies we installed, from disk. +loadInstalledNpmDepsLog :: Path' Abs (Dir ProjectRootDir) -> IO (Maybe AllNpmDeps) +loadInstalledNpmDepsLog dstDir = do + fileExists <- doesFileExist $ SP.fromAbsFile logFilePath + if fileExists + then do + fileContents <- B.readFile $ SP.fromAbsFile logFilePath + return (Aeson.decode fileContents :: Maybe AllNpmDeps) + else return Nothing + where + logFilePath = getInstalledNpmDepsLogFilePath dstDir + +-- Save the record of the Wasp's (webapp + server) npm dependencies we installed, to disk. +saveInstalledNpmDepsLog :: AllNpmDeps -> Path' Abs (Dir ProjectRootDir) -> IO () +saveInstalledNpmDepsLog deps dstDir = + B.writeFile (SP.fromAbsFile $ getInstalledNpmDepsLogFilePath dstDir) (Aeson.encode deps) + +forgetInstalledNpmDepsLog :: Path' Abs (Dir ProjectRootDir) -> IO () +forgetInstalledNpmDepsLog dstDir = + deleteFileIfExists $ getInstalledNpmDepsLogFilePath dstDir + +getInstalledNpmDepsLogFilePath :: Path' Abs (Dir ProjectRootDir) -> Path' Abs File' +getInstalledNpmDepsLogFilePath dstDir = dstDir installedNpmDepsLogFileInProjectRootDir + +installedNpmDepsLogFileInProjectRootDir :: Path' (Rel ProjectRootDir) File' +installedNpmDepsLogFileInProjectRootDir = [relfile|installedNpmDepsLog.json|] diff --git a/waspc/src/Wasp/Generator/SdkGenerator.hs b/waspc/src/Wasp/Generator/SdkGenerator.hs index 4fceb7c82b..7bef87a18c 100644 --- a/waspc/src/Wasp/Generator/SdkGenerator.hs +++ b/waspc/src/Wasp/Generator/SdkGenerator.hs @@ -43,39 +43,42 @@ genPackageJson spec = [relfile|package.json|] ( Just $ object - [ "depsChunk" .= N.getDependenciesPackageJsonEntry npmDepsForSdk, - "devDepsChunk" .= N.getDevDependenciesPackageJsonEntry npmDepsForSdk + [ "depsChunk" .= N.getDependenciesPackageJsonEntry npmDeps, + "devDepsChunk" .= N.getDevDependenciesPackageJsonEntry npmDeps ] ) where - npmDepsForSdk = - N.NpmDepsForPackage - { N.dependencies = - AS.Dependency.fromList - [ ("@prisma/client", show prismaVersion), - ("prisma", show prismaVersion), - ("@tanstack/react-query", "^4.29.0"), - ("axios", "^1.4.0"), - ("express", "~4.18.1"), - ("jsonwebtoken", "^8.5.1"), - ("mitt", "3.0.0"), - ("react", "^18.2.0"), - ("react-router-dom", "^5.3.3"), - ("react-hook-form", "^7.45.4"), - ("secure-password", "^4.0.0"), - ("superjson", "^1.12.2"), - ("@types/express-serve-static-core", "^4.17.13") - ] - ++ depsRequiredForAuth spec - -- This must be installed in the SDK because it lists prisma/client as a dependency. - -- Installing it inside .wasp/out/server/node_modules would also - -- install prisma/client in the same folder, which would cause our - -- runtime to load the wrong (uninitialized prisma/client) - -- TODO(filip): Find a better way to handle duplicate - -- dependencies: https://github.com/wasp-lang/wasp/issues/1640 - ++ ServerAuthG.depsRequiredByAuth spec, - N.devDependencies = AS.Dependency.fromList [] - } + npmDeps = npmDepsForSdk spec + +npmDepsForSdk :: AppSpec -> N.NpmDepsForPackage +npmDepsForSdk spec = + N.NpmDepsForPackage + { N.dependencies = + AS.Dependency.fromList + [ ("@prisma/client", show prismaVersion), + ("prisma", show prismaVersion), + ("@tanstack/react-query", "^4.29.0"), + ("axios", "^1.4.0"), + ("express", "~4.18.1"), + ("jsonwebtoken", "^8.5.1"), + ("mitt", "3.0.0"), + ("react", "^18.2.0"), + ("react-router-dom", "^5.3.3"), + ("react-hook-form", "^7.45.4"), + ("secure-password", "^4.0.0"), + ("superjson", "^1.12.2"), + ("@types/express-serve-static-core", "^4.17.13") + ] + ++ depsRequiredForAuth spec + -- This must be installed in the SDK because it lists prisma/client as a dependency. + -- Installing it inside .wasp/out/server/node_modules would also + -- install prisma/client in the same folder, which would cause our + -- runtime to load the wrong (uninitialized prisma/client) + -- TODO(filip): Find a better way to handle duplicate + -- dependencies: https://github.com/wasp-lang/wasp/issues/1640 + ++ ServerAuthG.depsRequiredByAuth spec, + N.devDependencies = AS.Dependency.fromList [] + } depsRequiredForAuth :: AppSpec -> [AS.Dependency.Dependency] depsRequiredForAuth spec = diff --git a/waspc/src/Wasp/Generator/Setup.hs b/waspc/src/Wasp/Generator/Setup.hs index f680b9f728..26cd4ce9b3 100644 --- a/waspc/src/Wasp/Generator/Setup.hs +++ b/waspc/src/Wasp/Generator/Setup.hs @@ -5,30 +5,20 @@ where import Control.Monad (when) import StrongPath (Abs, Dir, Path') -import Wasp.AppSpec (AppSpec (waspProjectDir)) +import Wasp.AppSpec (AppSpec) import Wasp.Generator.Common (ProjectRootDir) import qualified Wasp.Generator.DbGenerator as DbGenerator import Wasp.Generator.Monad (GeneratorError (..), GeneratorWarning (..)) -import Wasp.Generator.NpmInstall (installNpmDependenciesWithInstallRecord, isNpmInstallNeeded) +import Wasp.Generator.NpmInstall (installNpmDependenciesWithInstallRecord) import qualified Wasp.Message as Msg runSetup :: AppSpec -> Path' Abs (Dir ProjectRootDir) -> Msg.SendMessage -> IO ([GeneratorWarning], [GeneratorError]) runSetup spec dstDir sendMessage = do - runNpmInstallIfNeeded spec dstDir sendMessage >>= \case - npmInstallResults@(_, []) -> (npmInstallResults <>) <$> setUpDatabase spec dstDir sendMessage - npmInstallResults -> return npmInstallResults - -runNpmInstallIfNeeded :: AppSpec -> Path' Abs (Dir ProjectRootDir) -> Msg.SendMessage -> IO ([GeneratorWarning], [GeneratorError]) -runNpmInstallIfNeeded spec dstDir sendMessage = do - isNpmInstallNeeded spec dstDir >>= \case - Left errorMessage -> return ([], [GenericGeneratorError errorMessage]) - Right maybeFullStackDeps -> case maybeFullStackDeps of - Nothing -> return ([], []) - Just fullStackDeps -> do - (npmInstallWarnings, npmInstallErrors) <- - installNpmDependenciesWithInstallRecord fullStackDeps (waspProjectDir spec) dstDir - when (null npmInstallErrors) (sendMessage $ Msg.Success "Successfully completed npm install.") - return (npmInstallWarnings, npmInstallErrors) + installNpmDependenciesWithInstallRecord spec dstDir >>= \case + Right () -> do + sendMessage $ Msg.Success "Successfully completed npm install." + setUpDatabase spec dstDir sendMessage + Left e -> return ([], [e]) setUpDatabase :: AppSpec -> Path' Abs (Dir ProjectRootDir) -> Msg.SendMessage -> IO ([GeneratorWarning], [GeneratorError]) setUpDatabase spec dstDir sendMessage = do diff --git a/waspc/src/Wasp/Project/Common.hs b/waspc/src/Wasp/Project/Common.hs index 914cfd3205..0124e38a21 100644 --- a/waspc/src/Wasp/Project/Common.hs +++ b/waspc/src/Wasp/Project/Common.hs @@ -9,6 +9,7 @@ module Wasp.Project.Common waspProjectDirFromProjectRootDir, dotWaspRootFileInWaspProjectDir, dotWaspInfoFileInGeneratedCodeDir, + srcDirInWaspProjectDir, extServerCodeDirInWaspProjectDir, extClientCodeDirInWaspProjectDir, extSharedCodeDirInWaspProjectDir, @@ -57,14 +58,17 @@ dotWaspRootFileInWaspProjectDir = [relfile|.wasproot|] dotWaspInfoFileInGeneratedCodeDir :: Path' (Rel Wasp.Generator.Common.ProjectRootDir) File' dotWaspInfoFileInGeneratedCodeDir = [relfile|.waspinfo|] +srcDirInWaspProjectDir :: Path' (Rel WaspProjectDir) (Dir SourceExternalCodeDir) +srcDirInWaspProjectDir = [reldir|src|] + extServerCodeDirInWaspProjectDir :: Path' (Rel WaspProjectDir) (Dir SourceExternalCodeDir) -extServerCodeDirInWaspProjectDir = [reldir|src|] +extServerCodeDirInWaspProjectDir = srcDirInWaspProjectDir extClientCodeDirInWaspProjectDir :: Path' (Rel WaspProjectDir) (Dir SourceExternalCodeDir) -extClientCodeDirInWaspProjectDir = [reldir|src|] +extClientCodeDirInWaspProjectDir = srcDirInWaspProjectDir extSharedCodeDirInWaspProjectDir :: Path' (Rel WaspProjectDir) (Dir SourceExternalCodeDir) -extSharedCodeDirInWaspProjectDir = [reldir|src|] +extSharedCodeDirInWaspProjectDir = srcDirInWaspProjectDir packageJsonInWaspProjectDir :: Path' (Rel WaspProjectDir) File' packageJsonInWaspProjectDir = [relfile|package.json|] diff --git a/waspc/test/Analyzer/EvaluatorTest.hs b/waspc/test/Analyzer/EvaluatorTest.hs index 7829c59f51..69bed7acb6 100644 --- a/waspc/test/Analyzer/EvaluatorTest.hs +++ b/waspc/test/Analyzer/EvaluatorTest.hs @@ -199,7 +199,7 @@ spec_Evaluator = do let typeDefs = TD.addDeclType @Special $ TD.empty let source = [ "special Test {", - " imps: [import { field } from \"@server/main.js\", import main from \"@server/main.js\"],", + " imps: [import { field } from \"@src/main.js\", import main from \"@src/main.js\"],", " json: {=json { \"key\": 1 } json=}", "}" ] diff --git a/waspc/test/AnalyzerTest.hs b/waspc/test/AnalyzerTest.hs index 4c33aa30cb..6cc92a399f 100644 --- a/waspc/test/AnalyzerTest.hs +++ b/waspc/test/AnalyzerTest.hs @@ -9,7 +9,6 @@ import Data.List (intercalate) import Data.Maybe (fromJust) import qualified StrongPath as SP import Test.Tasty.Hspec -import qualified Wasp.AI.GenerateNewProject.Common as Auth import Wasp.Analyzer import Wasp.Analyzer.Parser (Ctx) import qualified Wasp.Analyzer.TypeChecker as TC @@ -18,7 +17,6 @@ import qualified Wasp.AppSpec.App as App import qualified Wasp.AppSpec.App.Auth as Auth import qualified Wasp.AppSpec.App.Client as Client import qualified Wasp.AppSpec.App.Db as Db -import qualified Wasp.AppSpec.App.Dependency as Dependency import qualified Wasp.AppSpec.App.EmailSender as EmailSender import qualified Wasp.AppSpec.App.Server as Server import qualified Wasp.AppSpec.App.Wasp as Wasp @@ -51,25 +49,22 @@ spec_Analyzer = do " userEntity: User,", " methods: {", " usernameAndPassword: {", - " userSignupFields: import { getUserFields } from \"@server/auth/signup.js\",", + " userSignupFields: import { getUserFields } from \"@src/auth/signup.js\",", " }", " },", " onAuthFailedRedirectTo: \"/\",", " },", - " dependencies: [", - " (\"redux\", \"^4.0.5\")", - " ],", " server: {", - " setupFn: import { setupServer } from \"@server/bar.js\"", + " setupFn: import { setupServer } from \"@src/bar.js\"", " },", " client: {", - " rootComponent: import { App } from \"@client/App.jsx\",", - " setupFn: import { setupClient } from \"@client/baz.js\",", + " rootComponent: import { App } from \"@src/App.jsx\",", + " setupFn: import { setupClient } from \"@src/baz.js\",", " baseDir: \"/\"", " },", " db: {", " system: PostgreSQL,", - " seeds: [ import { devSeedSimple } from \"@server/dbSeeds.js\" ],", + " seeds: [ import { devSeedSimple } from \"@src/dbSeeds.js\" ],", " prisma: {", " clientPreviewFeatures: [\"extendedWhereUnique\"],", " dbExtensions: [{ name: \"pg_trgm\", version: \"1.0.0\" }]", @@ -89,23 +84,23 @@ spec_Analyzer = do "psl=}", "", "page HomePage {", - " component: import Home from \"@client/pages/Main\"", + " component: import Home from \"@src/pages/Main\"", "}", "", "page ProfilePage {", - " component: import { profilePage } from \"@client/pages/Profile\",", + " component: import { profilePage } from \"@src/pages/Profile\",", " authRequired: true", "}", "", "route HomeRoute { path: \"/\", to: HomePage }", "", "query getUsers {", - " fn: import { getAllUsers } from \"@server/foo.js\",", + " fn: import { getAllUsers } from \"@src/foo.js\",", " entities: [User]", "}", "", "action updateUser {", - " fn: import { updateUser } from \"@server/foo.js\",", + " fn: import { updateUser } from \"@src/foo.js\",", " entities: [User],", " auth: true", "}", @@ -113,7 +108,7 @@ spec_Analyzer = do "job BackgroundJob {", " executor: PgBoss,", " perform: {", - " fn: import { backgroundJob } from \"@server/jobs/baz.js\",", + " fn: import { backgroundJob } from \"@src/jobs/baz.js\",", " executorOptions: {", " pgBoss: {=json { \"retryLimit\": 1 } json=}", " }", @@ -155,10 +150,6 @@ spec_Analyzer = do Auth.onAuthFailedRedirectTo = "/", Auth.onAuthSucceededRedirectTo = Nothing }, - App.dependencies = - Just - [ Dependency.Dependency {Dependency.name = "redux", Dependency.version = "^4.0.5"} - ], App.server = Just Server.Server @@ -350,7 +341,7 @@ spec_Analyzer = do let source = unlines [ "route HomeRoute { path: \"/\", to: HomePage }", - "page HomePage { component: import Home from \"@client/HomePage.js\" }" + "page HomePage { component: import Home from \"@src/HomePage.js\" }" ] isRight (analyze source) `shouldBe` True @@ -360,22 +351,22 @@ spec_Analyzer = do unlines [ "app MyApp {", " title: \"My app\",", - " dependencies: [", - " (\"bar\", 13),", - " (\"foo\", 14)", - " ]", + " db: {", + " seeds: [ (\"foo\", \"bar\") ],", + " }", "}" ] analyze source - `errorMessageShouldBe` ( ctx (4, 5) (4, 15), + `errorMessageShouldBe` ( ctx (4, 14) (4, 27), intercalate "\n" [ "Type error:", - " Expected type: (string, string)", - " Actual type: (string, number)", + " Expected type: external import", + " Actual type: (string, string)", "", - " -> For dictionary field 'dependencies':", - " -> In list" + " -> For dictionary field 'db':", + " -> For dictionary field 'seeds':", + " -> In list" ] ) @@ -384,22 +375,19 @@ spec_Analyzer = do unlines [ "app MyApp {", " title: \"My app\",", - " dependencies: [", - " { name: \"bar\", version: 13 },", - " { name: \"foo\", version: \"1.2.3\" }", - " ]", + " db: {", + " seeds: [ 42, \"foo\" ],", + " }", "}" ] analyze source - `errorMessageShouldBe` ( ctx (5, 29) (5, 35), + `errorMessageShouldBe` ( ctx (4, 18) (4, 22), intercalate "\n" [ "Type error:", " Can't mix the following types:", " - number", - " - string", - "", - " -> For dictionary field 'version'" + " - string" ] ) diff --git a/waspc/test/AppSpec/ValidTest.hs b/waspc/test/AppSpec/ValidTest.hs index 46a38236fe..ba1bbdd372 100644 --- a/waspc/test/AppSpec/ValidTest.hs +++ b/waspc/test/AppSpec/ValidTest.hs @@ -2,6 +2,7 @@ module AppSpec.ValidTest where +import qualified Data.Map as M import Data.Maybe (fromJust) import Fixtures (systemSPRoot) import qualified StrongPath as SP @@ -17,6 +18,7 @@ import qualified Wasp.AppSpec.Core.Decl as AS.Decl import qualified Wasp.AppSpec.Core.Ref as AS.Core.Ref import qualified Wasp.AppSpec.Entity as AS.Entity import qualified Wasp.AppSpec.ExtImport as AS.ExtImport +import qualified Wasp.AppSpec.PackageJson as AS.PJS import qualified Wasp.AppSpec.Page as AS.Page import qualified Wasp.AppSpec.Route as AS.Route import qualified Wasp.AppSpec.Valid as ASV @@ -344,7 +346,6 @@ spec_AppSpecValid = do AS.App.server = Nothing, AS.App.client = Nothing, AS.App.auth = Nothing, - AS.App.dependencies = Nothing, AS.App.head = Nothing, AS.App.emailSender = Nothing, AS.App.webSocket = Nothing @@ -359,6 +360,12 @@ spec_AppSpecValid = do AS.externalClientFiles = [], AS.externalServerFiles = [], AS.externalSharedFiles = [], + AS.packageJson = + AS.PJS.PackageJson + { AS.PJS.name = "testApp", + AS.PJS.dependencies = M.empty, + AS.PJS.devDependencies = M.empty + }, AS.isBuild = False, AS.migrationsDir = Nothing, AS.devEnvVarsClient = [], diff --git a/waspc/test/Generator/NpmDependenciesTest.hs b/waspc/test/Generator/NpmDependenciesTest.hs index 339a203c15..97a2ab3994 100644 --- a/waspc/test/Generator/NpmDependenciesTest.hs +++ b/waspc/test/Generator/NpmDependenciesTest.hs @@ -45,7 +45,7 @@ spec_combineNpmDepsForPackage = do devDependenciesConflictErrors = [] } - it "wasp deps completely overlap with user deps, no duplication" $ do + it "wasp deps completely overlap with user deps: all wasp deps are dropped" $ do let npmDepsForWasp = NpmDepsForWasp { waspDependencies = waspDeps, @@ -53,26 +53,18 @@ spec_combineNpmDepsForPackage = do } let npmDepsForUser = NpmDepsForUser - { userDependencies = - D.fromList - [ ("a", "1"), - ("b", "2") - ], + { userDependencies = waspDeps, userDevDependencies = [] } combineNpmDepsForPackage npmDepsForWasp npmDepsForUser `shouldBe` Right NpmDepsForPackage - { dependencies = - D.fromList - [ ("a", "1"), - ("b", "2") - ], + { dependencies = [], devDependencies = [] } - it "user dependencies supplement wasp dependencies" $ do + it "user dependencies have no overlap with wasp deps: wasp deps remain the same" $ do let npmDepsForWasp = NpmDepsForWasp { waspDependencies = waspDeps, @@ -91,17 +83,11 @@ spec_combineNpmDepsForPackage = do combineNpmDepsForPackage npmDepsForWasp npmDepsForUser `shouldBe` Right NpmDepsForPackage - { dependencies = - D.fromList - [ ("a", "1"), - ("b", "2"), - ("c", "3"), - ("d", "4") - ], + { dependencies = waspDeps, devDependencies = [] } - it "user dependencies partially overlap wasp dependencies, so only non-overlapping supplement" $ do + it "user dependencies partially overlap wasp dependencies, so intersection gets removed from wasp deps" $ do let npmDepsForWasp = NpmDepsForWasp { waspDependencies = waspDeps, @@ -120,12 +106,7 @@ spec_combineNpmDepsForPackage = do combineNpmDepsForPackage npmDepsForWasp npmDepsForUser `shouldBe` Right NpmDepsForPackage - { dependencies = - D.fromList - [ ("a", "1"), - ("b", "2"), - ("d", "4") - ], + { dependencies = D.fromList [("b", "2")], devDependencies = [] } @@ -183,7 +164,7 @@ spec_combineNpmDepsForPackage = do devDependenciesConflictErrors = [] } - it "dev dependencies are also combined" $ do + it "both dev deps and normal deps are same for user and wasp: all wasp deps are removed" $ do let npmDepsForWasp = NpmDepsForWasp { waspDependencies = waspDeps, @@ -192,35 +173,17 @@ spec_combineNpmDepsForPackage = do let npmDepsForUser = NpmDepsForUser - { userDependencies = - D.fromList - [ ("a", "1"), - ("d", "4") - ], - userDevDependencies = - D.fromList - [ ("alpha", "10"), - ("gamma", "30") - ] + { userDependencies = waspDeps, + userDevDependencies = waspDevDeps } combineNpmDepsForPackage npmDepsForWasp npmDepsForUser `shouldBe` Right NpmDepsForPackage - { dependencies = - D.fromList - [ ("a", "1"), - ("b", "2"), - ("d", "4") - ], - devDependencies = - D.fromList - [ ("alpha", "10"), - ("beta", "20"), - ("gamma", "30") - ] + { dependencies = [], + devDependencies = [] } - it "wasp dev dependency overlaps with user dependency, should remain devDependency" $ do + it "wasp dev dependency overlaps with user non-dev dependency: should have no effect" $ do let npmDepsForWasp = NpmDepsForWasp { waspDependencies = waspDeps, @@ -239,16 +202,8 @@ spec_combineNpmDepsForPackage = do combineNpmDepsForPackage npmDepsForWasp npmDepsForUser `shouldBe` Right NpmDepsForPackage - { dependencies = - D.fromList - [ ("a", "1"), - ("b", "2") - ], - devDependencies = - D.fromList - [ ("alpha", "10"), - ("beta", "20") - ] + { dependencies = waspDeps, + devDependencies = waspDevDeps } it "conflictErrorToMessage" $ do diff --git a/waspc/test/Generator/WebAppGeneratorTest.hs b/waspc/test/Generator/WebAppGeneratorTest.hs index 145e6e493e..7a168e6208 100644 --- a/waspc/test/Generator/WebAppGeneratorTest.hs +++ b/waspc/test/Generator/WebAppGeneratorTest.hs @@ -1,5 +1,6 @@ module Generator.WebAppGeneratorTest where +import qualified Data.Map as M import Fixtures import qualified StrongPath as SP import System.FilePath (()) @@ -8,6 +9,7 @@ import qualified Wasp.AppSpec as AS import qualified Wasp.AppSpec.App as AS.App import qualified Wasp.AppSpec.App.Wasp as AS.Wasp import qualified Wasp.AppSpec.Core.Decl as AS.Decl +import qualified Wasp.AppSpec.PackageJson as AS.PJS import Wasp.Generator.FileDraft import qualified Wasp.Generator.FileDraft.CopyAndModifyTextFileDraft as CMTextFD import qualified Wasp.Generator.FileDraft.CopyDirFileDraft as CopyDirFD @@ -39,7 +41,6 @@ spec_WebAppGenerator = do AS.App.server = Nothing, AS.App.client = Nothing, AS.App.auth = Nothing, - AS.App.dependencies = Nothing, AS.App.head = Nothing, AS.App.emailSender = Nothing, AS.App.webSocket = Nothing @@ -49,6 +50,12 @@ spec_WebAppGenerator = do AS.externalClientFiles = [], AS.externalServerFiles = [], AS.externalSharedFiles = [], + AS.packageJson = + AS.PJS.PackageJson + { AS.PJS.name = "testApp", + AS.PJS.dependencies = M.empty, + AS.PJS.devDependencies = M.empty + }, AS.isBuild = False, AS.migrationsDir = Nothing, AS.devEnvVarsServer = [], diff --git a/waspc/waspc.cabal b/waspc/waspc.cabal index cdb55c56ef..6feca9acf5 100644 --- a/waspc/waspc.cabal +++ b/waspc/waspc.cabal @@ -293,6 +293,8 @@ library Wasp.Generator.Monad Wasp.Generator.NpmDependencies Wasp.Generator.NpmInstall + Wasp.Generator.NpmInstall.Common + Wasp.Generator.NpmInstall.InstalledNpmDepsLog Wasp.Generator.SdkGenerator Wasp.Generator.ServerGenerator Wasp.Generator.ServerGenerator.JsImport