@@ -2,6 +2,7 @@ module Spago.Command.Init
22 ( DefaultConfigOptions (..)
33 , DefaultConfigPackageOptions
44 , DefaultConfigWorkspaceOptions
5+ , InitMode (..)
56 , InitOptions
67 , defaultConfig
78 , defaultConfig'
@@ -14,65 +15,79 @@ module Spago.Command.Init
1415import Spago.Prelude
1516
1617import Data.Map as Map
18+ import Data.String as String
1719import Node.Path as Path
1820import Registry.PackageName as PackageName
1921import Registry.Version as Version
2022import Spago.Config (Dependencies (..), SetAddress (..), Config )
2123import Spago.Config as Config
2224import Spago.FS as FS
25+ import Spago.Log as Log
26+ import Spago.Paths as Paths
2327import Spago.Registry (RegistryEnv )
2428import Spago.Registry as Registry
2529
30+ data InitMode
31+ = InitWorkspace { packageName :: Maybe String }
32+ | InitSubpackage { packageName :: String }
33+
2634type InitOptions =
2735 -- TODO: we should allow the `--package-set` flag to alternatively pass in a URL
2836 { setVersion :: Maybe Version
29- , packageName :: PackageName
37+ , mode :: InitMode
3038 , useSolver :: Boolean
3139 }
3240
3341-- TODO run git init? Is that desirable?
3442
3543run :: ∀ a . InitOptions -> Spago (RegistryEnv a ) Config
3644run opts = do
37- logInfo " Initializing a new project..."
38-
3945 -- Use the specified version of the package set (if specified).
4046 -- Otherwise, get the latest version of the package set for the given compiler
4147 packageSetVersion <- Registry .findPackageSet opts.setVersion
4248
49+ packageName <- getPackageName
50+ withWorkspace <- getWithWorkspace packageSetVersion
51+ projectDir <- getProjectDir packageName
52+
4353 { purs } <- ask
54+ logInfo " Initializing a new project..."
4455 logInfo $ " Found PureScript " Version .print purs.version <> " , will use package set " Version .print packageSetVersion
4556
46- -- Write config
4757 let
48- config = defaultConfig
49- { name: opts.packageName
50- , withWorkspace: Just
51- { setVersion: case opts.useSolver of
52- true -> Nothing
53- false -> Just packageSetVersion
54- }
55- , testModuleName: " Test.Main"
56- }
57- let configPath = " spago.yaml"
58+ mainModuleName = " Main"
59+ testModuleName = " Test.Main"
60+ srcDir = Path .concat [ projectDir, " src"
61+ testDir = Path .concat [ projectDir, " test"
62+ configPath = Path .concat [ projectDir, " spago.yaml"
63+ config = defaultConfig { name: packageName, withWorkspace, testModuleName }
64+
65+ -- Write config
5866 (FS .exists configPath) >>= case _ of
5967 true -> logInfo $ foundExistingProject configPath
6068 false -> liftAff $ FS .writeYamlFile Config .configCodec configPath config
6169
6270 -- If these directories (or files) exist, we skip copying "sample sources"
6371 -- Because you might want to just init a project with your own source files,
6472 -- or just migrate a psc-package project
65- let mainModuleName = " Main"
66- whenDirNotExists " src" do
67- copyIfNotExists (" src" Path .sep <> mainModuleName <> " .purs"
73+ whenDirNotExists srcDir do
74+ copyIfNotExists (Path .concat [ srcDir, mainModuleName <> " .purs"
6875
69- whenDirNotExists " test " do
70- FS .mkdirp (Path .concat [ " test " " Test"
71- copyIfNotExists (Path .concat [ " test " " Test" " Main.purs" " Test.Main "
76+ whenDirNotExists testDir $ do
77+ FS .mkdirp (Path .concat [ testDir , " Test"
78+ copyIfNotExists (Path .concat [ testDir , " Test" " Main.purs" testModuleName )
7279
73- copyIfNotExists " .gitignore"
80+ case opts.mode of
81+ InitWorkspace _ -> do
82+ copyIfNotExists " .gitignore"
83+ copyIfNotExists pursReplFile.name pursReplFile.content
84+ InitSubpackage _ ->
85+ pure unit
7486
75- copyIfNotExists pursReplFile.name pursReplFile.content
87+ logInfo " Set up a new Spago project."
88+ case opts.mode of
89+ InitWorkspace _ -> logInfo " Try running `spago run`"
90+ InitSubpackage _ -> logInfo $ " Try running `spago run -p " PackageName .print packageName <> " `"
7691
7792 pure config
7893
@@ -87,6 +102,46 @@ run opts = do
87102 true -> logInfo $ foundExistingFile dest
88103 false -> FS .writeTextFile dest srcTemplate
89104
105+ getPackageName :: Spago (RegistryEnv a ) PackageName
106+ getPackageName = do
107+ let
108+ candidateName = case opts.mode of
109+ InitWorkspace { packageName: Nothing } -> String .take 150 Path .basename Paths .cwd
110+ InitWorkspace { packageName: Just n } -> n
111+ InitSubpackage { packageName: n } -> n
112+ logDebug [ show Paths .cwd, show candidateName ]
113+ pname <- case PackageName .parse (PackageName .stripPureScriptPrefix candidateName) of
114+ Left err -> die
115+ [ toDoc " Could not figure out a name for the new package. Error:"
116+ , Log .break
117+ , Log .indent2 $ toDoc err
118+ ]
119+ Right p -> pure p
120+ logDebug [ " Got packageName and setVersion:" PackageName .print pname, unsafeStringify opts.setVersion ]
121+ pure pname
122+
123+ getWithWorkspace :: Version -> Spago (RegistryEnv a ) (Maybe { setVersion :: Maybe Version } )
124+ getWithWorkspace setVersion = case opts.mode of
125+ InitWorkspace _ ->
126+ pure $ Just
127+ { setVersion: case opts.useSolver of
128+ true -> Nothing
129+ false -> Just setVersion
130+ }
131+ InitSubpackage _ -> do
132+ when (isJust opts.setVersion || opts.useSolver) do
133+ logWarn " The --package-set and --use-solver flags are ignored when initializing a subpackage"
134+ pure Nothing
135+
136+ getProjectDir :: PackageName -> Spago (RegistryEnv a ) FilePath
137+ getProjectDir packageName = case opts.mode of
138+ InitWorkspace _ ->
139+ pure " ."
140+ InitSubpackage _ -> do
141+ let dirPath = PackageName .print packageName
142+ unlessM (FS .exists dirPath) $ FS .mkdirp dirPath
143+ pure dirPath
144+
90145-- TEMPLATES -------------------------------------------------------------------
91146
92147type TemplateConfig =
@@ -234,10 +289,10 @@ pursReplFile = { name: ".purs-repl", content: "import Prelude\n" }
234289-- ERROR TEXTS -----------------------------------------------------------------
235290
236291foundExistingProject :: FilePath -> String
237- foundExistingProject path = " Found a " show path <> " file, skipping copy."
292+ foundExistingProject path = " Found a \" " " \ ""
238293
239294foundExistingDirectory :: FilePath -> String
240- foundExistingDirectory dir = " Found existing directory " show dir <> " , skipping copy of sample sources"
295+ foundExistingDirectory dir = " Found existing directory \" " " \ ""
241296
242297foundExistingFile :: FilePath -> String
243- foundExistingFile file = " Found existing file " show file <> " , not overwriting it"
298+ foundExistingFile file = " Found existing file \" " " \ ""
0 commit comments