Add global --debug flag

app/Main.hs

@@ -1,12 +1,13 @@
-{-# LANGUAGE ApplicativeDo #-}
 module Main (main) where
 
+import Spago.Prelude
+
 import qualified Data.Text as Text
 import Data.Version (showVersion)
 import qualified GHC.IO.Encoding
 import qualified Paths_spago as Pcli
 import qualified System.Environment as Env
-import qualified Turtle as T
+import qualified Turtle as CLI
 
 import Spago.Build (BuildOptions (..), ExtraArg (..), ModuleName (..),
  NoBuild (..), SourcePath (..), TargetPath (..), Watch (..),
@@ -94,15 +95,16 @@ data Command
  | Version
 
 
-parser :: T.Parser Command
-parser = projectCommands
- T.<|> packageSetCommands
- T.<|> pscPackageCommands
- T.<|> otherCommands
+parser :: CLI.Parser (Command, GlobalOptions)
+parser = do
+ opts <- globalOptions
+ command <- projectCommands <|> packageSetCommands <|> pscPackageCommands <|> otherCommands
+ pure (command, opts)
  where
- force = T.switch "force" 'f' "Overwrite any project found in the current directory"
- watchBool = T.switch "watch" 'w' "Watch for changes in local files and automatically rebuild"
- noBuildBool = T.switch "no-build" 's' "Skip build step"
+ force = CLI.switch "force" 'f' "Overwrite any project found in the current directory"
+ verbose = CLI.switch "verbose" 'v' "Enable additional debug logging, e.g. printing `purs` commands"
+ watchBool = CLI.switch "watch" 'w' "Watch for changes in local files and automatically rebuild"
+ noBuildBool = CLI.switch "no-build" 's' "Skip build step"
  watch = do
  res <- watchBool
  pure $ case res of
@@ -113,22 +115,23 @@ parser = projectCommands
  pure $ case res of
  True -> NoBuild
  False -> DoBuild
- mainModule = T.optional (T.opt (Just . ModuleName) "main" 'm' "The main module to bundle")
- toTarget = T.optional (T.opt (Just . TargetPath) "to" 't' "The target file path")
- limitJobs = T.optional (T.optInt "jobs" 'j' "Limit the amount of jobs that can run concurrently")
- sourcePaths = T.many (T.opt (Just . SourcePath) "path" 'p' "Source path to include")
- packageName = T.arg (Just . PackageName) "package" "Specify a package name. You can list them with `list-packages`"
- packageNames = T.many $ T.arg (Just . PackageName) "package" "Package name to add as dependency"
- passthroughArgs = T.many $ T.arg (Just . ExtraArg) " ..any `purs compile` option" "Options passed through to `purs compile`; use -- to separate"
+ mainModule = CLI.optional (CLI.opt (Just . ModuleName) "main" 'm' "The main module to bundle")
+ toTarget = CLI.optional (CLI.opt (Just . TargetPath) "to" 't' "The target file path")
+ limitJobs = CLI.optional (CLI.optInt "jobs" 'j' "Limit the amount of jobs that can run concurrently")
+ sourcePaths = CLI.many (CLI.opt (Just . SourcePath) "path" 'p' "Source path to include")
+ packageName = CLI.arg (Just . PackageName) "package" "Specify a package name. You can list them with `list-packages`"
+ packageNames = CLI.many $ CLI.arg (Just . PackageName) "package" "Package name to add as dependency"
+ passthroughArgs = many $ CLI.arg (Just . ExtraArg) " ..any `purs compile` option" "Options passed through to `purs compile`; use -- to separate"
  buildOptions = BuildOptions <$> limitJobs <*> watch <*> sourcePaths <*> passthroughArgs
+ globalOptions = GlobalOptions <$> verbose
  packagesFilter =
  let wrap = \case
  "direct" -> Just DirectDeps
  "transitive" -> Just TransitiveDeps
  _ -> Nothing
- in T.optional $ T.opt wrap "filter" 'f' "Filter packages: direct deps with `direct`, transitive ones with `transitive`"
+ in CLI.optional $ CLI.opt wrap "filter" 'f' "Filter packages: direct deps with `direct`, transitive ones with `transitive`"
 
- projectCommands = T.subcommandGroup "Project commands:"
+ projectCommands = CLI.subcommandGroup "Project commands:"
  [ initProject
  , build
  , repl
@@ -188,7 +191,7 @@ parser = projectCommands
  )
 
 
- packageSetCommands = T.subcommandGroup "Package set commands:"
+ packageSetCommands = CLI.subcommandGroup "Package set commands:"
  [ install
  , sources
  , listPackages
@@ -241,7 +244,7 @@ parser = projectCommands
  )
 
 
- pscPackageCommands = T.subcommandGroup "Psc-Package compatibility commands:"
+ pscPackageCommands = CLI.subcommandGroup "Psc-Package compatibility commands:"
  [ pscPackageLocalSetup
  , pscPackageInsDhall
  , pscPackageClean
@@ -266,7 +269,7 @@ parser = projectCommands
  )
 
 
- otherCommands = T.subcommandGroup "Other commands:"
+ otherCommands = CLI.subcommandGroup "Other commands:"
  [ version
  ]
 
@@ -287,28 +290,29 @@ main = do
  Env.setEnv "GIT_TERMINAL_PROMPT" "0"
 
  -- | Print out Spago version
- let printVersion = T.echo $ T.unsafeTextToLine $ Text.pack $ showVersion Pcli.version
-
- command <- T.options "Spago - manage your PureScript projects" parser
- case command of
- Init force -> Spago.Packages.initProject force
- Install limitJobs packageNames -> Spago.Packages.install limitJobs packageNames
- ListPackages packagesFilter -> Spago.Packages.listPackages packagesFilter
- Sources -> Spago.Packages.sources
- Verify limitJobs package -> Spago.Packages.verify limitJobs (Just package)
- VerifySet limitJobs -> Spago.Packages.verify limitJobs Nothing
- PackageSetUpgrade -> Spago.Packages.upgradePackageSet
- Freeze -> Spago.Packages.freeze
- Build buildOptions -> Spago.Build.build buildOptions Nothing
- Test modName buildOptions -> Spago.Build.test modName buildOptions
- Run modName buildOptions -> Spago.Build.run modName buildOptions
- Repl paths pursArgs -> Spago.Build.repl paths pursArgs
- Bundle modName tPath shouldBuild buildOptions
- -> Spago.Build.bundle WithMain modName tPath shouldBuild buildOptions
- MakeModule modName tPath shouldBuild buildOptions
- -> Spago.Build.makeModule modName tPath shouldBuild buildOptions
- Docs sourcePaths -> Spago.Build.docs sourcePaths
- Version -> printVersion
- PscPackageLocalSetup force -> PscPackage.localSetup force
- PscPackageInsDhall -> PscPackage.insDhall
- PscPackageClean -> PscPackage.clean
+ let printVersion = CLI.echo $ CLI.unsafeTextToLine $ Text.pack $ showVersion Pcli.version
+
+ (command, globalOptions) <- CLI.options "Spago - manage your PureScript projects" parser
+ (flip runReaderT) globalOptions $
+ case command of
+ Init force -> Spago.Packages.initProject force
+ Install limitJobs packageNames -> Spago.Packages.install limitJobs packageNames
+ ListPackages packagesFilter -> Spago.Packages.listPackages packagesFilter
+ Sources -> Spago.Packages.sources
+ Verify limitJobs package -> Spago.Packages.verify limitJobs (Just package)
+ VerifySet limitJobs -> Spago.Packages.verify limitJobs Nothing
+ PackageSetUpgrade -> Spago.Packages.upgradePackageSet
+ Freeze -> Spago.Packages.freeze
+ Build buildOptions -> Spago.Build.build buildOptions Nothing
+ Test modName buildOptions -> Spago.Build.test modName buildOptions
+ Run modName buildOptions -> Spago.Build.run modName buildOptions
+ Repl paths pursArgs -> Spago.Build.repl paths pursArgs
+ Bundle modName tPath shouldBuild buildOptions
+ -> Spago.Build.bundle WithMain modName tPath shouldBuild buildOptions
+ MakeModule modName tPath shouldBuild buildOptions
+ -> Spago.Build.makeModule modName tPath shouldBuild buildOptions
+ Docs sourcePaths -> Spago.Build.docs sourcePaths
+ Version -> printVersion
+ PscPackageLocalSetup force -> liftIO $ PscPackage.localSetup force
+ PscPackageInsDhall -> liftIO $ PscPackage.insDhall
+ PscPackageClean -> liftIO $ PscPackage.clean

app/Spago/Build.hs

@@ -16,19 +16,15 @@ module Spago.Build
  , Purs.WithMain (..)
  ) where
 
-import Control.Exception (SomeException, try)
-import Data.Maybe (Maybe(..), fromMaybe)
+import Spago.Prelude
+
 import qualified Data.Set as Set
 import qualified Data.Text as Text
-import System.Directory (makeAbsolute)
 import qualified System.FilePath.Glob as Glob
-import System.IO (hPutStrLn)
-import qualified Turtle as T hiding (die, echo)
 
 import qualified Spago.Config as Config
 import qualified Spago.Packages as Packages
 import qualified Spago.Purs as Purs
-import Spago.Turtle
 import Spago.Watch (watch)
 
 
@@ -63,7 +59,7 @@ prepareBundleDefaults maybeModuleName maybeTargetPath = (moduleName, targetPath)
 
 -- | Build the project with purs, passing through additional args and
 -- eventually running some other action after the build
-build :: BuildOptions -> Maybe (IO ()) -> IO ()
+build :: Spago m => BuildOptions -> Maybe (m ()) -> m ()
 build BuildOptions{..} maybePostBuild = do
  config <- Config.ensureConfig
  deps <- Packages.getProjectDeps config
@@ -81,7 +77,7 @@ build BuildOptions{..} maybePostBuild = do
  Watch -> watch (Set.fromAscList $ fmap Glob.compile absoluteProjectGlobs) buildAction
 
 -- | Start a repl
-repl :: [Purs.SourcePath] -> [Purs.ExtraArg] -> IO ()
+repl :: Spago m => [Purs.SourcePath] -> [Purs.ExtraArg] -> m ()
 repl sourcePaths passthroughArgs = do
  config <- Config.ensureConfig
  deps <- Packages.getProjectDeps config
@@ -90,35 +86,43 @@ repl sourcePaths passthroughArgs = do
 
 -- | Test the project: compile and run "Test.Main"
 -- (or the provided module name) with node
-test :: Maybe Purs.ModuleName -> BuildOptions -> IO ()
+test :: Spago m => Maybe Purs.ModuleName -> BuildOptions -> m ()
 test = runWithNode (Purs.ModuleName "Test.Main") (Just "Tests succeeded.") "Tests failed: "
 
 -- | Run the project: compile and run "Main"
 -- (or the provided module name) with node
-run :: Maybe Purs.ModuleName -> BuildOptions -> IO ()
+run :: Spago m => Maybe Purs.ModuleName -> BuildOptions -> m ()
 run = runWithNode (Purs.ModuleName "Main") Nothing "Running failed, exit code: "
 
 -- | Run the project with node: compile and run with the provided ModuleName
 -- (or the default one if that's missing)
 runWithNode
- :: Purs.ModuleName
- -> Maybe T.Text
- -> T.Text
+ :: Spago m
+ => Purs.ModuleName
+ -> Maybe Text
+ -> Text
  -> Maybe Purs.ModuleName
  -> BuildOptions
- -> IO ()
+ -> m ()
 runWithNode defaultModuleName maybeSuccessMessage failureMessage maybeModuleName buildOpts = do
  build buildOpts (Just nodeAction)
  where
  moduleName = fromMaybe defaultModuleName maybeModuleName
  cmd = "node -e \"require('./output/" <> Purs.unModuleName moduleName <> "').main()\""
  nodeAction = do
- T.shell cmd T.empty >>= \case
- T.ExitSuccess -> fromMaybe (pure ()) (echo <$> maybeSuccessMessage)
- T.ExitFailure n -> die $ failureMessage <> T.repr n
+ shell cmd empty >>= \case
+ ExitSuccess -> fromMaybe (pure ()) (echo <$> maybeSuccessMessage)
+ ExitFailure n -> die $ failureMessage <> repr n
 
  -- | Bundle the project to a js file
-bundle :: Purs.WithMain -> Maybe Purs.ModuleName -> Maybe Purs.TargetPath -> NoBuild -> BuildOptions -> IO ()
+bundle
+ :: Spago m
+ => Purs.WithMain
+ -> Maybe Purs.ModuleName
+ -> Maybe Purs.TargetPath
+ -> NoBuild
+ -> BuildOptions
+ -> m ()
 bundle withMain maybeModuleName maybeTargetPath noBuild buildOpts =
  let (moduleName, targetPath) = prepareBundleDefaults maybeModuleName maybeTargetPath
  bundleAction = Purs.bundle withMain moduleName targetPath
@@ -127,26 +131,32 @@ bundle withMain maybeModuleName maybeTargetPath noBuild buildOpts =
  NoBuild -> bundleAction
 
 -- | Bundle into a CommonJS module
-makeModule :: Maybe Purs.ModuleName -> Maybe Purs.TargetPath -> NoBuild -> BuildOptions -> IO ()
-makeModule maybeModuleName maybeTargetPath noBuild buildOpts =
+makeModule
+ :: Spago m
+ => Maybe Purs.ModuleName
+ -> Maybe Purs.TargetPath
+ -> NoBuild
+ -> BuildOptions
+ -> m ()
+makeModule maybeModuleName maybeTargetPath noBuild buildOpts = do
  let (moduleName, targetPath) = prepareBundleDefaults maybeModuleName maybeTargetPath
  jsExport = Text.unpack $ "\nmodule.exports = PS[\""<> Purs.unModuleName moduleName <> "\"];"
  bundleAction = do
  echo "Bundling first..."
  Purs.bundle Purs.WithoutMain moduleName targetPath
  -- Here we append the CommonJS export line at the end of the bundle
- try (T.with
- (T.appendonly $ T.fromText $ Purs.unTargetPath targetPath)
+ try (with
+ (appendonly $ pathFromText $ Purs.unTargetPath targetPath)
  ((flip hPutStrLn) jsExport))
  >>= \case
  Right _ -> echo $ "Make module succeeded and output file to " <> Purs.unTargetPath targetPath
- Left (n :: SomeException) -> die $ "Make module failed: " <> T.repr n
- in case noBuild of
+ Left (n :: SomeException) -> die $ "Make module failed: " <> repr n
+ case noBuild of
  DoBuild -> build buildOpts (Just bundleAction)
  NoBuild -> bundleAction
 
 -- | Generate docs for the `sourcePaths`
-docs :: [Purs.SourcePath] -> IO ()
+docs :: Spago m => [Purs.SourcePath] -> m ()
 docs sourcePaths = do
  config <- Config.ensureConfig
  deps <- Packages.getProjectDeps config