mirror of
https://github.com/wasp-lang/wasp.git
synced 2024-08-16 18:50:44 +03:00
wasp start
now does setup and start while forwarding output.
fix
This commit is contained in:
parent
0bc5b2eec8
commit
f06c933182
230
waspc/.stylish-haskell.yaml
Normal file
230
waspc/.stylish-haskell.yaml
Normal file
@ -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'.
|
||||||
|
#
|
||||||
|
# - <integer>: 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
|
@ -5,7 +5,7 @@ module Command
|
|||||||
, CommandError(..)
|
, CommandError(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Except (MonadError, ExceptT, runExceptT)
|
import Control.Monad.Except (ExceptT, MonadError, runExceptT)
|
||||||
import Control.Monad.IO.Class (MonadIO)
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
|
||||||
|
|
||||||
@ -17,9 +17,8 @@ runCommand cmd = do
|
|||||||
errorOrResult <- runExceptT $ _runCommand cmd
|
errorOrResult <- runExceptT $ _runCommand cmd
|
||||||
case errorOrResult of
|
case errorOrResult of
|
||||||
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
Left cmdError -> putStrLn $ "Error: " ++ _errorMsg cmdError
|
||||||
Right _ -> return ()
|
Right _ -> return ()
|
||||||
|
|
||||||
-- TODO: What if we want to recognize errors in order to handle them?
|
-- 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?
|
-- Should we add _commandErrorType? Should CommandError be parametrized by it, is that even possible?
|
||||||
data CommandError = CommandError { _errorMsg :: !String }
|
data CommandError = CommandError { _errorMsg :: !String }
|
||||||
|
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
module Command.Common
|
module Command.Common
|
||||||
( findWaspProjectRootFromCwd
|
( findWaspProjectRootFromCwd
|
||||||
, findWaspProjectRoot
|
, findWaspProjectRoot
|
||||||
|
, waspSays
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Directory (getCurrentDirectory, doesPathExist, doesFileExist)
|
import System.Directory (getCurrentDirectory, doesPathExist, doesFileExist)
|
||||||
@ -36,3 +37,6 @@ findWaspProjectRootFromCwd :: Command (Path Abs (Dir WaspProjectDir))
|
|||||||
findWaspProjectRootFromCwd = do
|
findWaspProjectRootFromCwd = do
|
||||||
absCurrentDir <- liftIO getCurrentDirectory
|
absCurrentDir <- liftIO getCurrentDirectory
|
||||||
findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir)
|
findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir)
|
||||||
|
|
||||||
|
waspSays :: String -> Command ()
|
||||||
|
waspSays what = liftIO $ putStrLn $ "\ESC[33m{= Wasp =}\ESC[0m " ++ what -- Yellow
|
||||||
|
@ -13,7 +13,7 @@ import qualified StrongPath as SP
|
|||||||
import qualified Lib
|
import qualified Lib
|
||||||
import qualified Util.IO
|
import qualified Util.IO
|
||||||
import Command (Command, CommandError(..))
|
import Command (Command, CommandError(..))
|
||||||
import Command.Common (findWaspProjectRootFromCwd)
|
import Command.Common (findWaspProjectRootFromCwd, waspSays)
|
||||||
import qualified Common
|
import qualified Common
|
||||||
|
|
||||||
|
|
||||||
@ -26,8 +26,11 @@ start = do
|
|||||||
{ externalCodeDirPath = waspRoot </> Common.extCodeDirInWaspProjectDir }
|
{ externalCodeDirPath = waspRoot </> Common.extCodeDirInWaspProjectDir }
|
||||||
|
|
||||||
-- TODO: This just compiles once. We need `wasp start` to do much more.
|
-- TODO: This just compiles once. We need `wasp start` to do much more.
|
||||||
maybeError <- liftIO $ Lib.compile waspFile outDir options
|
waspSays "Compiling wasp code..."
|
||||||
liftIO $ either putStrLn (\_ -> print ("Code has been successfully (re)generated." :: String)) maybeError
|
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.
|
-- 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.
|
-- 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
|
-- 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.
|
-- 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.
|
-- Right now we have setup/installation being called, but it has not support for being "smart" yet.
|
||||||
liftIO $ putStrLn "Setting up generated project..."
|
waspSays "Setting up generated project..."
|
||||||
setupResult <- liftIO $ Lib.setup outDir options
|
setupResult <- liftIO $ Lib.setup outDir
|
||||||
case setupResult of
|
case setupResult of
|
||||||
Left setupError -> throwError $ CommandError $ "Setup failed: " ++ setupError
|
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.
|
-- 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.
|
-- 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,
|
-- 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.
|
-- 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.
|
-- TODO: Listen for changes, if they happen, re-generate the code.
|
||||||
where
|
where
|
||||||
|
@ -54,6 +54,10 @@ library:
|
|||||||
- time
|
- time
|
||||||
- exceptions
|
- exceptions
|
||||||
- process
|
- process
|
||||||
|
- conduit
|
||||||
|
- conduit-extra
|
||||||
|
- async
|
||||||
|
- bytestring
|
||||||
|
|
||||||
executables:
|
executables:
|
||||||
wasp:
|
wasp:
|
||||||
|
@ -1,27 +1,27 @@
|
|||||||
module Generator
|
module Generator
|
||||||
( writeWebAppCode
|
( writeWebAppCode
|
||||||
, setup
|
, Generator.Setup.setup
|
||||||
|
, Generator.Start.start
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Text
|
import qualified Data.Text
|
||||||
import qualified Data.Text.IO
|
import qualified Data.Text.IO
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import qualified Paths_waspc
|
|
||||||
import qualified Data.Version
|
import qualified Data.Version
|
||||||
import Control.Monad (mapM_)
|
import qualified Path as P
|
||||||
import qualified Path as P
|
import qualified Paths_waspc
|
||||||
import System.Exit (ExitCode(..))
|
|
||||||
|
|
||||||
import StrongPath (Path, Abs, Dir, (</>))
|
import CompileOptions (CompileOptions)
|
||||||
import qualified StrongPath as SP
|
import Generator.Common (ProjectRootDir)
|
||||||
import CompileOptions (CompileOptions)
|
import Generator.DbGenerator (genDb)
|
||||||
import Wasp (Wasp)
|
import Generator.FileDraft (FileDraft, write)
|
||||||
import Generator.WebAppGenerator (generateWebApp)
|
import Generator.ServerGenerator (genServer)
|
||||||
import Generator.ServerGenerator (genServer)
|
import qualified Generator.Setup
|
||||||
import Generator.DbGenerator (genDb)
|
import qualified Generator.Start
|
||||||
import qualified Generator.ServerGenerator.Setup
|
import Generator.WebAppGenerator (generateWebApp)
|
||||||
import Generator.FileDraft (FileDraft, write)
|
import StrongPath (Abs, Dir, Path, (</>))
|
||||||
import Generator.Common (ProjectRootDir)
|
import qualified StrongPath as SP
|
||||||
|
import Wasp (Wasp)
|
||||||
|
|
||||||
|
|
||||||
-- | Generates web app code from given Wasp and writes it to given destination directory.
|
-- | 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 content = "Generated on " ++ (show currentTime) ++ " by waspc version " ++ (show version) ++ " ."
|
||||||
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
let dstPath = dstDir </> SP.fromPathRelFile [P.relfile|.waspinfo|]
|
||||||
Data.Text.IO.writeFile (SP.toFilePath dstPath) (Data.Text.pack content)
|
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 ()
|
|
||||||
|
29
waspc/src/Generator/Job.hs
Normal file
29
waspc/src/Generator/Job.hs
Normal file
@ -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)
|
27
waspc/src/Generator/Job/IO.hs
Normal file
27
waspc/src/Generator/Job/IO.hs
Normal file
@ -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
|
49
waspc/src/Generator/Job/Process.hs
Normal file
49
waspc/src/Generator/Job/Process.hs
Normal file
@ -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
|
||||||
|
|
@ -2,24 +2,14 @@ module Generator.ServerGenerator.Setup
|
|||||||
( setupServer
|
( setupServer
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified System.Process as P
|
import Generator.Common (ProjectRootDir)
|
||||||
import System.Exit (ExitCode(..))
|
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
|
setupServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
type Stderr = String
|
|
||||||
|
|
||||||
setupServer :: Path Abs (Dir ProjectRootDir) -> IO (ExitCode, Stdout, Stderr)
|
|
||||||
setupServer projectDir = do
|
setupServer projectDir = do
|
||||||
let serverDir = projectDir SP.</> C.serverRootDirInProjectRootDir
|
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||||
|
runNodeCommandAsJob serverDir "npm" ["install"] J.Server
|
||||||
-- 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?
|
|
||||||
|
|
||||||
|
@ -2,22 +2,14 @@ module Generator.ServerGenerator.Start
|
|||||||
( startServer
|
( startServer
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified System.Process as P
|
import Generator.Common (ProjectRootDir)
|
||||||
import System.Exit (ExitCode(..))
|
import qualified Generator.Job as J
|
||||||
|
import Generator.Job.Process (runNodeCommandAsJob)
|
||||||
import qualified StrongPath as SP
|
import qualified Generator.ServerGenerator.Common as Common
|
||||||
import StrongPath (Path, Abs, Dir)
|
import StrongPath (Abs, Dir, Path, (</>))
|
||||||
import qualified Generator.ServerGenerator.Common as C
|
|
||||||
import Generator.Common (ProjectRootDir)
|
|
||||||
|
|
||||||
|
|
||||||
startServer :: Path Abs (Dir ProjectRootDir) -> IO (ExitCode, String, String) -- ^ (exit code, stdout, stderr)
|
startServer :: Path Abs (Dir ProjectRootDir) -> J.Job
|
||||||
startServer projectDir = do
|
startServer projectDir = do
|
||||||
let serverDir = projectDir SP.</> C.serverRootDirInProjectRootDir
|
let serverDir = projectDir </> Common.serverRootDirInProjectRootDir
|
||||||
|
runNodeCommandAsJob serverDir "npm" ["start"] J.Server
|
||||||
-- 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"
|
|
||||||
|
|
||||||
|
43
waspc/src/Generator/Setup.hs
Normal file
43
waspc/src/Generator/Setup.hs
Normal file
@ -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
|
31
waspc/src/Generator/Start.hs
Normal file
31
waspc/src/Generator/Start.hs
Normal file
@ -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
|
15
waspc/src/Generator/WebAppGenerator/Setup.hs
Normal file
15
waspc/src/Generator/WebAppGenerator/Setup.hs
Normal file
@ -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
|
15
waspc/src/Generator/WebAppGenerator/Start.hs
Normal file
15
waspc/src/Generator/WebAppGenerator/Start.hs
Normal file
@ -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
|
@ -1,6 +1,7 @@
|
|||||||
module Lib
|
module Lib
|
||||||
( compile
|
( compile
|
||||||
, setup
|
, Generator.setup
|
||||||
|
, Generator.start
|
||||||
, ProjectRootDir
|
, ProjectRootDir
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -28,8 +29,3 @@ compile waspFile outDir options = do
|
|||||||
generateCode $ wasp `setExternalCodeFiles` externalCodeFiles
|
generateCode $ wasp `setExternalCodeFiles` externalCodeFiles
|
||||||
where
|
where
|
||||||
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
generateCode wasp = Generator.writeWebAppCode wasp outDir options >> return (Right ())
|
||||||
|
|
||||||
type SetupError = String
|
|
||||||
|
|
||||||
setup :: Path Abs (Dir ProjectRootDir) -> CompileOptions -> IO (Either SetupError ())
|
|
||||||
setup = Generator.setup
|
|
||||||
|
Loading…
Reference in New Issue
Block a user