From f06c933182222f0bdf86e1c6b4c3723c35ccf4e4 Mon Sep 17 00:00:00 2001 From: Martin Sosic Date: Thu, 10 Sep 2020 16:33:26 +0200 Subject: [PATCH] `wasp start` now does setup and start while forwarding output. fix --- waspc/.stylish-haskell.yaml | 230 +++++++++++++++++++ waspc/cli/Command.hs | 5 +- waspc/cli/Command/Common.hs | 4 + waspc/cli/Command/Start.hs | 20 +- waspc/package.yaml | 4 + waspc/src/Generator.hs | 50 ++-- waspc/src/Generator/Job.hs | 29 +++ waspc/src/Generator/Job/IO.hs | 27 +++ waspc/src/Generator/Job/Process.hs | 49 ++++ waspc/src/Generator/ServerGenerator/Setup.hs | 26 +-- waspc/src/Generator/ServerGenerator/Start.hs | 24 +- waspc/src/Generator/Setup.hs | 43 ++++ waspc/src/Generator/Start.hs | 31 +++ waspc/src/Generator/WebAppGenerator/Setup.hs | 15 ++ waspc/src/Generator/WebAppGenerator/Start.hs | 15 ++ waspc/src/Lib.hs | 8 +- 16 files changed, 497 insertions(+), 83 deletions(-) create mode 100644 waspc/.stylish-haskell.yaml create mode 100644 waspc/src/Generator/Job.hs create mode 100644 waspc/src/Generator/Job/IO.hs create mode 100644 waspc/src/Generator/Job/Process.hs create mode 100644 waspc/src/Generator/Setup.hs create mode 100644 waspc/src/Generator/Start.hs create mode 100644 waspc/src/Generator/WebAppGenerator/Setup.hs create mode 100644 waspc/src/Generator/WebAppGenerator/Start.hs diff --git a/waspc/.stylish-haskell.yaml b/waspc/.stylish-haskell.yaml new file mode 100644 index 000000000..602981f3a --- /dev/null +++ b/waspc/.stylish-haskell.yaml @@ -0,0 +1,230 @@ +# stylish-haskell configuration file +# ================================== + +# The stylish-haskell tool is mainly configured by specifying steps. These steps +# are a list, so they have an order, and one specific step may appear more than +# once (if needed). Each file is processed by these steps in the given order. +steps: + # Convert some ASCII sequences to their Unicode equivalents. This is disabled + # by default. + # - unicode_syntax: + # # In order to make this work, we also need to insert the UnicodeSyntax + # # language pragma. If this flag is set to true, we insert it when it's + # # not already present. You may want to disable it if you configure + # # language extensions using some other method than pragmas. Default: + # # true. + # add_language_pragma: true + + # Align the right hand side of some elements. This is quite conservative + # and only applies to statements where each element occupies a single + # line. All default to true. + - simple_align: + cases: true + top_level_patterns: true + records: true + + # Import cleanup + - imports: + # There are different ways we can align names and lists. + # + # - global: Align the import names and import list throughout the entire + # file. + # + # - file: Like global, but don't add padding when there are no qualified + # imports in the file. + # + # - group: Only align the imports per group (a group is formed by adjacent + # import lines). + # + # - none: Do not perform any alignment. + # + # Default: global. + align: global + + # The following options affect only import list alignment. + # + # List align has following options: + # + # - after_alias: Import list is aligned with end of import including + # 'as' and 'hiding' keywords. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # > init, last, length) + # + # - with_alias: Import list is aligned with start of alias or hiding. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # > init, last, length) + # + # - new_line: Import list starts always on new line. + # + # > import qualified Data.List as List + # > (concat, foldl, foldr, head, init, last, length) + # + # Default: after_alias + list_align: after_alias + + # Right-pad the module names to align imports in a group: + # + # - true: a little more readable + # + # > import qualified Data.List as List (concat, foldl, foldr, + # > init, last, length) + # > import qualified Data.List.Extra as List (concat, foldl, foldr, + # > init, last, length) + # + # - false: diff-safe + # + # > import qualified Data.List as List (concat, foldl, foldr, init, + # > last, length) + # > import qualified Data.List.Extra as List (concat, foldl, foldr, + # > init, last, length) + # + # Default: true + pad_module_names: true + + # Long list align style takes effect when import is too long. This is + # determined by 'columns' setting. + # + # - inline: This option will put as much specs on same line as possible. + # + # - new_line: Import list will start on new line. + # + # - new_line_multiline: Import list will start on new line when it's + # short enough to fit to single line. Otherwise it'll be multiline. + # + # - multiline: One line per import list entry. + # Type with constructor list acts like single import. + # + # > import qualified Data.Map as M + # > ( empty + # > , singleton + # > , ... + # > , delete + # > ) + # + # Default: inline + long_list_align: inline + + # Align empty list (importing instances) + # + # Empty list align has following options + # + # - inherit: inherit list_align setting + # + # - right_after: () is right after the module name: + # + # > import Vector.Instances () + # + # Default: inherit + empty_list_align: inherit + + # List padding determines indentation of import list on lines after import. + # This option affects 'long_list_align'. + # + # - : constant value + # + # - module_name: align under start of module name. + # Useful for 'file' and 'group' align settings. + # + # Default: 4 + list_padding: 4 + + # Separate lists option affects formatting of import list for type + # or class. The only difference is single space between type and list + # of constructors, selectors and class functions. + # + # - true: There is single space between Foldable type and list of it's + # functions. + # + # > import Data.Foldable (Foldable (fold, foldl, foldMap)) + # + # - false: There is no space between Foldable type and list of it's + # functions. + # + # > import Data.Foldable (Foldable(fold, foldl, foldMap)) + # + # Default: true + separate_lists: true + + # Space surround option affects formatting of import lists on a single + # line. The only difference is single space after the initial + # parenthesis and a single space before the terminal parenthesis. + # + # - true: There is single space associated with the enclosing + # parenthesis. + # + # > import Data.Foo ( foo ) + # + # - false: There is no space associated with the enclosing parenthesis + # + # > import Data.Foo (foo) + # + # Default: false + space_surround: false + + # Language pragmas + - language_pragmas: + # We can generate different styles of language pragma lists. + # + # - vertical: Vertical-spaced language pragmas, one per line. + # + # - compact: A more compact style. + # + # - compact_line: Similar to compact, but wrap each line with + # `{-#LANGUAGE #-}'. + # + # Default: vertical. + style: vertical + + # Align affects alignment of closing pragma brackets. + # + # - true: Brackets are aligned in same column. + # + # - false: Brackets are not aligned together. There is only one space + # between actual import and closing bracket. + # + # Default: true + align: true + + # stylish-haskell can detect redundancy of some language pragmas. If this + # is set to true, it will remove those redundant pragmas. Default: true. + remove_redundant: true + + # Replace tabs by spaces. This is disabled by default. + # - tabs: + # # Number of spaces to use for each tab. Default: 8, as specified by the + # # Haskell report. + # spaces: 8 + + # Remove trailing whitespace + - trailing_whitespace: {} + + # Squash multiple spaces between the left and right hand sides of some + # elements into single spaces. Basically, this undoes the effect of + # simple_align but is a bit less conservative. + # - squash: {} + +# A common setting is the number of columns (parts of) code will be wrapped +# to. Different steps take this into account. Default: 80. +columns: 80 + +# By default, line endings are converted according to the OS. You can override +# preferred format here. +# +# - native: Native newline format. CRLF on Windows, LF on other OSes. +# +# - lf: Convert to LF ("\n"). +# +# - crlf: Convert to CRLF ("\r\n"). +# +# Default: native. +newline: native + +# Sometimes, language extensions are specified in a cabal file or from the +# command line instead of using language pragmas in the file. stylish-haskell +# needs to be aware of these, so it can parse the file correctly. +# +# No language extensions are enabled by default. +language_extensions: + - QuasiQuotes diff --git a/waspc/cli/Command.hs b/waspc/cli/Command.hs index 81fd595f5..d7a34299e 100644 --- a/waspc/cli/Command.hs +++ b/waspc/cli/Command.hs @@ -5,7 +5,7 @@ module Command , CommandError(..) ) where -import Control.Monad.Except (MonadError, ExceptT, runExceptT) +import Control.Monad.Except (ExceptT, MonadError, runExceptT) import Control.Monad.IO.Class (MonadIO) @@ -17,9 +17,8 @@ runCommand cmd = do errorOrResult <- runExceptT $ _runCommand cmd case errorOrResult of Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError - Right _ -> return () + Right _ -> return () -- 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 { _errorMsg :: !String } - diff --git a/waspc/cli/Command/Common.hs b/waspc/cli/Command/Common.hs index b66e0836d..7d7389fa4 100644 --- a/waspc/cli/Command/Common.hs +++ b/waspc/cli/Command/Common.hs @@ -1,6 +1,7 @@ module Command.Common ( findWaspProjectRootFromCwd , findWaspProjectRoot + , waspSays ) where import System.Directory (getCurrentDirectory, doesPathExist, doesFileExist) @@ -36,3 +37,6 @@ findWaspProjectRootFromCwd :: Command (Path Abs (Dir WaspProjectDir)) findWaspProjectRootFromCwd = do absCurrentDir <- liftIO getCurrentDirectory findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir) + +waspSays :: String -> Command () +waspSays what = liftIO $ putStrLn $ "\ESC[33m{= Wasp =}\ESC[0m " ++ what -- Yellow diff --git a/waspc/cli/Command/Start.hs b/waspc/cli/Command/Start.hs index 7699c36b8..b529fa590 100644 --- a/waspc/cli/Command/Start.hs +++ b/waspc/cli/Command/Start.hs @@ -13,7 +13,7 @@ import qualified StrongPath as SP import qualified Lib import qualified Util.IO import Command (Command, CommandError(..)) -import Command.Common (findWaspProjectRootFromCwd) +import Command.Common (findWaspProjectRootFromCwd, waspSays) import qualified Common @@ -26,8 +26,11 @@ start = do { externalCodeDirPath = waspRoot Common.extCodeDirInWaspProjectDir } -- TODO: This just compiles once. We need `wasp start` to do much more. - maybeError <- liftIO $ Lib.compile waspFile outDir options - liftIO $ either putStrLn (\_ -> print ("Code has been successfully (re)generated." :: String)) maybeError + waspSays "Compiling wasp code..." + errorOrResult <- liftIO $ Lib.compile waspFile outDir options + case errorOrResult of + Left compileError -> throwError $ CommandError $ "Compilation failed: " ++ compileError + Right () -> waspSays "Code has been successfully compiled.\n" -- TODO: Do smart install -> if we need to install stuff, install it. -- This should be responsibility of Generator, it should tell us how to install stuff. @@ -36,16 +39,21 @@ start = do -- Then, next time, we give it data we have about last installation, and it uses that -- to decide if installation needs to happen or not. If it happens, it returnes new data again. -- Right now we have setup/installation being called, but it has not support for being "smart" yet. - liftIO $ putStrLn "Setting up generated project..." - setupResult <- liftIO $ Lib.setup outDir options + waspSays "Setting up generated project..." + setupResult <- liftIO $ Lib.setup outDir case setupResult of Left setupError -> throwError $ CommandError $ "Setup failed: " ++ setupError - Right () -> liftIO $ putStrLn "Setup successful." + Right () -> waspSays "Setup successful.\n" -- TODO: Check node version and then run `npm start` on both web and server. -- Again, this is something that Generator should be responsible for, since it knows how the code is generated. -- It should tell us how to start stuff and we just start it. It should even do composing of the outputs, -- since it knows more than us about that. + waspSays "Starting up generated project..." + startResult <- liftIO $ Lib.start outDir + case startResult of + Left startError -> throwError $ CommandError $ "Start failed: " ++ startError + Right () -> error "This should never happen, start should never end." -- TODO: Listen for changes, if they happen, re-generate the code. where diff --git a/waspc/package.yaml b/waspc/package.yaml index 46ed93b34..0d8cead3d 100644 --- a/waspc/package.yaml +++ b/waspc/package.yaml @@ -54,6 +54,10 @@ library: - time - exceptions - process + - conduit + - conduit-extra + - async + - bytestring executables: wasp: diff --git a/waspc/src/Generator.hs b/waspc/src/Generator.hs index 870b8d7c5..daec168fa 100644 --- a/waspc/src/Generator.hs +++ b/waspc/src/Generator.hs @@ -1,27 +1,27 @@ module Generator ( writeWebAppCode - , setup + , Generator.Setup.setup + , Generator.Start.start ) where import qualified Data.Text import qualified Data.Text.IO -import Data.Time.Clock -import qualified Paths_waspc +import Data.Time.Clock import qualified Data.Version -import Control.Monad (mapM_) -import qualified Path as P -import System.Exit (ExitCode(..)) +import qualified Path as P +import qualified Paths_waspc -import StrongPath (Path, Abs, Dir, ()) -import qualified StrongPath as SP -import CompileOptions (CompileOptions) -import Wasp (Wasp) -import Generator.WebAppGenerator (generateWebApp) -import Generator.ServerGenerator (genServer) -import Generator.DbGenerator (genDb) -import qualified Generator.ServerGenerator.Setup -import Generator.FileDraft (FileDraft, write) -import Generator.Common (ProjectRootDir) +import CompileOptions (CompileOptions) +import Generator.Common (ProjectRootDir) +import Generator.DbGenerator (genDb) +import Generator.FileDraft (FileDraft, write) +import Generator.ServerGenerator (genServer) +import qualified Generator.Setup +import qualified Generator.Start +import Generator.WebAppGenerator (generateWebApp) +import StrongPath (Abs, Dir, Path, ()) +import qualified StrongPath as SP +import Wasp (Wasp) -- | Generates web app code from given Wasp and writes it to given destination directory. @@ -50,21 +50,3 @@ writeDotWaspInfo dstDir = do let content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ." let dstPath = dstDir SP.fromPathRelFile [P.relfile|.waspinfo|] Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content) - -setup :: Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO (Either String ()) -setup outDir _ = do - serverResult <- setupServer - webAppResult <- setupWebApp - return serverResult -- TODO: Should merge server results with web app results. - where - setupServer = do - (exitCode, stdout, stderr) <- Generator.ServerGenerator.Setup.setupServer outDir - print stdout - print stderr - case exitCode of - ExitSuccess -> return $ Right () - ExitFailure failureCode -> return $ Left $ "Server installation failed with exit code " ++ (show failureCode) - - setupWebApp = do -- TODO: Implement. - putStrLn "Pretending to be setting up web app." - return $ Right () diff --git a/waspc/src/Generator/Job.hs b/waspc/src/Generator/Job.hs new file mode 100644 index 000000000..ee548abb5 --- /dev/null +++ b/waspc/src/Generator/Job.hs @@ -0,0 +1,29 @@ +module Generator.Job + ( Job + , JobMessage (..) + , JobMessageData (..) + , JobOutputType (..) + , JobType (..) + ) where + +import Control.Concurrent (Chan) +import System.Exit (ExitCode) + + +-- | Job is an IO action that communicates progress by writing messages to given channel +-- until it is done, when it returns exit code. +type Job = Chan JobMessage -> IO ExitCode + +data JobMessage = JobMessage + { _data :: JobMessageData + , _jobType :: JobType + } + deriving (Show) + +data JobMessageData = JobOutput String JobOutputType + | JobExit ExitCode + deriving (Show) + +data JobOutputType = Stdout | Stderr deriving (Show) + +data JobType = WebApp | Server deriving (Show) diff --git a/waspc/src/Generator/Job/IO.hs b/waspc/src/Generator/Job/IO.hs new file mode 100644 index 000000000..58da93b75 --- /dev/null +++ b/waspc/src/Generator/Job/IO.hs @@ -0,0 +1,27 @@ +module Generator.Job.IO + ( printJobMessage + ) where + +import System.Exit (ExitCode (..)) +import System.IO (hPutStrLn, stderr, stdout) + +import qualified Generator.Job as J + + +printJobMessage :: J.JobMessage -> IO () +printJobMessage jobMsg = do + let outHandle = case J._data jobMsg of + J.JobOutput _ outputType -> + case outputType of + J.Stdout -> stdout + J.Stderr -> stderr + J.JobExit _ -> stderr + let prefix = case J._jobType jobMsg of + J.Server -> "\ESC[35mServer:\ESC[0m " -- Magenta + J.WebApp -> "\ESC[36mWeb app:\ESC[0m " -- Cyan + let message = case J._data jobMsg of + J.JobOutput output _ -> output + J.JobExit ExitSuccess -> "Job exited successfully." + J.JobExit (ExitFailure exitCode) -> "Job failed with exit code " ++ show exitCode + let outputLines = map (\l -> prefix ++ l) (lines message) + mapM_ (hPutStrLn outHandle) outputLines diff --git a/waspc/src/Generator/Job/Process.hs b/waspc/src/Generator/Job/Process.hs new file mode 100644 index 000000000..ccf810981 --- /dev/null +++ b/waspc/src/Generator/Job/Process.hs @@ -0,0 +1,49 @@ +module Generator.Job.Process + ( runProcessAsJob + , runNodeCommandAsJob + ) where + +import Control.Concurrent (writeChan) +import qualified Data.ByteString.Char8 as BS +import Data.Conduit (runConduit, (.|)) +import qualified Data.Conduit.List as CL +import qualified Data.Conduit.Process as CP +import qualified System.Process as P + +import qualified Generator.Job as J +import StrongPath (Abs, Dir, Path) +import qualified StrongPath as SP + + +-- | Runs a given process while streaming its stderr and stdout to provided channel. +-- Returns exit code of the process once it finishes, and also sends it to he channel. +runProcessAsJob :: P.CreateProcess -> J.JobType -> J.Job +runProcessAsJob process jobType = \chan -> do + (CP.ClosedStream, stdoutStream, stderrStream, processHandle) <- CP.streamingProcess process + + -- TODO: Do I need to use Concurrently to run concurrently these three below: + -- stdout, sdterr, and waiting for process? They do it in documentation/tutorial: + -- https://github.com/snoyberg/conduit/blob/master/PROCESS.md . + -- But for me it works fine without it, for now. + + runConduit $ stdoutStream .| CL.mapM_ + (\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (BS.unpack bs) J.Stdout + , J._jobType = jobType }) + + runConduit $ stderrStream .| CL.mapM_ + (\bs -> writeChan chan $ J.JobMessage { J._data = J.JobOutput (BS.unpack bs) J.Stderr + , J._jobType = jobType }) + + exitCode <- CP.waitForStreamingProcess processHandle + + writeChan chan $ J.JobMessage { J._data = J.JobExit exitCode + , J._jobType = jobType } + + return exitCode + +runNodeCommandAsJob :: Path Abs (Dir a) -> String -> [String] -> J.JobType -> J.Job +runNodeCommandAsJob fromDir command args jobType = do + -- TODO: Check npm/node version. + let process = (P.proc command args) { P.cwd = Just $ SP.toFilePath fromDir } + runProcessAsJob process jobType + diff --git a/waspc/src/Generator/ServerGenerator/Setup.hs b/waspc/src/Generator/ServerGenerator/Setup.hs index ba9bfebda..f13e326d9 100644 --- a/waspc/src/Generator/ServerGenerator/Setup.hs +++ b/waspc/src/Generator/ServerGenerator/Setup.hs @@ -2,24 +2,14 @@ module Generator.ServerGenerator.Setup ( setupServer ) where -import qualified System.Process as P -import System.Exit (ExitCode(..)) +import Generator.Common (ProjectRootDir) +import qualified Generator.Job as J +import Generator.Job.Process (runNodeCommandAsJob) +import qualified Generator.ServerGenerator.Common as Common +import StrongPath (Abs, Dir, Path, ()) -import qualified StrongPath as SP -import StrongPath (Path, Abs, Dir) -import qualified Generator.ServerGenerator.Common as C -import Generator.Common (ProjectRootDir) -type Stdout = String -type Stderr = String - -setupServer :: Path Abs (Dir ProjectRootDir) -> IO (ExitCode, Stdout, Stderr) +setupServer :: Path Abs (Dir ProjectRootDir) -> J.Job setupServer projectDir = do - let serverDir = projectDir SP. C.serverRootDirInProjectRootDir - - -- TODO: Check npm/node version. - - let process = (P.proc "npm" ["install"]){ P.cwd = Just (SP.toFilePath serverDir) } -- TODO: Do I need to set more stuff here? - P.readCreateProcessWithExitCode process "" - -- TODO: What about exceptions that command above could throw, how do we handle those? - + let serverDir = projectDir Common.serverRootDirInProjectRootDir + runNodeCommandAsJob serverDir "npm" ["install"] J.Server diff --git a/waspc/src/Generator/ServerGenerator/Start.hs b/waspc/src/Generator/ServerGenerator/Start.hs index d690bfb64..be4251b8d 100644 --- a/waspc/src/Generator/ServerGenerator/Start.hs +++ b/waspc/src/Generator/ServerGenerator/Start.hs @@ -2,22 +2,14 @@ module Generator.ServerGenerator.Start ( startServer ) where -import qualified System.Process as P -import System.Exit (ExitCode(..)) - -import qualified StrongPath as SP -import StrongPath (Path, Abs, Dir) -import qualified Generator.ServerGenerator.Common as C -import Generator.Common (ProjectRootDir) +import Generator.Common (ProjectRootDir) +import qualified Generator.Job as J +import Generator.Job.Process (runNodeCommandAsJob) +import qualified Generator.ServerGenerator.Common as Common +import StrongPath (Abs, Dir, Path, ()) -startServer :: Path Abs (Dir ProjectRootDir) -> IO (ExitCode, String, String) -- ^ (exit code, stdout, stderr) +startServer :: Path Abs (Dir ProjectRootDir) -> J.Job startServer projectDir = do - let serverDir = projectDir SP. C.serverRootDirInProjectRootDir - - -- TODO: Check npm/node version. - - -- TODO: npm start. I need to run process this in async manner! - -- Check out https://stackoverflow.com/a/47788165/1509394 . - error "To be implemented" - + let serverDir = projectDir Common.serverRootDirInProjectRootDir + runNodeCommandAsJob serverDir "npm" ["start"] J.Server diff --git a/waspc/src/Generator/Setup.hs b/waspc/src/Generator/Setup.hs new file mode 100644 index 000000000..dbd10ec30 --- /dev/null +++ b/waspc/src/Generator/Setup.hs @@ -0,0 +1,43 @@ +module Generator.Setup + ( setup + ) where + +import Control.Concurrent (Chan, newChan, readChan) +import Control.Concurrent.Async (concurrently) +import System.Exit (ExitCode (..)) + +import Generator.Common (ProjectRootDir) +import qualified Generator.Job as J +import Generator.Job.IO (printJobMessage) +import Generator.ServerGenerator.Setup (setupServer) +import Generator.WebAppGenerator.Setup (setupWebApp) +import StrongPath (Abs, Dir, Path) + + +setup :: Path Abs (Dir ProjectRootDir) -> IO (Either String ()) +setup projectDir = do + chan <- newChan + let runSetupJobs = concurrently (setupServer projectDir chan) (setupWebApp projectDir chan) + (_, result) <- concurrently (handleJobMessages chan (False, False)) runSetupJobs + case result of + (ExitSuccess, ExitSuccess) -> return $ Right () + exitCodes -> return $ Left $ setupFailedMessage exitCodes + where + handleJobMessages :: Chan J.JobMessage -> (Bool, Bool) -> IO () + handleJobMessages _ (True, True) = return () + handleJobMessages chan (isWebAppDone, isServerDone) = do + jobMsg <- readChan chan + case J._data jobMsg of + J.JobOutput {} -> printJobMessage jobMsg >> handleJobMessages chan (isWebAppDone, isServerDone) + J.JobExit {} -> case J._jobType jobMsg of + J.WebApp -> handleJobMessages chan (True, isServerDone) + J.Server -> handleJobMessages chan (isWebAppDone, True) + + setupFailedMessage (serverExitCode, webAppExitCode) = + let serverErrorMessage = case serverExitCode of + ExitFailure code -> " Server setup failed with exit code " ++ show code ++ "." + _ -> "" + webAppErrorMessage = case webAppExitCode of + ExitFailure code -> " Web app setup failed with exit code " ++ show code ++ "." + _ -> "" + in "Setup failed!" ++ serverErrorMessage ++ webAppErrorMessage diff --git a/waspc/src/Generator/Start.hs b/waspc/src/Generator/Start.hs new file mode 100644 index 000000000..bca67f1b2 --- /dev/null +++ b/waspc/src/Generator/Start.hs @@ -0,0 +1,31 @@ +module Generator.Start + ( start + ) where + +import Control.Concurrent (Chan, newChan, readChan) +import Control.Concurrent.Async (race) + +import Generator.Common (ProjectRootDir) +import Generator.Job (JobMessage) +import Generator.Job.IO (printJobMessage) +import Generator.ServerGenerator.Start (startServer) +import Generator.WebAppGenerator.Start (startWebApp) +import StrongPath (Abs, Dir, Path) + + +-- | This is a blocking action, that will start the processes that run web app and server. +-- It will wait for those processes to end, but since they are made to keep running until error +-- occurs, so will this action, run until one of them fails or it fails itself. +start :: Path Abs (Dir ProjectRootDir) -> IO (Either String ()) +start projectDir = do + chan <- newChan + let runStartJobs = race (startServer projectDir chan) (startWebApp projectDir chan) + result <- race (handleJobMessages chan) runStartJobs + case result of + Left () -> error "App start: Reading job messages stopped too early, this should never happen." + Right serverOrWebExitCode -> case serverOrWebExitCode of + Left serverExitCode -> return $ Left $ "Server failed with exit code " ++ show serverExitCode ++ "." + Right webAppExitCode -> return $ Left $ "Web app failed with exit code " ++ show webAppExitCode ++ "." + where + handleJobMessages :: Chan JobMessage -> IO () + handleJobMessages chan = readChan chan >>= printJobMessage >> handleJobMessages chan diff --git a/waspc/src/Generator/WebAppGenerator/Setup.hs b/waspc/src/Generator/WebAppGenerator/Setup.hs new file mode 100644 index 000000000..e4c7b2d9a --- /dev/null +++ b/waspc/src/Generator/WebAppGenerator/Setup.hs @@ -0,0 +1,15 @@ +module Generator.WebAppGenerator.Setup + ( setupWebApp + ) where + +import Generator.Common (ProjectRootDir) +import qualified Generator.Job as J +import Generator.Job.Process (runNodeCommandAsJob) +import qualified Generator.WebAppGenerator.Common as Common +import StrongPath (Abs, Dir, Path, ()) + + +setupWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job +setupWebApp projectDir = do + let webAppDir = projectDir Common.webAppRootDirInProjectRootDir + runNodeCommandAsJob webAppDir "npm" ["install"] J.WebApp diff --git a/waspc/src/Generator/WebAppGenerator/Start.hs b/waspc/src/Generator/WebAppGenerator/Start.hs new file mode 100644 index 000000000..83bb46368 --- /dev/null +++ b/waspc/src/Generator/WebAppGenerator/Start.hs @@ -0,0 +1,15 @@ +module Generator.WebAppGenerator.Start + ( startWebApp + ) where + +import Generator.Common (ProjectRootDir) +import qualified Generator.Job as J +import Generator.Job.Process (runNodeCommandAsJob) +import qualified Generator.WebAppGenerator.Common as Common +import StrongPath (Abs, Dir, Path, ()) + + +startWebApp :: Path Abs (Dir ProjectRootDir) -> J.Job +startWebApp projectDir = do + let webAppDir = projectDir Common.webAppRootDirInProjectRootDir + runNodeCommandAsJob webAppDir "npm" ["start"] J.WebApp diff --git a/waspc/src/Lib.hs b/waspc/src/Lib.hs index a418716ae..d169a8319 100644 --- a/waspc/src/Lib.hs +++ b/waspc/src/Lib.hs @@ -1,6 +1,7 @@ module Lib ( compile - , setup + , Generator.setup + , Generator.start , ProjectRootDir ) where @@ -28,8 +29,3 @@ compile waspFile outDir options = do generateCode $ wasp `setExternalCodeFiles` externalCodeFiles where generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ()) - -type SetupError = String - -setup :: Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO (Either SetupError ()) -setup = Generator.setup