New 'spago init --subpackage foo' option to initialize a sub-project …

…within current workspace (#1279)

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,6 +7,7 @@ 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
 
 flagMaybe ∷ ∀ (a ∷ Type). a -> Mod FlagFields (Maybe a) -> Parser (Maybe a)
@@ -178,8 +179,8 @@ transitive =
         <> O.help "Include transitive dependencies"
     )
 
-pure :: Parser Boolean
-pure =
+pureLockfile :: Parser Boolean
+pureLockfile =
   O.switch
     ( O.long "pure"
         <> O.help "Use the package information from the current lockfile, even if it is out of date"
@@ -301,6 +302,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 <$> { packageName: _ } <$> subpackageName)
+    <|> (Init.InitWorkspace <$> { packageName: _ } <$> maybePackageName)
+    <|> pure (Init.InitWorkspace { packageName: 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,10 @@ 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
 
 type GlobalArgs =
   { noColor :: Boolean
@@ -70,7 +66,7 @@ type GlobalArgs =
 
 type InitArgs =
   { setVersion :: Maybe String
-  , name :: Maybe String
+  , mode :: Init.InitMode
   , useSolver :: Boolean
   }
 
@@ -296,7 +292,7 @@ initArgsParser :: Parser InitArgs
 initArgsParser =
   Optparse.fromRecord
     { setVersion: Flags.maybeSetVersion
-    , name: Flags.maybePackageName
+    , mode: Flags.initMode
     , useSolver: Flags.useSolver
     }
 
@@ -307,7 +303,7 @@ fetchArgsParser =
     , selectedPackage: Flags.selectedPackage
     , ensureRanges: Flags.ensureRanges
     , testDeps: Flags.testDeps
-    , pure: Flags.pure
+    , pure: Flags.pureLockfile
     }
 
 sourcesArgsParser :: Parser SourcesArgs
@@ -328,7 +324,7 @@ installArgsParser =
     , pedanticPackages: Flags.pedanticPackages
     , ensureRanges: Flags.ensureRanges
     , testDeps: Flags.testDeps
-    , pure: Flags.pure
+    , pure: Flags.pureLockfile
     }
 
 uninstallArgsParser :: Parser UninstallArgs
@@ -350,7 +346,7 @@ buildArgsParser = Optparse.fromRecord
   , jsonErrors: Flags.jsonErrors
   , strict: Flags.strict
   , statVerbosity: Flags.statVerbosity
-  , pure: Flags.pure
+  , pure: Flags.pureLockfile
   }
 
 replArgsParser :: Parser ReplArgs
@@ -372,7 +368,7 @@ runArgsParser = Optparse.fromRecord
   , ensureRanges: Flags.ensureRanges
   , strict: Flags.strict
   , statVerbosity: Flags.statVerbosity
-  , pure: Flags.pure
+  , pure: Flags.pureLockfile
   }
 
 upgradeArgsParser :: Parser UpgradeArgs
@@ -391,7 +387,7 @@ testArgsParser = Optparse.fromRecord
   , pedanticPackages: Flags.pedanticPackages
   , strict: Flags.strict
   , statVerbosity: Flags.statVerbosity
-  , pure: Flags.pure
+  , pure: Flags.pureLockfile
   }
 
 bundleArgsParser :: Parser BundleArgs
@@ -413,7 +409,7 @@ bundleArgsParser =
     , ensureRanges: Flags.ensureRanges
     , strict: Flags.strict
     , statVerbosity: Flags.statVerbosity
-    , pure: Flags.pure
+    , pure: Flags.pureLockfile
     }
 
 publishArgsParser :: Parser PublishArgs
@@ -489,15 +485,15 @@ lsPathsArgsParser = Optparse.fromRecord
 lsPackagesArgsParser :: Parser LsPackagesArgs
 lsPackagesArgsParser = Optparse.fromRecord
   { json: Flags.json
-  , pure: Flags.pure
+  , pure: Flags.pureLockfile
   }
 
 lsDepsArgsParser :: Parser LsDepsArgs
 lsDepsArgsParser = Optparse.fromRecord
   { json: Flags.json
   , transitive: Flags.transitive
   , selectedPackage: Flags.selectedPackage
-  , pure: Flags.pure
+  , pure: Flags.pureLockfile
   }
 
 data Cmd a = Cmd'SpagoCmd (SpagoCmd a) | Cmd'VersionCmd Boolean
@@ -547,24 +543,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 +602,7 @@ main = do
                 env <- mkRegistryEnv offline
                 void $ runSpago env $ Init.run
                   { setVersion: Nothing
-                  , packageName: UnsafeCoerce.unsafeCoerce "repl"
+                  , mode: Init.InitWorkspace { packageName: Just "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,79 @@ 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 { packageName :: Maybe String }
+  | InitSubpackage { packageName :: 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 +102,46 @@ run opts = do
       true -> logInfo $ foundExistingFile dest
       false -> FS.writeTextFile dest srcTemplate
 
+  getPackageName :: Spago (RegistryEnv a) PackageName
+  getPackageName = do
+    let
+      candidateName = case opts.mode of
+        InitWorkspace { packageName: Nothing } -> String.take 150 $ Path.basename Paths.cwd
+        InitWorkspace { packageName: Just n } -> n
+        InitSubpackage { packageName: 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 :: Version -> Spago (RegistryEnv a) (Maybe { setVersion :: Maybe Version })
+  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 -> Spago (RegistryEnv a) FilePath
+  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 +289,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`