New 'spago init --subpackage foo' option to initialize a sub-project within current workspace

CHANGELOG.md

@@ -34,6 +34,8 @@ Other improvements:
   Spago on different platforms.
 - when encountering a mistyped option for a command, Spago will show help for
   that command, not root help.
+- a new `spago init --subpackage foo` option to initialize a sub-project in the
+  current workspace.
 
 ## [0.21.0] - 2023-05-04
 

bin/src/Flags.purs

@@ -7,7 +7,9 @@ import Data.List as List
 import Options.Applicative (FlagFields, Mod, Parser)
 import Options.Applicative as O
 import Options.Applicative.Types as OT
+import Spago.Command.Init as Init
 import Spago.Core.Config as Core
+import Spago.Prelude as Prelude
 
 flagMaybe ∷ ∀ (a ∷ Type). a -> Mod FlagFields (Maybe a) -> Parser (Maybe a)
 flagMaybe a mod = O.flag Nothing (Just a) mod
@@ -301,6 +303,19 @@ maybePackageName =
           <> O.help "Optional package name to be used for the new project"
       )
 
+subpackageName :: Parser String
+subpackageName =
+  O.strOption
+    ( O.long "subpackage"
+        <> O.help "Name of a subpackage to initialize within the current workspace"
+    )
+
+initMode :: Parser Init.InitMode
+initMode =
+  (Init.InitSubpackage <$> subpackageName)
+    <|> (Init.InitWorkspace <$> maybePackageName)
+    <|> Prelude.pure (Init.InitWorkspace Nothing)
+
 ensureRanges :: Parser Boolean
 ensureRanges =
   O.switch

bin/src/Main.purs

@@ -12,11 +12,9 @@ import Data.Foldable as Foldable
 import Data.List as List
 import Data.Maybe as Maybe
 import Data.Set as Set
-import Data.String as String
 import Effect.Aff as Aff
 import Effect.Aff.AVar as AVar
 import Effect.Now as Now
-import Node.Path as Path
 import Node.Process as Process
 import Options.Applicative (CommandFields, Mod, Parser, ParserPrefs(..))
 import Options.Applicative as O
@@ -53,12 +51,11 @@ import Spago.Generated.BuildInfo as BuildInfo
 import Spago.Git as Git
 import Spago.Json as Json
 import Spago.Log (LogVerbosity(..))
-import Spago.Log as Log
 import Spago.Paths as Paths
 import Spago.Purs as Purs
 import Spago.Registry as Registry
 import Spago.Repl as SpagoRepl
-import Unsafe.Coerce as UnsafeCoerce
+import Unsafe.Coerce (unsafeCoerce)
 
 type GlobalArgs =
   { noColor :: Boolean
@@ -70,7 +67,7 @@ type GlobalArgs =
 
 type InitArgs =
   { setVersion :: Maybe String
-  , name :: Maybe String
+  , mode :: Init.InitMode
   , useSolver :: Boolean
   }
 
@@ -296,7 +293,7 @@ initArgsParser :: Parser InitArgs
 initArgsParser =
   Optparse.fromRecord
     { setVersion: Flags.maybeSetVersion
-    , name: Flags.maybePackageName
+    , mode: Flags.initMode
     , useSolver: Flags.useSolver
     }
 
@@ -547,24 +544,10 @@ main = do
               }
             void $ runSpago env (Sources.run { json: args.json })
           Init args@{ useSolver } -> do
-            -- Figure out the package name from the current dir
-            let candidateName = fromMaybe (String.take 150 $ Path.basename Paths.cwd) args.name
-            logDebug [ show Paths.cwd, show candidateName ]
-            packageName <- case PackageName.parse (PackageName.stripPureScriptPrefix candidateName) of
-              Left err -> die
-                [ toDoc "Could not figure out a name for the new package. Error:"
-                , Log.break
-                , Log.indent2 $ toDoc err
-                ]
-              Right p -> pure p
-            setVersion <- parseSetVersion args.setVersion
-            logDebug [ "Got packageName and setVersion:", PackageName.print packageName, unsafeStringify setVersion ]
-            let initOpts = { packageName, setVersion, useSolver }
             -- Fetch the registry here so we can select the right package set later
             env <- mkRegistryEnv offline
-            void $ runSpago env $ Init.run initOpts
-            logInfo "Set up a new Spago project."
-            logInfo "Try running `spago run`"
+            setVersion <- parseSetVersion args.setVersion
+            void $ runSpago env $ Init.run { mode: args.mode, setVersion, useSolver }
           Fetch args -> do
             { env, fetchOpts } <- mkFetchEnv (Record.merge { isRepl: false, migrateConfig, offline } args)
             void $ runSpago env (Fetch.run fetchOpts)
@@ -620,7 +603,7 @@ main = do
                 env <- mkRegistryEnv offline
                 void $ runSpago env $ Init.run
                   { setVersion: Nothing
-                  , packageName: UnsafeCoerce.unsafeCoerce "repl"
+                  , mode: Init.InitWorkspace (Just $ unsafeCoerce "repl")
                   , useSolver: true
                   }
                 pure $ List.fromFoldable [ "effect", "console" ] -- TODO newPackages

src/Spago/Command/Init.purs

@@ -2,6 +2,7 @@ module Spago.Command.Init
   ( DefaultConfigOptions(..)
   , DefaultConfigPackageOptions
   , DefaultConfigWorkspaceOptions
+  , InitMode(..)
   , InitOptions
   , defaultConfig
   , defaultConfig'
@@ -14,65 +15,77 @@ module Spago.Command.Init
 import Spago.Prelude
 
 import Data.Map as Map
+import Data.String as String
 import Node.Path as Path
 import Registry.PackageName as PackageName
 import Registry.Version as Version
 import Spago.Config (Dependencies(..), SetAddress(..), Config)
 import Spago.Config as Config
 import Spago.FS as FS
+import Spago.Log as Log
+import Spago.Paths as Paths
 import Spago.Registry (RegistryEnv)
 import Spago.Registry as Registry
 
+data InitMode = InitWorkspace (Maybe String) | InitSubpackage String
+
 type InitOptions =
   -- TODO: we should allow the `--package-set` flag to alternatively pass in a URL
   { setVersion :: Maybe Version
-  , packageName :: PackageName
+  , mode :: InitMode
   , useSolver :: Boolean
   }
 
 -- TODO run git init? Is that desirable?
 
 run :: ∀ a. InitOptions -> Spago (RegistryEnv a) Config
 run opts = do
-  logInfo "Initializing a new project..."
-
   -- Use the specified version of the package set (if specified).
   -- Otherwise, get the latest version of the package set for the given compiler
   packageSetVersion <- Registry.findPackageSet opts.setVersion
 
+  packageName <- getPackageName
+  withWorkspace <- getWithWorkspace packageSetVersion
+  projectDir <- getProjectDir packageName
+
   { purs } <- ask
+  logInfo "Initializing a new project..."
   logInfo $ "Found PureScript " <> Version.print purs.version <> ", will use package set " <> Version.print packageSetVersion
 
-  -- Write config
   let
-    config = defaultConfig
-      { name: opts.packageName
-      , withWorkspace: Just
-          { setVersion: case opts.useSolver of
-              true -> Nothing
-              false -> Just packageSetVersion
-          }
-      , testModuleName: "Test.Main"
-      }
-  let configPath = "spago.yaml"
+    mainModuleName = "Main"
+    testModuleName = "Test.Main"
+    srcDir = Path.concat [ projectDir, "src" ]
+    testDir = Path.concat [ projectDir, "test" ]
+    configPath = Path.concat [ projectDir, "spago.yaml" ]
+    config = defaultConfig { name: packageName, withWorkspace, testModuleName }
+
+  -- Write config
   (FS.exists configPath) >>= case _ of
     true -> logInfo $ foundExistingProject configPath
     false -> liftAff $ FS.writeYamlFile Config.configCodec configPath config
 
   -- If these directories (or files) exist, we skip copying "sample sources"
   -- Because you might want to just init a project with your own source files,
   -- or just migrate a psc-package project
-  let mainModuleName = "Main"
-  whenDirNotExists "src" do
-    copyIfNotExists ("src" <> Path.sep <> mainModuleName <> ".purs") (srcMainTemplate mainModuleName)
+  whenDirNotExists srcDir do
+    copyIfNotExists (Path.concat [ srcDir, mainModuleName <> ".purs" ]) (srcMainTemplate mainModuleName)
 
-  whenDirNotExists "test" $ do
-    FS.mkdirp (Path.concat [ "test", "Test" ])
-    copyIfNotExists (Path.concat [ "test", "Test", "Main.purs" ]) (testMainTemplate "Test.Main")
+  whenDirNotExists testDir $ do
+    FS.mkdirp (Path.concat [ testDir, "Test" ])
+    copyIfNotExists (Path.concat [ testDir, "Test", "Main.purs" ]) (testMainTemplate testModuleName)
 
-  copyIfNotExists ".gitignore" gitignoreTemplate
+  case opts.mode of
+    InitWorkspace _ -> do
+      copyIfNotExists ".gitignore" gitignoreTemplate
+      copyIfNotExists pursReplFile.name pursReplFile.content
+    InitSubpackage _ ->
+      pure unit
 
-  copyIfNotExists pursReplFile.name pursReplFile.content
+  logInfo "Set up a new Spago project."
+  case opts.mode of
+    InitWorkspace _ -> logInfo "Try running `spago run`"
+    InitSubpackage _ -> logInfo $ "Try running `spago run -p " <> PackageName.print packageName <> "`"
 
   pure config
 
@@ -87,6 +100,43 @@ run opts = do
       true -> logInfo $ foundExistingFile dest
       false -> FS.writeTextFile dest srcTemplate
 
+  getPackageName = do
+    let
+      candidateName = case opts.mode of
+        InitWorkspace Nothing -> String.take 150 $ Path.basename Paths.cwd
+        InitWorkspace (Just n) -> n
+        InitSubpackage n -> n
+    logDebug [ show Paths.cwd, show candidateName ]
+    pname <- case PackageName.parse (PackageName.stripPureScriptPrefix candidateName) of
+      Left err -> die
+        [ toDoc "Could not figure out a name for the new package. Error:"
+        , Log.break
+        , Log.indent2 $ toDoc err
+        ]
+      Right p -> pure p
+    logDebug [ "Got packageName and setVersion:", PackageName.print pname, unsafeStringify opts.setVersion ]
+    pure pname
+
+  getWithWorkspace setVersion = case opts.mode of
+    InitWorkspace _ ->
+      pure $ Just
+        { setVersion: case opts.useSolver of
+            true -> Nothing
+            false -> Just setVersion
+        }
+    InitSubpackage _ -> do
+      when (isJust opts.setVersion || opts.useSolver) do
+        logWarn "The --package-set and --use-solver flags are ignored when initializing a subpackage"
+      pure Nothing
+
+  getProjectDir packageName = case opts.mode of
+    InitWorkspace _ ->
+      pure "."
+    InitSubpackage _ -> do
+      let dirPath = PackageName.print packageName
+      unlessM (FS.exists dirPath) $ FS.mkdirp dirPath
+      pure dirPath
+
 -- TEMPLATES -------------------------------------------------------------------
 
 type TemplateConfig =
@@ -234,10 +284,10 @@ pursReplFile = { name: ".purs-repl", content: "import Prelude\n" }
 -- ERROR TEXTS -----------------------------------------------------------------
 
 foundExistingProject :: FilePath -> String
-foundExistingProject path = "Found a " <> show path <> " file, skipping copy."
+foundExistingProject path = "Found a " <> path <> " file, skipping copy."
 
 foundExistingDirectory :: FilePath -> String
-foundExistingDirectory dir = "Found existing directory " <> show dir <> ", skipping copy of sample sources"
+foundExistingDirectory dir = "Found existing directory " <> dir <> ", skipping copy of sample sources"
 
 foundExistingFile :: FilePath -> String
-foundExistingFile file = "Found existing file " <> show file <> ", not overwriting it"
+foundExistingFile file = "Found existing file " <> file <> ", not overwriting it"

test-fixtures/init/subpackage/conflicting-flags.txt

@@ -0,0 +1,21 @@
+Invalid option `--subpackage'
+
+Usage: index.dev.js init [--migrate] [--monochrome|--no-color] [--offline] [-q|--quiet] [-v|--verbose] ([--subpackage ARG] | [--name ARG]) [--package-set ARG] [--use-solver]
+  Initialise a new project
+
+Available options:
+  --migrate                Migrate the spago.yaml file to the latest format
+  --monochrome,--no-color  Force logging without ANSI color escape sequences
+  --offline                Do not attempt to use the network. Warning: this will
+                           fail if you don't have the necessary dependencies
+                           already cached
+  -q,--quiet               Suppress all spago logging
+  -v,--verbose             Enable additional debug logging, e.g. printing `purs`
+                           commands
+  --subpackage ARG         Name of a subpackage to initialize within the current
+                           workspace
+  --name ARG               Optional package name to be used for the new project
+  --package-set ARG        Optional package set version to be used instead of
+                           the latest one
+  --use-solver             Use the solver instead of package sets
+  -h,--help                Show this help text

test-fixtures/init/subpackage/existing-src-file.txt

@@ -0,0 +1,5 @@
+Initializing a new project...
+Found PureScript a.b.c, will use package set x.y.z
+Found existing directory subdir/src, skipping copy of sample sources
+Set up a new Spago project.
+Try running `spago run -p subdir`

test-fixtures/init/subpackage/package-set-solver-warning-existing-files.txt

@@ -0,0 +1,8 @@
+‼ The --package-set and --use-solver flags are ignored when initializing a subpackage
+Initializing a new project...
+Found PureScript a.b.c, will use package set x.y.z
+Found a subdir/spago.yaml file, skipping copy.
+Found existing directory subdir/src, skipping copy of sample sources
+Found existing directory subdir/test, skipping copy of sample sources
+Set up a new Spago project.
+Try running `spago run -p subdir`

test-fixtures/init/subpackage/package-set-solver-warning.txt

@@ -0,0 +1,5 @@
+‼ The --package-set and --use-solver flags are ignored when initializing a subpackage
+Initializing a new project...
+Found PureScript a.b.c, will use package set x.y.z
+Set up a new Spago project.
+Try running `spago run -p subdir`

test-fixtures/init/subpackage/subdir-spago.yaml

@@ -0,0 +1,9 @@
+package:
+  name: subdir
+  dependencies:
+    - console
+    - effect
+    - prelude
+  test:
+    main: Test.Main
+    dependencies: []

test-fixtures/init/subpackage/subdir2-spago.yaml

@@ -0,0 +1,9 @@
+package:
+  name: subdir2
+  dependencies:
+    - console
+    - effect
+    - prelude
+  test:
+    main: Test.Main
+    dependencies: []

test/Spago/Cli.purs

@@ -32,12 +32,15 @@ spec = Spec.around withTempDir do
       { stdoutFile: stdout
       , stderrFile: stderr
       , result
-      , sanitize:
-          String.trim
-          >>> Regex.replace progNameRegex "Usage: index.dev.js"
-          >>> Regex.replace optionsLineRegex " $1"
+      , sanitize: sanitizeCliHelpOutput
       }
 
+sanitizeCliHelpOutput :: String -> String
+sanitizeCliHelpOutput =
+  String.trim
+  >>> Regex.replace progNameRegex "Usage: index.dev.js"
+  >>> Regex.replace optionsLineRegex " $1"
+  where
   -- On Windows progname has the full path like
   -- "Usage: C:\whatever\index.dev.js", but on Unix
   -- it's just "Usage: index.dev.js"
@@ -61,4 +64,4 @@ spec = Spec.around withTempDir do
   --
   --     Usage: index.dev.js build [--option] [--another-option] [--third-option] [--foo] [-f|--force] [--help]
   --
-  optionsLineRegex = unsafeFromRight $ Regex.regex "\\n\\s+(\\(\\[-|\\[-|PACKAGE)" RF.global
+  optionsLineRegex = unsafeFromRight $ Regex.regex "\\n\\s+(\\| \\[-|\\(\\[-|\\[-|PACKAGE)" RF.global

test/Spago/Init.purs

@@ -4,6 +4,7 @@ import Test.Prelude
 
 import Node.Path as Path
 import Spago.FS as FS
+import Test.Spago.InitSubpackage as Subpackage
 import Test.Spec (Spec)
 import Test.Spec as Spec
 import Test.Spec.Assertions as Assert
@@ -25,3 +26,5 @@ spec = Spec.around withTempDir do
     Spec.it "should use user-specified tag if it exists instead of latest release" \({ spago, fixture } :: TestDirs) -> do
       spago [ "init", "--package-set", "9.0.0", "--name", "7368613235362d47665357393342584955783641314b70674c" ] >>= shouldBeSuccess
       checkFixture "spago.yaml" (fixture "older-package-set-tag.yaml")
+
+    Subpackage.spec