Use send message protocol in cli (#493)

Use cliSendMessage everywhere in CLI

Instead of using waspSays and friends, we use the new cliSendMessage protocol everywhere to
send messages. For convenience we introduce a cliSendMessageC that's lifted to commands.

We handle CommandErrors specially now, and have a special way to display errors (failures) and warnings
with a heading.
This commit is contained in:
Martijn Faassen 2022-03-09 15:43:41 +01:00 committed by GitHub
parent f68c2d5a8b
commit b6f738416a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 114 additions and 114 deletions

View File

@ -9,7 +9,8 @@ where
import Control.Monad.Except (ExceptT, MonadError, runExceptT) import Control.Monad.Except (ExceptT, MonadError, runExceptT)
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import qualified Wasp.Util.Terminal as Term import Wasp.Cli.Message (cliSendMessage)
import qualified Wasp.Message as Msg
newtype Command a = Command {_runCommand :: ExceptT CommandError IO a} newtype Command a = Command {_runCommand :: ExceptT CommandError IO a}
deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError) deriving (Functor, Applicative, Monad, MonadIO, MonadError CommandError)
@ -18,9 +19,9 @@ runCommand :: Command a -> IO ()
runCommand cmd = do runCommand cmd = do
errorOrResult <- runExceptT $ _runCommand cmd errorOrResult <- runExceptT $ _runCommand cmd
case errorOrResult of case errorOrResult of
Left cmdError -> putStrLn $ Term.applyStyles [Term.Red] (_errorMsg cmdError) Left cmdError -> cliSendMessage $ Msg.Failure (_errorTitle cmdError) (_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 {_errorTitle :: !String, _errorMsg :: !String}

View File

@ -16,14 +16,14 @@ import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Command.Common import Wasp.Cli.Command.Common
( alphaWarningMessage, ( alphaWarningMessage,
findWaspProjectRootDirFromCwd, findWaspProjectRootDirFromCwd,
waspSaysC,
) )
import Wasp.Cli.Command.Compile (compileIOWithOptions) import Wasp.Cli.Command.Compile (compileIOWithOptions)
import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Message (cliSendMessage) import Wasp.Cli.Message (cliSendMessage)
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage)
import Wasp.CompileOptions (CompileOptions (..)) import Wasp.CompileOptions (CompileOptions (..))
import qualified Wasp.Lib import qualified Wasp.Lib
import qualified Wasp.Message as Msg
build :: Command () build :: Command ()
build = do build = do
@ -35,16 +35,16 @@ build = do
doesBuildDirExist <- liftIO $ doesDirectoryExist buildDirFilePath doesBuildDirExist <- liftIO $ doesDirectoryExist buildDirFilePath
when doesBuildDirExist $ do when doesBuildDirExist $ do
waspSaysC $ asWaspStartMessage "Clearing the content of the .wasp/build directory..." cliSendMessageC $ Msg.Start "Clearing the content of the .wasp/build directory..."
liftIO $ removeDirectoryRecursive buildDirFilePath liftIO $ removeDirectoryRecursive buildDirFilePath
waspSaysC $ asWaspSuccessMessage "Successfully cleared the contents of the .wasp/build directory." cliSendMessageC $ Msg.Success "Successfully cleared the contents of the .wasp/build directory."
waspSaysC $ asWaspStartMessage "Building wasp project..." cliSendMessageC $ Msg.Start "Building wasp project..."
buildResult <- liftIO $ buildIO waspProjectDir buildDir buildResult <- liftIO $ buildIO waspProjectDir buildDir
case buildResult of case buildResult of
Left compileError -> throwError $ CommandError $ asWaspFailureMessage "Build failed:" ++ compileError Left compileError -> throwError $ CommandError "Build failed" compileError
Right () -> waspSaysC $ asWaspSuccessMessage "Code has been successfully built! Check it out in .wasp/build directory." Right () -> cliSendMessageC $ Msg.Success "Code has been successfully built! Check it out in .wasp/build directory."
waspSaysC alphaWarningMessage cliSendMessageC $ Msg.Warning "Build warning" alphaWarningMessage
buildIO :: buildIO ::
Path' Abs (Dir Common.WaspProjectDir) -> Path' Abs (Dir Common.WaspProjectDir) ->

View File

@ -10,18 +10,19 @@ import System.Directory
removeDirectoryRecursive, removeDirectoryRecursive,
) )
import Wasp.Cli.Command (Command) import Wasp.Cli.Command (Command)
import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd, waspSaysC) import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd)
import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspStartMessage, asWaspSuccessMessage) import qualified Wasp.Message as Msg
clean :: Command () clean :: Command ()
clean = do clean = do
waspProjectDir <- findWaspProjectRootDirFromCwd waspProjectDir <- findWaspProjectRootDirFromCwd
let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir let dotWaspDirFp = SP.toFilePath $ waspProjectDir SP.</> Common.dotWaspDirInWaspProjectDir
waspSaysC $ asWaspStartMessage "Deleting .wasp/ directory..." cliSendMessageC $ Msg.Start "Deleting .wasp/ directory..."
doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp doesDotWaspDirExist <- liftIO $ doesDirectoryExist dotWaspDirFp
if doesDotWaspDirExist if doesDotWaspDirExist
then do then do
liftIO $ removeDirectoryRecursive dotWaspDirFp liftIO $ removeDirectoryRecursive dotWaspDirFp
waspSaysC $ asWaspSuccessMessage "Deleted .wasp/ directory." cliSendMessageC $ Msg.Success "Deleted .wasp/ directory."
else waspSaysC "Nothing to delete: .wasp directory does not exist." else cliSendMessageC $ Msg.Success "Nothing to delete: .wasp directory does not exist."

View File

@ -1,9 +1,6 @@
module Wasp.Cli.Command.Common module Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
findWaspProjectRoot, findWaspProjectRoot,
waspSaysC,
waspScreamsC,
waspWarnsC,
alphaWarningMessage, alphaWarningMessage,
) )
where where
@ -21,13 +18,7 @@ import System.Directory
) )
import qualified System.FilePath as FP import qualified System.FilePath as FP
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Common import Wasp.Cli.Common (dotWaspRootFileInWaspProjectDir)
( dotWaspRootFileInWaspProjectDir,
waspSays,
waspScreams,
waspWarns,
)
import Wasp.Cli.Terminal (asWaspFailureMessage)
import Wasp.Common (WaspProjectDir) import Wasp.Common (WaspProjectDir)
findWaspProjectRoot :: Path' Abs (Dir ()) -> Command (Path' Abs (Dir WaspProjectDir)) findWaspProjectRoot :: Path' Abs (Dir ()) -> Command (Path' Abs (Dir WaspProjectDir))
@ -45,9 +36,9 @@ findWaspProjectRoot currentDir = do
findWaspProjectRoot parentDir findWaspProjectRoot parentDir
where where
notFoundError = notFoundError =
CommandError $ CommandError
asWaspFailureMessage "Wasp command failed:" "Wasp command failed"
++ ( "Couldn't find wasp project root - make sure" ( "Couldn't find wasp project root - make sure"
++ " you are running this command from a Wasp project." ++ " you are running this command from a Wasp project."
) )
@ -56,16 +47,7 @@ findWaspProjectRootDirFromCwd = do
absCurrentDir <- liftIO getCurrentDirectory absCurrentDir <- liftIO getCurrentDirectory
findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir) findWaspProjectRoot (fromJust $ SP.parseAbsDir absCurrentDir)
waspSaysC :: String -> Command ()
waspSaysC = liftIO . waspSays
waspWarnsC :: String -> Command ()
waspWarnsC = liftIO . waspWarns
waspScreamsC :: String -> Command ()
waspScreamsC = liftIO . waspScreams
alphaWarningMessage :: String alphaWarningMessage :: String
alphaWarningMessage = alphaWarningMessage =
"NOTE: Wasp is still in Alpha, therefore not yet production ready " "Wasp is still in Alpha, therefore not yet production ready "
++ "and might change significantly in the future versions." ++ "and might change significantly in the future versions."

View File

@ -12,15 +12,14 @@ import StrongPath (Abs, Dir, Path', (</>))
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Command.Common import Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
waspSaysC,
) )
import Wasp.Cli.Common (waspWarns) import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Message (cliSendMessage) import Wasp.Cli.Message (cliSendMessage)
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage, asWaspWarningMessage)
import Wasp.Common (WaspProjectDir) import Wasp.Common (WaspProjectDir)
import Wasp.CompileOptions (CompileOptions (..)) import Wasp.CompileOptions (CompileOptions (..))
import qualified Wasp.Lib import qualified Wasp.Lib
import qualified Wasp.Message as Msg
compile :: Command () compile :: Command ()
compile = do compile = do
@ -29,11 +28,11 @@ compile = do
waspProjectDir </> Common.dotWaspDirInWaspProjectDir waspProjectDir </> Common.dotWaspDirInWaspProjectDir
</> Common.generatedCodeDirInDotWaspDir </> Common.generatedCodeDirInDotWaspDir
waspSaysC $ asWaspStartMessage "Compiling wasp code..." cliSendMessageC $ Msg.Start "Compiling wasp code..."
compilationResult <- liftIO $ compileIO waspProjectDir outDir compilationResult <- liftIO $ compileIO waspProjectDir outDir
case compilationResult of case compilationResult of
Left compileError -> throwError $ CommandError $ asWaspFailureMessage "Compilation failed:" ++ compileError Left compileError -> throwError $ CommandError "Compilation failed" compileError
Right () -> waspSaysC $ asWaspSuccessMessage "Code has been successfully compiled, project has been generated." Right () -> cliSendMessageC $ Msg.Success "Code has been successfully compiled, project has been generated."
-- | Compiles Wasp source code in waspProjectDir directory and generates a project -- | Compiles Wasp source code in waspProjectDir directory and generates a project
-- in given outDir directory. -- in given outDir directory.
@ -66,4 +65,4 @@ compileIOWithOptions options waspProjectDir outDir = do
formatMessages messages = intercalate "\n" $ map ("- " ++) messages formatMessages messages = intercalate "\n" $ map ("- " ++) messages
displayWarnings [] = return () displayWarnings [] = return ()
displayWarnings warnings = displayWarnings warnings =
waspWarns $ asWaspWarningMessage "Your project compiled with warnings:" ++ formatMessages warnings ++ "\n\n" cliSendMessage $ Msg.Warning "Your project compiled with warnings" (formatMessages warnings ++ "\n\n")

View File

@ -19,7 +19,6 @@ import Wasp.AppSpec.ExternalCode (SourceExternalCodeDir)
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import qualified Wasp.Cli.Command.Common as Command.Common import qualified Wasp.Cli.Command.Common as Command.Common
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspFailureMessage)
import qualified Wasp.Data import qualified Wasp.Data
import Wasp.Lexer (reservedNames) import Wasp.Lexer (reservedNames)
import qualified Wasp.Util.Terminal as Term import qualified Wasp.Util.Terminal as Term
@ -28,9 +27,13 @@ newtype ProjectName = ProjectName {_projectName :: String}
createNewProject :: String -> Command () createNewProject :: String -> Command ()
createNewProject (all isLetter -> False) = createNewProject (all isLetter -> False) =
throwError $ CommandError $ asWaspFailureMessage "Project creation failed:" ++ "Please use only letters for a new project's name." throwError $ CommandError "Project creation failed" "Please use only letters for a new project's name."
createNewProject ((`elem` reservedNames) -> True) = createNewProject ((`elem` reservedNames) -> True) =
throwError . CommandError $ asWaspFailureMessage "Project creation failed:" ++ "Please pick a project name not one of these reserved words:\n\t" ++ intercalate "\n\t" reservedNames throwError $
CommandError
"Project creation failed"
( "Please pick a project name not one of these reserved words:\n\t" ++ intercalate "\n\t" reservedNames
)
createNewProject name = createNewProject' (ProjectName name) createNewProject name = createNewProject' (ProjectName name)
createNewProject' :: ProjectName -> Command () createNewProject' :: ProjectName -> Command ()
@ -39,9 +42,9 @@ createNewProject' (ProjectName projectName) = do
waspProjectDir <- case SP.parseAbsDir $ absCwd FP.</> projectName of waspProjectDir <- case SP.parseAbsDir $ absCwd FP.</> projectName of
Left err -> Left err ->
throwError $ throwError $
CommandError $ CommandError
asWaspFailureMessage "Project creation failed:" "Project creation failed"
++ ( "Failed to parse absolute path to wasp project dir: " ( "Failed to parse absolute path to wasp project dir: "
++ show err ++ show err
) )
Right sp -> return sp Right sp -> return sp

View File

@ -9,12 +9,13 @@ import Control.Concurrent.Async (concurrently)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import StrongPath ((</>)) import StrongPath ((</>))
import Wasp.Cli.Command (Command, runCommand) import Wasp.Cli.Command (Command, runCommand)
import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd, waspSaysC) import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd)
import Wasp.Cli.Command.Compile (compile) import Wasp.Cli.Command.Compile (compile)
import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspStartMessage)
import Wasp.Generator.DbGenerator.Jobs (runStudio) import Wasp.Generator.DbGenerator.Jobs (runStudio)
import Wasp.Generator.Job.IO (readJobMessagesAndPrintThemPrefixed) import Wasp.Generator.Job.IO (readJobMessagesAndPrintThemPrefixed)
import qualified Wasp.Message as Msg
runDbCommand :: Command a -> IO () runDbCommand :: Command a -> IO ()
runDbCommand = runCommand . makeDbCommand runDbCommand = runCommand . makeDbCommand
@ -37,7 +38,7 @@ studio = do
waspProjectDir </> Common.dotWaspDirInWaspProjectDir waspProjectDir </> Common.dotWaspDirInWaspProjectDir
</> Common.generatedCodeDirInDotWaspDir </> Common.generatedCodeDirInDotWaspDir
waspSaysC $ asWaspStartMessage "Running studio..." cliSendMessageC $ Msg.Start "Running studio..."
chan <- liftIO newChan chan <- liftIO newChan
_ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan) _ <- liftIO $ concurrently (readJobMessagesAndPrintThemPrefixed chan) (runStudio genProjectDir chan)

View File

@ -11,12 +11,12 @@ import StrongPath ((</>))
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Command.Common import Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
waspSaysC,
) )
import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Cli.Common import qualified Wasp.Cli.Common as Cli.Common
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage)
import qualified Wasp.Common import qualified Wasp.Common
import qualified Wasp.Generator.DbGenerator.Operations as DbOps import qualified Wasp.Generator.DbGenerator.Operations as DbOps
import qualified Wasp.Message as Msg
-- | NOTE(shayne): Performs database schema migration (based on current schema) in the generated project. -- | NOTE(shayne): Performs database schema migration (based on current schema) in the generated project.
-- This assumes the wasp project migrations dir was copied from wasp source project by a previous compile. -- This assumes the wasp project migrations dir was copied from wasp source project by a previous compile.
@ -33,9 +33,9 @@ migrateDev maybeMigrationName = do
waspProjectDir waspProjectDir
</> Wasp.Common.dbMigrationsDirInWaspProjectDir </> Wasp.Common.dbMigrationsDirInWaspProjectDir
waspSaysC $ asWaspStartMessage "Performing migration..." cliSendMessageC $ Msg.Start "Performing migration..."
migrateResult <- liftIO $ DbOps.migrateDevAndCopyToSource waspDbMigrationsDir genProjectRootDir maybeMigrationName migrateResult <- liftIO $ DbOps.migrateDevAndCopyToSource waspDbMigrationsDir genProjectRootDir maybeMigrationName
case migrateResult of case migrateResult of
Left migrateError -> Left migrateError ->
throwError $ CommandError $ asWaspFailureMessage "Migrate dev failed:" ++ migrateError throwError $ CommandError "Migrate dev failed" migrateError
Right () -> waspSaysC $ asWaspSuccessMessage "Migration done." Right () -> cliSendMessageC $ Msg.Success "Migration done."

View File

@ -14,12 +14,14 @@ import qualified Wasp.Analyzer as Analyzer
import qualified Wasp.AppSpec as AS import qualified Wasp.AppSpec as AS
import qualified Wasp.AppSpec.App as AS.App import qualified Wasp.AppSpec.App as AS.App
import Wasp.Cli.Command (Command) import Wasp.Cli.Command (Command)
import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd, waspSaysC) import Wasp.Cli.Command.Common (findWaspProjectRootDirFromCwd)
import Wasp.Cli.Command.Message (cliSendMessageC)
import qualified Wasp.Cli.Common as Cli.Common import qualified Wasp.Cli.Common as Cli.Common
import Wasp.Cli.Terminal (title) import Wasp.Cli.Terminal (title)
import Wasp.Common (WaspProjectDir) import Wasp.Common (WaspProjectDir)
import Wasp.Error (showCompilerErrorForTerminal) import Wasp.Error (showCompilerErrorForTerminal)
import Wasp.Lib (findWaspFile) import Wasp.Lib (findWaspFile)
import qualified Wasp.Message as Msg
import Wasp.Util.IO (listDirectoryDeep) import Wasp.Util.IO (listDirectoryDeep)
import qualified Wasp.Util.Terminal as Term import qualified Wasp.Util.Terminal as Term
@ -31,9 +33,10 @@ info =
projectSize <- liftIO $ readDirectorySizeMB waspDir projectSize <- liftIO $ readDirectorySizeMB waspDir
declsOrError <- liftIO $ parseWaspFile waspDir declsOrError <- liftIO $ parseWaspFile waspDir
case declsOrError of case declsOrError of
Left err -> waspSaysC err Left err -> cliSendMessageC $ Msg.Failure "Info failed" err
Right decls -> do Right decls -> do
waspSaysC $ cliSendMessageC $
Msg.Info $
unlines unlines
[ "", [ "",
title "Project information", title "Project information",

View File

@ -0,0 +1,9 @@
module Wasp.Cli.Command.Message (cliSendMessageC) where
import Control.Monad.IO.Class (liftIO)
import Wasp.Cli.Command (Command)
import Wasp.Cli.Message (cliSendMessage)
import qualified Wasp.Message as Msg
cliSendMessageC :: Msg.Message -> Command ()
cliSendMessageC = liftIO . cliSendMessage

View File

@ -10,15 +10,15 @@ import StrongPath ((</>))
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import Wasp.Cli.Command.Common import Wasp.Cli.Command.Common
( findWaspProjectRootDirFromCwd, ( findWaspProjectRootDirFromCwd,
waspSaysC,
) )
import Wasp.Cli.Command.Compile import Wasp.Cli.Command.Compile
( compileIO, ( compileIO,
) )
import Wasp.Cli.Command.Message (cliSendMessageC)
import Wasp.Cli.Command.Watch (watch) import Wasp.Cli.Command.Watch (watch)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage)
import qualified Wasp.Lib import qualified Wasp.Lib
import qualified Wasp.Message as Msg
-- | Does initial compile of wasp code and then runs the generated project. -- | Does initial compile of wasp code and then runs the generated project.
-- It also listens for any file changes and recompiles and restarts generated project accordingly. -- It also listens for any file changes and recompiles and restarts generated project accordingly.
@ -27,17 +27,17 @@ start = do
waspRoot <- findWaspProjectRootDirFromCwd waspRoot <- findWaspProjectRootDirFromCwd
let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir let outDir = waspRoot </> Common.dotWaspDirInWaspProjectDir </> Common.generatedCodeDirInDotWaspDir
waspSaysC $ asWaspStartMessage "Starting compilation and setup phase. Hold tight..." cliSendMessageC $ Msg.Start "Starting compilation and setup phase. Hold tight..."
compilationResult <- liftIO $ compileIO waspRoot outDir compilationResult <- liftIO $ compileIO waspRoot outDir
case compilationResult of case compilationResult of
Left compileError -> throwError $ CommandError $ asWaspFailureMessage "Compilation failed:" ++ compileError Left compileError -> throwError $ CommandError "Compilation failed" compileError
Right () -> waspSaysC $ asWaspSuccessMessage "Code has been successfully compiled, project has been generated." Right () -> cliSendMessageC $ Msg.Success "Code has been successfully compiled, project has been generated."
waspSaysC $ asWaspStartMessage "Listening for file changes..." cliSendMessageC $ Msg.Start "Listening for file changes..."
waspSaysC $ asWaspStartMessage "Starting up generated project..." cliSendMessageC $ Msg.Start "Starting up generated project..."
watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Wasp.Lib.start outDir) watchOrStartResult <- liftIO $ race (watch waspRoot outDir) (Wasp.Lib.start outDir)
case watchOrStartResult of case watchOrStartResult of
Left () -> error "This should never happen, listening for file changes should never end but it did." Left () -> error "This should never happen, listening for file changes should never end but it did."
Right startResult -> case startResult of Right startResult -> case startResult of
Left startError -> throwError $ CommandError $ asWaspFailureMessage "Start failed:" ++ startError Left startError -> throwError $ CommandError "Start failed" startError
Right () -> error "This should never happen, start should never end but it did." Right () -> error "This should never happen, start should never end but it did."

View File

@ -13,11 +13,11 @@ import qualified StrongPath as SP
import qualified System.Environment as ENV import qualified System.Environment as ENV
import Wasp.Cli.Command (Command, CommandError (..)) import Wasp.Cli.Command (Command, CommandError (..))
import qualified Wasp.Cli.Command.Call as Command.Call import qualified Wasp.Cli.Command.Call as Command.Call
import Wasp.Cli.Command.Common (waspSaysC) import Wasp.Cli.Command.Message (cliSendMessageC)
import Wasp.Cli.Command.Telemetry.Common (ensureTelemetryCacheDirExists) import Wasp.Cli.Command.Telemetry.Common (ensureTelemetryCacheDirExists)
import qualified Wasp.Cli.Command.Telemetry.Project as TlmProject import qualified Wasp.Cli.Command.Telemetry.Project as TlmProject
import qualified Wasp.Cli.Command.Telemetry.User as TlmUser import qualified Wasp.Cli.Command.Telemetry.User as TlmUser
import Wasp.Cli.Terminal (asWaspFailureMessage) import qualified Wasp.Message as Msg
isTelemetryDisabled :: IO Bool isTelemetryDisabled :: IO Bool
isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE" isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
@ -26,7 +26,8 @@ isTelemetryDisabled = isJust <$> ENV.lookupEnv "WASP_TELEMETRY_DISABLE"
telemetry :: Command () telemetry :: Command ()
telemetry = do telemetry = do
telemetryDisabled <- liftIO isTelemetryDisabled telemetryDisabled <- liftIO isTelemetryDisabled
waspSaysC $ cliSendMessageC $
Msg.Info $
"Telemetry is currently: " "Telemetry is currently: "
<> ( if telemetryDisabled <> ( if telemetryDisabled
then "DISABLED" then "DISABLED"
@ -35,7 +36,7 @@ telemetry = do
unless telemetryDisabled $ do unless telemetryDisabled $ do
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists
waspSaysC $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath cliSendMessageC $ Msg.Info $ "Telemetry cache directory: " ++ SP.toFilePath telemetryCacheDirPath
maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing) maybeProjectHash <- (Just <$> TlmProject.getWaspProjectPathHash) `catchError` const (return Nothing)
for_ maybeProjectHash $ \projectHash -> do for_ maybeProjectHash $ \projectHash -> do
@ -43,9 +44,9 @@ telemetry = do
for_ maybeProjectCache $ \projectCache -> do for_ maybeProjectCache $ \projectCache -> do
let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache let maybeTimeOfLastSending = TlmProject.getTimeOfLastTelemetryDataSent projectCache
for_ maybeTimeOfLastSending $ \timeOfLastSending -> do for_ maybeTimeOfLastSending $ \timeOfLastSending -> do
waspSaysC $ "Last time telemetry data was sent for this project: " ++ show timeOfLastSending cliSendMessageC $ Msg.Info $ "Last time telemetry data was sent for this project: " ++ show timeOfLastSending
waspSaysC "Our telemetry is anonymized and very limited in its scope: check https://wasp-lang.dev/docs/telemetry for more details." cliSendMessageC $ Msg.Info "Our telemetry is anonymized and very limited in its scope: check https://wasp-lang.dev/docs/telemetry for more details."
-- | Sends telemetry data about the current Wasp project, if conditions are met. -- | Sends telemetry data about the current Wasp project, if conditions are met.
-- If we are not in the Wasp project at the moment, nothing happens. -- If we are not in the Wasp project at the moment, nothing happens.
@ -54,7 +55,7 @@ telemetry = do
considerSendingData :: Command.Call.Call -> Command () considerSendingData :: Command.Call.Call -> Command ()
considerSendingData cmdCall = (`catchError` const (return ())) $ do considerSendingData cmdCall = (`catchError` const (return ())) $ do
telemetryDisabled <- liftIO isTelemetryDisabled telemetryDisabled <- liftIO isTelemetryDisabled
when telemetryDisabled $ throwError $ CommandError $ asWaspFailureMessage "Telemetry disabled by user." when telemetryDisabled $ throwError $ CommandError "Telemetry failed" "Telemetry disabled by user."
telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists telemetryCacheDirPath <- liftIO ensureTelemetryCacheDirExists

View File

@ -14,10 +14,10 @@ import qualified StrongPath as SP
import qualified System.FSNotify as FSN import qualified System.FSNotify as FSN
import qualified System.FilePath as FP import qualified System.FilePath as FP
import Wasp.Cli.Command.Compile (compileIO) import Wasp.Cli.Command.Compile (compileIO)
import Wasp.Cli.Common (waspSays, waspScreams)
import qualified Wasp.Cli.Common as Common import qualified Wasp.Cli.Common as Common
import Wasp.Cli.Terminal (asWaspFailureMessage, asWaspStartMessage, asWaspSuccessMessage) import Wasp.Cli.Message (cliSendMessage)
import qualified Wasp.Lib import qualified Wasp.Lib
import qualified Wasp.Message as Msg
-- TODO: Another possible problem: on re-generation, wasp re-generates a lot of files, even those that should not -- TODO: Another possible problem: on re-generation, wasp re-generates a lot of files, even those that should not
-- be generated again, since it is not smart enough yet to know which files do not need to be regenerated. -- be generated again, since it is not smart enough yet to know which files do not need to be regenerated.
@ -79,11 +79,11 @@ watch waspProjectDir outDir = FSN.withManager $ \mgr -> do
recompile :: IO () recompile :: IO ()
recompile = do recompile = do
waspSays $ asWaspStartMessage "Recompiling on file change..." cliSendMessage $ Msg.Start "Recompiling on file change..."
compilationResult <- compileIO waspProjectDir outDir compilationResult <- compileIO waspProjectDir outDir
case compilationResult of case compilationResult of
Left err -> waspScreams $ asWaspFailureMessage "Recompilation on file change failed:" ++ err Left err -> cliSendMessage $ Msg.Failure "Recompilation on file change failed" err
Right () -> waspSays $ asWaspSuccessMessage "Recompilation on file change succeeded." Right () -> cliSendMessage $ Msg.Success "Recompilation on file change succeeded."
return () return ()
-- TODO: This is a hardcoded approach to ignoring most of the common tmp files that editors -- TODO: This is a hardcoded approach to ignoring most of the common tmp files that editors

View File

@ -11,11 +11,13 @@ import qualified Wasp.Message as Msg
-- | Send a message using the CLI -- | Send a message using the CLI
cliSendMessage :: Msg.SendMessage cliSendMessage :: Msg.SendMessage
cliSendMessage (Msg.Info msg) =
waspSays msg
cliSendMessage (Msg.Start msg) = cliSendMessage (Msg.Start msg) =
waspSays $ asWaspStartMessage msg waspSays $ asWaspStartMessage msg
cliSendMessage (Msg.Success msg) = cliSendMessage (Msg.Success msg) =
waspSays $ asWaspSuccessMessage msg waspSays $ asWaspSuccessMessage msg
cliSendMessage (Msg.Failure msg) = cliSendMessage (Msg.Failure title msg) =
waspScreams $ asWaspFailureMessage msg waspScreams $ asWaspFailureMessage (title ++ ":") ++ msg
cliSendMessage (Msg.Warning msg) = cliSendMessage (Msg.Warning title msg) =
waspWarns $ asWaspWarningMessage msg waspWarns $ asWaspWarningMessage (title ++ ":") ++ msg

View File

@ -3,6 +3,7 @@ module Wasp.Generator.Setup
) )
where where
import Control.Monad (when)
import StrongPath (Abs, Dir, Path') import StrongPath (Abs, Dir, Path')
import Wasp.AppSpec (AppSpec) import Wasp.AppSpec (AppSpec)
import Wasp.Generator.Common (ProjectRootDir) import Wasp.Generator.Common (ProjectRootDir)
@ -20,10 +21,7 @@ runSetup spec dstDir sendMessage = do
sendMessage $ Msg.Success "Successfully completed npm install." sendMessage $ Msg.Success "Successfully completed npm install."
sendMessage $ Msg.Start "Setting up database..." sendMessage $ Msg.Start "Setting up database..."
(dbGeneratorWarnings, dbGeneratorErrors) <- DbGenerator.postWriteDbGeneratorActions spec dstDir (dbGeneratorWarnings, dbGeneratorErrors) <- DbGenerator.postWriteDbGeneratorActions spec dstDir
if null dbGeneratorErrors when (null dbGeneratorErrors) (sendMessage $ Msg.Success "Database successfully set up.")
then sendMessage $ Msg.Success "Database successfully set up."
else sendMessage $ Msg.Failure "Could not set up database."
return (npmInstallWarnings ++ dbGeneratorWarnings, dbGeneratorErrors) return (npmInstallWarnings ++ dbGeneratorWarnings, dbGeneratorErrors)
else do else do
sendMessage $ Msg.Failure "npm install failed!"
return (npmInstallWarnings, npmInstallErrors) return (npmInstallWarnings, npmInstallErrors)

View File

@ -9,6 +9,6 @@ module Wasp.Message (Message (..), SendMessage) where
-- This protocol is for sending messages for display in a UI. -- This protocol is for sending messages for display in a UI.
-- If you need success or failure another purpose use return values. -- If you need success or failure another purpose use return values.
data Message = Start String | Success String | Failure String | Warning String data Message = Info String | Start String | Success String | Failure String String | Warning String String
type SendMessage = Message -> IO () type SendMessage = Message -> IO ()