From 555cd27cc1789c22ddc5e359a84432b0f3df1c36 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 13:23:16 -0700 Subject: [PATCH 01/32] Change template spago.dhall to multi-target format --- templates/spago.dhall | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/templates/spago.dhall b/templates/spago.dhall index 2e0e6dcf8..9372b0db4 100644 --- a/templates/spago.dhall +++ b/templates/spago.dhall @@ -10,8 +10,20 @@ When creating a new Spago project, you can use `spago init --no-comments` or `spago init -C` to generate this file without the comments in this block. -} -{ name = "my-project" -, dependencies = [ "console", "effect", "prelude", "psci-support" ] -, packages = ./packages.dhall -, sources = [ "src/**/*.purs", "test/**/*.purs" ] -} +let main = + { dependencies = [ "console", "effect", "prelude", "psci-support" ] + , sources = [ "src/**/*.purs" ] + } +let test = + { dependencies = main.dependencies # [ "spec" ] + , sources = main.sources # [ "test/**/*.purs" ] + } + +in + { name = "my-project" + , packages = ./packages.dhall + , targets = + { main = main + , test = test + } + } From f89ee67e040a9d6556e4d545e040e6b5f9c59423 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 15:37:33 -0700 Subject: [PATCH 02/32] Define types: Target and TargetName --- src/Spago/Types.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Spago/Types.hs b/src/Spago/Types.hs index 4d27d0d41..bf76e92f5 100644 --- a/src/Spago/Types.hs +++ b/src/Spago/Types.hs @@ -192,6 +192,14 @@ data Config = Config , publishConfig :: Either (Dhall.ReadError Void) PublishConfig } deriving (Show, Generic) +newtype TargetName = TargetName { targetName :: Text } + deriving (Show, Read, Data) + deriving newtype (Eq, Ord, ToJSON, FromJSON, ToJSONKey, FromJSONKey, Dhall.FromDhall) + +data Target = Target + { targetDependencies :: [PackageName] + , targetSourcePaths :: [SourcePath] + } deriving (Show, Generic) -- | The extra fields that are only needed for publishing libraries. data PublishConfig = PublishConfig From 50c60370475822b8d444737cfed7e8dda0018225 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 15:38:02 -0700 Subject: [PATCH 03/32] Define common target names --- spago.cabal | 1 + src/Spago/Targets.hs | 15 +++++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 src/Spago/Targets.hs diff --git a/spago.cabal b/spago.cabal index 7a400268b..59df8c052 100644 --- a/spago.cabal +++ b/spago.cabal @@ -106,6 +106,7 @@ library Spago.PscPackage Spago.Purs Spago.RunEnv + Spago.Targets Spago.Templates Spago.TH Spago.Types diff --git a/src/Spago/Targets.hs b/src/Spago/Targets.hs new file mode 100644 index 000000000..2917e37cf --- /dev/null +++ b/src/Spago/Targets.hs @@ -0,0 +1,15 @@ +module Spago.Targets where + +import Spago.Types + +mainTarget :: TargetName +mainTarget = TargetName "main" + +testTarget :: TargetName +testTarget = TargetName "test" + +examplesTarget :: TargetName +examplesTarget = TargetName "examples" + +benchmarkTarget :: TargetName +benchmarkTarget = TargetName "benchmark" From f1e6147351f5543bac55157825ebd1890fc03fb2 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 20:30:57 -0700 Subject: [PATCH 04/32] Make Config have targets, update Dhall parsing --- src/Spago/Config.hs | 24 +++++++++++++++++++++++- src/Spago/Dhall.hs | 9 +++++++++ src/Spago/Messages.hs | 9 +++++++++ src/Spago/Types.hs | 1 + 4 files changed, 42 insertions(+), 1 deletion(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 0f87296c8..bac313902 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -33,6 +33,7 @@ import qualified Spago.Dhall as Dhall import qualified Spago.Messages as Messages import qualified Spago.PackageSet as PackageSet import qualified Spago.PscPackage as PscPackage +import qualified Spago.Targets as Targets import qualified Spago.Templates as Templates @@ -61,6 +62,9 @@ dependenciesType :: Dhall.Decoder [PackageName] dependenciesType = Dhall.list (Dhall.auto :: Dhall.Decoder PackageName) +sourcesType :: Dhall.Decoder [SourcePath] +sourcesType = Dhall.list (Dhall.auto :: Dhall.Decoder SourcePath) + parsePackage :: (MonadIO m, MonadThrow m, MonadReader env m, HasLogFunc env) => ResolvedExpr -> m Package parsePackage (Dhall.RecordLit ks') = do let ks = Dhall.extractRecordValues ks' @@ -93,6 +97,13 @@ parsePackage (Dhall.App pure Package{..} parsePackage expr = die [ display $ Messages.failedToParsePackage $ pretty expr ] +parseTarget :: (MonadIO m, MonadThrow m, MonadReader env m, HasLogFunc env) => ResolvedExpr -> m Target +parseTarget (Dhall.RecordLit ks') = do + let ks = Dhall.extractRecordValues ks' + targetDependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType + targetSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType + pure Target{..} +parseTarget expr = die [ display $ Messages.failedToParseTarget $ pretty expr ] -- | Parse the contents of a "packages.dhall" file (or the "packages" key of an -- evaluated "spago.dhall") @@ -110,6 +121,14 @@ parsePackageSet pkgs = do pure PackageSet{..} +-- | Parse the contents of the "targets" key of an evaluated "spago.dhall") +parseTargets + :: HasLogFunc env + => Dhall.Map.Map Text (Dhall.DhallExpr Void) + -> RIO env (Map TargetName Target) +parseTargets config = do + fmap (Map.mapKeys TargetName . Dhall.Map.toMap) $ traverse parseTarget config + -- | Tries to read in a Spago Config parseConfig :: (HasLogFunc env, HasConfigPath env) @@ -123,10 +142,12 @@ parseConfig = do case expr of Dhall.RecordLit ks' -> do let ks = Dhall.extractRecordValues ks' - let sourcesType = Dhall.list (Dhall.auto :: Dhall.Decoder SourcePath) name <- Dhall.requireTypedKey ks "name" Dhall.strictText dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType + targets <- Dhall.requireKey ks "targets" (\case + Dhall.RecordLit tgts -> parseTargets (Dhall.extractRecordValues tgts) + something -> throwM $ Dhall.TargetsIsNotRecord something) alternateBackend <- Dhall.maybeTypedKey ks "backend" Dhall.strictText let ensurePublishConfig = do @@ -171,6 +192,7 @@ makeTempConfig -> RIO env Config makeTempConfig dependencies alternateBackend configSourcePaths maybeTag = do PursCmd { compilerVersion } <- view (the @PursCmd) + let targets = Map.singleton Targets.mainTarget (Target { targetDependencies = dependencies, targetSourcePaths = configSourcePaths }) tag <- case maybeTag of Nothing -> PackageSet.getLatestSetForCompilerVersion compilerVersion "purescript" "package-sets" >>= \case diff --git a/src/Spago/Dhall.hs b/src/Spago/Dhall.hs index 6e983c719..89a4a924b 100644 --- a/src/Spago/Dhall.hs +++ b/src/Spago/Dhall.hs @@ -166,6 +166,8 @@ data ReadError a where ConfigIsNotRecord :: Typeable a => DhallExpr a -> ReadError a -- | the "packages" key is not a record PackagesIsNotRecord :: Typeable a => DhallExpr a -> ReadError a + -- | the "targets" key is not a record + TargetsIsNotRecord :: Typeable a => DhallExpr a -> ReadError a -- | the "dependencies" key is not a list DependenciesIsNotList :: Typeable a => DhallExpr a -> ReadError a -- | the expression is not a Text Literal @@ -194,6 +196,13 @@ instance (Pretty a) => Show (ReadError a) where , "" , "↳ " <> pretty tl ] + msg (TargetsIsNotRecord tl) = + [ "Explanation: The \"targets\" key must contain a record of targets." + , "" + , "The value was instead:" + , "" + , "↳ " <> pretty tl + ] msg (DependenciesIsNotList e) = [ "Explanation: The \"dependencies\" key must contain a list of package names." , "" diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index 0a94a6b7f..9b77009ea 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -32,6 +32,15 @@ failedToParsePackage expr = makeMessage , expr ] +failedToParseTarget :: Text -> Text +failedToParseTarget expr = makeMessage + [ "Failed to parse the `targets` key in your spago.dhall file." + , "" + , "Your 'targets' declaration was the following expression:" + , "" + , expr + ] + failedToParseRepoString :: Text -> Text failedToParseRepoString repo = makeMessage [ "ERROR: was not able to parse the address to the remote repo: " <> surroundQuote repo diff --git a/src/Spago/Types.hs b/src/Spago/Types.hs index bf76e92f5..a05803204 100644 --- a/src/Spago/Types.hs +++ b/src/Spago/Types.hs @@ -187,6 +187,7 @@ data Config = Config { name :: Text , dependencies :: [PackageName] , packageSet :: PackageSet + , targets :: Map TargetName Target , alternateBackend :: Maybe Text , configSourcePaths :: [SourcePath] , publishConfig :: Either (Dhall.ReadError Void) PublishConfig From 07c2db9db0644df2b86890f28dc05a70c38dc230 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 20:35:11 -0700 Subject: [PATCH 05/32] Add targetName arg to CLI commands --- app/Spago.hs | 22 +++++++++++----------- src/Spago/CLI.hs | 49 ++++++++++++++++++++++++++---------------------- 2 files changed, 38 insertions(+), 33 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index c881559f4..54cd45b4a 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -53,11 +53,11 @@ main = withUtf8 $ do -> CLI.echo spagoVersion Path whichPath buildOptions -> Path.showPaths buildOptions whichPath - Repl replPackageNames paths pursArgs depsOnly + Repl _ replPackageNames paths pursArgs depsOnly -> Spago.Build.repl replPackageNames paths pursArgs depsOnly - BundleApp modName tPath shouldBuild buildOptions + BundleApp _ modName tPath shouldBuild buildOptions -> Spago.Build.bundleApp WithMain modName tPath shouldBuild buildOptions globalUsePsa - BundleModule modName tPath shouldBuild buildOptions + BundleModule _ modName tPath shouldBuild buildOptions -> Spago.Build.bundleModule modName tPath shouldBuild buildOptions globalUsePsa Script modulePath tag dependencies scriptBuildOptions -> Spago.Build.script modulePath tag dependencies scriptBuildOptions @@ -71,11 +71,11 @@ main = withUtf8 $ do $ Ls.listPackageSet jsonFlag -- ### Commands that need an "install environment": global options and a Config - Install packageNames -> Run.withInstallEnv + Install _ packageNames -> Run.withInstallEnv $ Spago.Packages.install packageNames - ListDeps jsonFlag transitiveFlag -> Run.withInstallEnv + ListDeps _ jsonFlag transitiveFlag -> Run.withInstallEnv $ Ls.listPackages transitiveFlag jsonFlag - Sources -> Run.withInstallEnv + Sources _ -> Run.withInstallEnv $ Spago.Packages.sources -- ### Commands that need a "publish env": install env + git and bower @@ -89,18 +89,18 @@ main = withUtf8 $ do $ Verify.verify checkUniqueModules Nothing -- ### Commands that need a build environment: a config, build options and access to purs - Build buildOptions -> Run.withBuildEnv globalUsePsa buildOptions + Build _ buildOptions -> Run.withBuildEnv globalUsePsa buildOptions $ Spago.Build.build Nothing - Search -> Run.withBuildEnv globalUsePsa defaultBuildOptions + Search _ -> Run.withBuildEnv globalUsePsa defaultBuildOptions $ Spago.Build.search - Docs format sourcePaths depsOnly noSearch openDocs -> + Docs _ format sourcePaths depsOnly noSearch openDocs -> let opts = defaultBuildOptions { depsOnly = depsOnly, sourcePaths = sourcePaths } in Run.withBuildEnv globalUsePsa opts $ Spago.Build.docs format noSearch openDocs - Test modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions + Test _ modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions $ Spago.Build.test modName nodeArgs - Run modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions + Run _ modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions $ Spago.Build.run modName nodeArgs -- ### Legacy commands, here for smoother migration path to new ones diff --git a/src/Spago/CLI.hs b/src/Spago/CLI.hs index eda01025d..316ecf23c 100644 --- a/src/Spago/CLI.hs +++ b/src/Spago/CLI.hs @@ -29,16 +29,16 @@ data Command | Init Force TemplateComments (Maybe Text) -- | Install (download) dependencies defined in spago.dhall - | Install [PackageName] + | Install TargetName [PackageName] -- | Get source globs of dependencies in spago.dhall - | Sources + | Sources TargetName -- | List available packages | ListPackages JsonFlag -- | List dependencies of the project - | ListDeps JsonFlag IncludeTransitive + | ListDeps TargetName JsonFlag IncludeTransitive -- | Bump and tag a new version in preparation for release. | BumpVersion DryRun VersionBump @@ -50,7 +50,7 @@ data Command | Freeze -- | Runs `purescript-docs-search search`. - | Search + | Search TargetName -- | Returns info about paths used by Spago | Path (Maybe PathType) BuildOptions @@ -61,29 +61,29 @@ data Command -- ### Build commands - i.e. they all call Purs at some point -- | Build the project - | Build BuildOptions + | Build TargetName BuildOptions -- | Start a REPL - | Repl [PackageName] [SourcePath] [PursArg] DepsOnly + | Repl TargetName [PackageName] [SourcePath] [PursArg] DepsOnly -- | Generate documentation for the project and its dependencies - | Docs (Maybe DocsFormat) [SourcePath] DepsOnly NoSearch OpenDocs + | Docs TargetName (Maybe DocsFormat) [SourcePath] DepsOnly NoSearch OpenDocs -- | Run the project with some module, default Main - | Run (Maybe ModuleName) BuildOptions [BackendArg] + | Run TargetName (Maybe ModuleName) BuildOptions [BackendArg] -- | Run the selected module as a script, specifying a .purs file, -- | optional package set tag, dependencies | Script Text (Maybe Text) [PackageName] ScriptBuildOptions -- | Test the project with some module, default Test.Main - | Test (Maybe ModuleName) BuildOptions [BackendArg] + | Test TargetName (Maybe ModuleName) BuildOptions [BackendArg] -- | Bundle the project into an executable - | BundleApp (Maybe ModuleName) (Maybe TargetPath) NoBuild BuildOptions + | BundleApp TargetName (Maybe ModuleName) (Maybe TargetPath) NoBuild BuildOptions -- | Bundle a module into a CommonJS module - | BundleModule (Maybe ModuleName) (Maybe TargetPath) NoBuild BuildOptions + | BundleModule TargetName (Maybe ModuleName) (Maybe TargetPath) NoBuild BuildOptions -- | Verify that a single package is consistent with the Package Set | Verify PackageName @@ -154,6 +154,11 @@ parser = do chkModsUniq = bool DoCheckModulesUnique NoCheckModulesUnique <$> CLI.switch "no-check-modules-unique" 'M' "Skip checking whether modules names are unique across all packages." transitive = bool NoIncludeTransitive IncludeTransitive <$> CLI.switch "transitive" 't' "Include transitive dependencies" + mkTargetNameOption val = TargetName <$> Opts.strOption (Opts.long "target" <> Opts.short 'o' <> Opts.help "Which target to use as defined in `spago.dhall`" <> Opts.value val <> Opts.showDefault) + + targetNameDefaultMain = mkTargetNameOption "main" + targetNameDefaultTest = mkTargetNameOption "test" + mainModule = CLI.optional $ CLI.opt (Just . ModuleName) "main" 'm' "Module to be used as the application's entry point" toTarget = CLI.optional $ CLI.opt (Just . TargetPath) "to" 't' "The target file path" docsFormat = CLI.optional $ CLI.opt Purs.parseDocsFormat "format" 'f' "Docs output format (markdown | html | etags | ctags)" @@ -196,13 +201,13 @@ parser = do build = ( "build" , "Install the dependencies and compile the current package" - , Build <$> buildOptions + , Build <$> targetNameDefaultMain <*> buildOptions ) repl = ( "repl" , "Start a REPL" - , Repl <$> dependencyPackageNames <*> sourcePaths <*> pursArgs <*> depsOnly + , Repl <$> targetNameDefaultMain <*> dependencyPackageNames <*> sourcePaths <*> pursArgs <*> depsOnly ) execArgs = (++) <$> backendArgs <*> nodeArgs @@ -210,37 +215,37 @@ parser = do test = ( "test" , "Test the project with some module, default Test.Main" - , Test <$> mainModule <*> buildOptions <*> execArgs + , Test <$> targetNameDefaultTest <*> mainModule <*> buildOptions <*> execArgs ) run = ( "run" , "Runs the project with some module, default Main" - , Run <$> mainModule <*> buildOptions <*> execArgs + , Run <$> targetNameDefaultMain <*> mainModule <*> buildOptions <*> execArgs ) bundleApp = ( "bundle-app" , "Bundle the project into an executable" - , BundleApp <$> mainModule <*> toTarget <*> noBuild <*> buildOptions + , BundleApp <$> targetNameDefaultMain <*> mainModule <*> toTarget <*> noBuild <*> buildOptions ) bundleModule = ( "bundle-module" , "Bundle the project into a CommonJS module" - , BundleModule <$> mainModule <*> toTarget <*> noBuild <*> buildOptions + , BundleModule <$> targetNameDefaultMain <*> mainModule <*> toTarget <*> noBuild <*> buildOptions ) docs = ( "docs" , "Generate docs for the project and its dependencies" - , Docs <$> docsFormat <*> sourcePaths <*> depsOnly <*> noSearch <*> openDocs + , Docs <$> targetNameDefaultMain <*> docsFormat <*> sourcePaths <*> depsOnly <*> noSearch <*> openDocs ) search = ( "search" , "Start a search REPL to find definitions matching names and types" - , pure Search + , Search <$> targetNameDefaultMain ) pathSubcommand @@ -260,7 +265,7 @@ parser = do listDeps = CLI.subcommand "deps" "List dependencies of the project" - (ListDeps <$> jsonFlag <*> transitive) + (ListDeps <$> targetNameDefaultMain <*> jsonFlag <*> transitive) list = ( "ls" @@ -271,13 +276,13 @@ parser = do install = ( "install" , "Install (download) all dependencies listed in spago.dhall" - , Install <$> packageNames + , Install <$> targetNameDefaultMain <*> packageNames ) sources = ( "sources" , "List all the source paths (globs) for the dependencies of the project" - , pure Sources + , Sources <$> targetNameDefaultMain ) verify = From aa58bee3a144d5a7f721ab8c53b82e85e3bc5550 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 14:20:59 -0700 Subject: [PATCH 06/32] Define `HasTarget` alias --- src/Spago/Env.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 8fc9823bf..16977d7f1 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -25,6 +25,7 @@ module Spago.Env , HasConfig , HasGit , HasBower + , HasTarget , HasPurs -- | Other types @@ -57,6 +58,7 @@ type HasPackageSet env = HasType PackageSet env type HasPurs env = HasType PursCmd env type HasGit env = HasType GitCmd env type HasBower env = HasType BowerCmd env +type HasTarget env = HasType Target env type HasEnv env = ( HasLogFunc env From 08463cb6a0fed265861cdcacb0c127c9b25d55f0 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 21:00:37 -0700 Subject: [PATCH 07/32] Update spago repl to support targets --- app/Spago.hs | 4 ++-- src/Spago/Build.hs | 29 ++++++++++++++++++++--------- src/Spago/Env.hs | 10 ++++++++++ src/Spago/Messages.hs | 7 +++++++ src/Spago/Packages.hs | 24 ++++++++++++++++++++++++ src/Spago/RunEnv.hs | 12 ++++++++++++ 6 files changed, 75 insertions(+), 11 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 54cd45b4a..6c8f125d5 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -53,8 +53,8 @@ main = withUtf8 $ do -> CLI.echo spagoVersion Path whichPath buildOptions -> Path.showPaths buildOptions whichPath - Repl _ replPackageNames paths pursArgs depsOnly - -> Spago.Build.repl replPackageNames paths pursArgs depsOnly + Repl targetName replPackageNames paths pursArgs depsOnly + -> Spago.Build.repl targetName replPackageNames paths pursArgs depsOnly BundleApp _ modName tPath shouldBuild buildOptions -> Spago.Build.bundleApp WithMain modName tPath shouldBuild buildOptions globalUsePsa BundleModule _ modName tPath shouldBuild buildOptions diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index c2ce7431f..a54cf56ae 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -197,16 +197,23 @@ build maybePostBuild = do -- | Start a repl repl :: (HasEnv env) - => [PackageName] + => TargetName + -> [PackageName] -> [SourcePath] -> [PursArg] -> Packages.DepsOnly -> RIO env () -repl newPackages sourcePaths pursArgs depsOnly = do +repl tgtName newPackages sourcePaths pursArgs depsOnly = do logDebug "Running `spago repl`" purs <- Run.getPurs NoPsa Config.ensureConfig >>= \case - Right config -> Run.withInstallEnv' (Just config) (replAction purs) + Right config -> do + case Map.lookup tgtName $ targets config of + Just target -> do + logDebug $ "Using target '" <> display (targetName tgtName) <> "'" + Run.withReplEnv config target (replAction purs) + Nothing -> + die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] Left err -> do logDebug err GlobalCache cacheDir _ <- view (the @GlobalCache) @@ -215,16 +222,20 @@ repl newPackages sourcePaths pursArgs depsOnly = do writeTextFile ".purs-repl" Templates.pursRepl - let dependencies = [ PackageName "effect", PackageName "console", PackageName "psci-support" ] <> newPackages + let + dependencies = [ PackageName "effect", PackageName "console", PackageName "psci-support" ] <> newPackages + srcPaths = [] + target = Target { targetDependencies = dependencies, targetSourcePaths = srcPaths } config <- Run.withPursEnv NoPsa $ do - Config.makeTempConfig dependencies Nothing [] Nothing + Config.makeTempConfig dependencies Nothing srcPaths Nothing - Run.withInstallEnv' (Just config) (replAction purs) + Run.withReplEnv config target (replAction purs) where + replAction :: PursCmd -> RIO ReplEnv () replAction purs = do - Config{..} <- view (the @Config) - deps <- Packages.getProjectDeps + Target{ targetSourcePaths } <- view (the @Target) + deps <- Packages.getTransitiveTargetDeps -- we check that psci-support is in the deps, see #550 unless (Set.member (PackageName "psci-support") (Set.fromList (map fst deps))) $ do die @@ -233,7 +244,7 @@ repl newPackages sourcePaths pursArgs depsOnly = do ] let globs = - Packages.getGlobsSourcePaths $ Packages.getGlobs deps depsOnly (configSourcePaths <> sourcePaths) + Packages.getGlobsSourcePaths $ Packages.getGlobs deps depsOnly (targetSourcePaths <> sourcePaths) Fetch.fetchPackages deps runRIO purs $ Purs.repl globs pursArgs diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 16977d7f1..356a9a0d2 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -4,6 +4,7 @@ module Spago.Env GlobalOptions(..) , Env(..) , PackageSetEnv(..) + , ReplEnv(..) , InstallEnv(..) , PublishEnv(..) , VerifyEnv(..) @@ -126,6 +127,15 @@ data VerifyEnv = VerifyEnv , envConfig :: !(Maybe Config) } deriving (Generic) +data ReplEnv = ReplEnv + { envLogFunc :: !LogFunc + , envJobs :: !Jobs + , envConfigPath :: !ConfigPath + , envGlobalCache :: !GlobalCache + , envPackageSet :: !PackageSet + , envTarget :: !Target + } deriving (Generic) + data InstallEnv = InstallEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index 9b77009ea..07b50b0d0 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -64,6 +64,13 @@ cannotFindConfig configPath = makeMessage , "otherwise you might want to run `spago init` to initialize a new project." ] +cannotFindTarget :: Text -> Text +cannotFindTarget targetName = makeMessage + [ "There's no target named " <> surroundQuote targetName <> " in your spago.dhall file" + , "" + , "Did you mispell the name? Does it exist?" + ] + cannotFindPackages :: Text cannotFindPackages = makeMessage [ "There's no " <> surroundQuote "packages.dhall" <> " in your current location." diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 842bcc126..728c58996 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -4,6 +4,8 @@ module Spago.Packages , getGlobs , getGlobsSourcePaths , getJsGlobs + , getDirectTargetDeps + , getTransitiveTargetDeps , getDirectDeps , getProjectDeps , getReverseDeps @@ -57,6 +59,28 @@ getJsGlobs deps depsOnly configSourcePaths <$> configSourcePaths +-- | Return the direct dependencies of the current target +getDirectTargetDeps + :: (HasLogFunc env, HasPackageSet env, HasTarget env) + => RIO env [(PackageName, Package)] +getDirectTargetDeps = do + PackageSet{..} <- view (the @PackageSet) + Target { targetDependencies } <- view (the @Target) + for targetDependencies $ \dep -> + case Map.lookup dep packagesDB of + Nothing -> + die [ display $ pkgNotFoundMsg packagesDB (NotFoundError dep) ] + Just pkg -> + pure (dep, pkg) + +-- | Return the transitive dependencies of the current target +getTransitiveTargetDeps + :: (HasLogFunc env, HasPackageSet env, HasTarget env) + => RIO env [(PackageName, Package)] +getTransitiveTargetDeps = do + Target{ targetDependencies } <- view (the @Target) + getTransitiveDeps targetDependencies + -- | Return the direct dependencies of the current project getDirectDeps :: (HasLogFunc env, HasConfig env) diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index b41d68082..b507ae2d9 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -76,6 +76,18 @@ withPackageSetEnv app = do runRIO PackageSetEnv{..} app +withReplEnv + :: (HasEnv env) + => Config + -> Target + -> RIO ReplEnv a + -> RIO env a +withReplEnv Config{..} target app = do + Env{..} <- getEnv + let envPackageSet = packageSet + envTarget = target + runRIO ReplEnv{..} app + withInstallEnv' :: (HasEnv env) => Maybe Config From 531d6d60784928a8edced0309510429c1aed32d7 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 16:10:01 -0700 Subject: [PATCH 08/32] Update spago sources to use targets --- app/Spago.hs | 4 ++-- src/Spago/Packages.hs | 29 +++++++++++++++++++++-------- 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 6c8f125d5..34664e2af 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -75,8 +75,8 @@ main = withUtf8 $ do $ Spago.Packages.install packageNames ListDeps _ jsonFlag transitiveFlag -> Run.withInstallEnv $ Ls.listPackages transitiveFlag jsonFlag - Sources _ -> Run.withInstallEnv - $ Spago.Packages.sources + Sources targetName -> Run.withInstallEnv + $ Spago.Packages.sources targetName -- ### Commands that need a "publish env": install env + git and bower BumpVersion dryRun spec -> Run.withPublishEnv diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 728c58996..7e2673466 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -25,6 +25,8 @@ import qualified Data.Text as Text import qualified Spago.Config as Config import qualified Spago.FetchPackage as Fetch +import qualified Spago.Messages as Messages +import qualified Spago.Targets as Targets data Globs = Globs @@ -229,13 +231,24 @@ stripPurescriptPrefix (PackageName name) = -- | Get source globs of dependencies listed in `spago.dhall` -sources :: (HasLogFunc env, HasConfig env) => RIO env () -sources = do +sources :: (HasLogFunc env, HasConfig env) => Maybe TargetName -> RIO env () +sources maybeTargetName = do logDebug "Running `spago sources`" + -- Note: we'll use this later when looking up the target + -- from within the config file config <- view (the @Config) - deps <- getProjectDeps - traverse_ output - $ fmap unSourcePath - $ getGlobsSourcePaths - $ getGlobs deps AllSources - $ configSourcePaths config + let + maybeTargetInfo = do + targetName <- maybeTargetName <|> pure Targets.mainTarget + target <- Map.lookup targetName placeholderTargetMap + pure (targetName, target) + case maybeTargetInfo of + Just (name, Target{..}) -> do + logDebug $ "Using target '" <> display (targetName name) <> "'" + deps <- getTransitiveDeps targetDependencies + traverse_ output + $ fmap unSourcePath + $ getGlobsSourcePaths + $ getGlobs deps AllSources targetSourcePaths + Nothing -> + die $ [ display $ Messages.cannotFindTarget (targetName <$> maybeTargetName) (targetName Targets.mainTarget) ] From 54a377d37db3bc037ae43a3eccea7e3e21c34414 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 16:55:46 -0700 Subject: [PATCH 09/32] Updat sources to support targets --- src/Spago/Packages.hs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 7e2673466..766eba86d 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -26,7 +26,6 @@ import qualified Data.Text as Text import qualified Spago.Config as Config import qualified Spago.FetchPackage as Fetch import qualified Spago.Messages as Messages -import qualified Spago.Targets as Targets data Globs = Globs @@ -231,24 +230,17 @@ stripPurescriptPrefix (PackageName name) = -- | Get source globs of dependencies listed in `spago.dhall` -sources :: (HasLogFunc env, HasConfig env) => Maybe TargetName -> RIO env () -sources maybeTargetName = do +sources :: (HasLogFunc env, HasConfig env) => TargetName -> RIO env () +sources tgtName = do logDebug "Running `spago sources`" - -- Note: we'll use this later when looking up the target - -- from within the config file config <- view (the @Config) - let - maybeTargetInfo = do - targetName <- maybeTargetName <|> pure Targets.mainTarget - target <- Map.lookup targetName placeholderTargetMap - pure (targetName, target) - case maybeTargetInfo of - Just (name, Target{..}) -> do - logDebug $ "Using target '" <> display (targetName name) <> "'" + case Map.lookup tgtName (targets config) of + Just Target{..} -> do + logDebug $ "Using target '" <> display (targetName tgtName) <> "'" deps <- getTransitiveDeps targetDependencies traverse_ output $ fmap unSourcePath $ getGlobsSourcePaths $ getGlobs deps AllSources targetSourcePaths Nothing -> - die $ [ display $ Messages.cannotFindTarget (targetName <$> maybeTargetName) (targetName Targets.mainTarget) ] + die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] From c04b21baa6ed833e4054246bf7071755c31173bf Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 21:17:18 -0700 Subject: [PATCH 10/32] Update spago ls to support targets --- app/Spago.hs | 2 +- src/Spago/Command/Ls.hs | 15 +++++++++------ src/Spago/Env.hs | 14 ++++++++++++++ src/Spago/RunEnv.hs | 17 +++++++++++++++++ 4 files changed, 41 insertions(+), 7 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 34664e2af..9f43bd3fa 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -73,7 +73,7 @@ main = withUtf8 $ do -- ### Commands that need an "install environment": global options and a Config Install _ packageNames -> Run.withInstallEnv $ Spago.Packages.install packageNames - ListDeps _ jsonFlag transitiveFlag -> Run.withInstallEnv + ListDeps targetName jsonFlag transitiveFlag -> Run.withLsEnv targetName $ Ls.listPackages transitiveFlag jsonFlag Sources targetName -> Run.withInstallEnv $ Spago.Packages.sources targetName diff --git a/src/Spago/Command/Ls.hs b/src/Spago/Command/Ls.hs index 1aebca2e4..82659a939 100644 --- a/src/Spago/Command/Ls.hs +++ b/src/Spago/Command/Ls.hs @@ -41,19 +41,22 @@ listPackageSet jsonFlag = do traverse_ output $ formatPackageNames jsonFlag (Map.toList packagesDB) listPackages - :: (HasLogFunc env, HasConfig env) - => IncludeTransitive -> JsonFlag + :: (HasLogFunc env, HasConfig env, HasTarget env, HasTargetName env) + => IncludeTransitive + -> JsonFlag -> RIO env () listPackages packagesFilter jsonFlag = do logDebug "Running `listPackages`" + tgtName <- view (the @TargetName) packagesToList :: [(PackageName, Package)] <- case packagesFilter of - IncludeTransitive -> Packages.getProjectDeps + IncludeTransitive -> Packages.getTransitiveTargetDeps _ -> do - Config { packageSet = PackageSet{ packagesDB }, dependencies } <- view (the @Config) - pure $ Map.toList $ Map.restrictKeys packagesDB (Set.fromList dependencies) + Config { packageSet = PackageSet{ packagesDB } } <- view (the @Config) + Target { targetDependencies } <- view (the @Target) + pure $ Map.toList $ Map.restrictKeys packagesDB (Set.fromList targetDependencies) case packagesToList of - [] -> logWarn "There are no dependencies listed in your spago.dhall" + [] -> logWarn $ "There are no dependencies listed in your spago.dhall for the target '" <> display (targetName tgtName) <> "'" _ -> traverse_ output $ formatPackageNames jsonFlag packagesToList formatPackageNames :: JsonFlag -> [(PackageName, Package)] -> [Text] diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 356a9a0d2..89e3fa322 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -5,6 +5,7 @@ module Spago.Env , Env(..) , PackageSetEnv(..) , ReplEnv(..) + , LsEnv(..) , InstallEnv(..) , PublishEnv(..) , VerifyEnv(..) @@ -27,6 +28,7 @@ module Spago.Env , HasGit , HasBower , HasTarget + , HasTargetName , HasPurs -- | Other types @@ -60,6 +62,7 @@ type HasPurs env = HasType PursCmd env type HasGit env = HasType GitCmd env type HasBower env = HasType BowerCmd env type HasTarget env = HasType Target env +type HasTargetName env = HasType TargetName env type HasEnv env = ( HasLogFunc env @@ -136,6 +139,17 @@ data ReplEnv = ReplEnv , envTarget :: !Target } deriving (Generic) +data LsEnv = LsEnv + { envLogFunc :: !LogFunc + , envJobs :: !Jobs + , envConfigPath :: !ConfigPath + , envGlobalCache :: !GlobalCache + , envPackageSet :: !PackageSet + , envConfig :: !Config + , envTarget :: !Target + , envTargetName :: !TargetName + } deriving (Generic) + data InstallEnv = InstallEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index b507ae2d9..224e7c8db 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -8,6 +8,7 @@ import qualified System.Environment as Env import qualified RIO import qualified System.Info import qualified Turtle +import qualified Data.Map as Map import qualified Spago.Config as Config import qualified Spago.GlobalCache as Cache @@ -107,6 +108,22 @@ withInstallEnv -> RIO env a withInstallEnv = withInstallEnv' Nothing +withLsEnv + :: (HasEnv env) + => TargetName + -> RIO LsEnv a + -> RIO env a +withLsEnv tgtName app = do + Env{..} <- getEnv + envConfig@Config{..} <- getConfig + case Map.lookup tgtName targets of + Nothing -> do + die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] + Just envTarget -> do + let envPackageSet = packageSet + envTargetName = tgtName + runRIO LsEnv{..} app + withVerifyEnv :: HasEnv env => UsePsa From 8790f527bced58eb23cb71a46a41043d77166041 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 21:34:33 -0700 Subject: [PATCH 11/32] Refactor process for getting target --- src/Spago/Build.hs | 8 ++------ src/Spago/RunEnv.hs | 20 +++++++++++++------- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index a54cf56ae..91352b077 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -208,12 +208,8 @@ repl tgtName newPackages sourcePaths pursArgs depsOnly = do purs <- Run.getPurs NoPsa Config.ensureConfig >>= \case Right config -> do - case Map.lookup tgtName $ targets config of - Just target -> do - logDebug $ "Using target '" <> display (targetName tgtName) <> "'" - Run.withReplEnv config target (replAction purs) - Nothing -> - die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] + target <- Run.getTarget tgtName (targets config) + Run.withReplEnv config target (replAction purs) Left err -> do logDebug err GlobalCache cacheDir _ <- view (the @GlobalCache) diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index 224e7c8db..4ea465829 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -116,13 +116,10 @@ withLsEnv withLsEnv tgtName app = do Env{..} <- getEnv envConfig@Config{..} <- getConfig - case Map.lookup tgtName targets of - Nothing -> do - die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] - Just envTarget -> do - let envPackageSet = packageSet - envTargetName = tgtName - runRIO LsEnv{..} app + envTarget <- getTarget tgtName targets + let envPackageSet = packageSet + envTargetName = tgtName + runRIO LsEnv{..} app withVerifyEnv :: HasEnv env @@ -206,6 +203,15 @@ getConfig = Config.ensureConfig >>= \case Right c -> pure c Left err -> die [ "Failed to read the config. Error was:", err ] +getTarget :: (HasLogFunc env) => TargetName -> Map TargetName Target -> RIO env Target +getTarget tgtName targets = do + logDebug $ "Using target '" <> display (targetName tgtName) <> "'" + case Map.lookup tgtName targets of + Nothing -> do + die [ display $ Messages.cannotFindTarget (targetName tgtName) ] + Just target -> do + pure target + getPurs :: HasLogFunc env => UsePsa -> RIO env PursCmd getPurs usePsa = do purs <- findExecutableOrDie "purs" From c83e213e8fa28e79e1f2eb6ba3cfc89738dbcc48 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 21:36:21 -0700 Subject: [PATCH 12/32] Refactor LsEnv to InstallEnv2 --- app/Spago.hs | 6 +++--- src/Spago/Env.hs | 4 ++-- src/Spago/Packages.hs | 22 ++++++++-------------- src/Spago/RunEnv.hs | 8 ++++---- 4 files changed, 17 insertions(+), 23 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 9f43bd3fa..c507459d4 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -73,10 +73,10 @@ main = withUtf8 $ do -- ### Commands that need an "install environment": global options and a Config Install _ packageNames -> Run.withInstallEnv $ Spago.Packages.install packageNames - ListDeps targetName jsonFlag transitiveFlag -> Run.withLsEnv targetName + ListDeps targetName jsonFlag transitiveFlag -> Run.withInstallEnv2 targetName $ Ls.listPackages transitiveFlag jsonFlag - Sources targetName -> Run.withInstallEnv - $ Spago.Packages.sources targetName + Sources targetName -> Run.withInstallEnv2 targetName + $ Spago.Packages.sources -- ### Commands that need a "publish env": install env + git and bower BumpVersion dryRun spec -> Run.withPublishEnv diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 89e3fa322..239a31d65 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -5,7 +5,7 @@ module Spago.Env , Env(..) , PackageSetEnv(..) , ReplEnv(..) - , LsEnv(..) + , InstallEnv2(..) , InstallEnv(..) , PublishEnv(..) , VerifyEnv(..) @@ -139,7 +139,7 @@ data ReplEnv = ReplEnv , envTarget :: !Target } deriving (Generic) -data LsEnv = LsEnv +data InstallEnv2 = InstallEnv2 { envLogFunc :: !LogFunc , envJobs :: !Jobs , envConfigPath :: !ConfigPath diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 766eba86d..3221914b3 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -25,7 +25,6 @@ import qualified Data.Text as Text import qualified Spago.Config as Config import qualified Spago.FetchPackage as Fetch -import qualified Spago.Messages as Messages data Globs = Globs @@ -230,17 +229,12 @@ stripPurescriptPrefix (PackageName name) = -- | Get source globs of dependencies listed in `spago.dhall` -sources :: (HasLogFunc env, HasConfig env) => TargetName -> RIO env () -sources tgtName = do +sources :: (HasLogFunc env, HasConfig env, HasTarget env) => RIO env () +sources = do logDebug "Running `spago sources`" - config <- view (the @Config) - case Map.lookup tgtName (targets config) of - Just Target{..} -> do - logDebug $ "Using target '" <> display (targetName tgtName) <> "'" - deps <- getTransitiveDeps targetDependencies - traverse_ output - $ fmap unSourcePath - $ getGlobsSourcePaths - $ getGlobs deps AllSources targetSourcePaths - Nothing -> - die $ [ display $ Messages.cannotFindTarget (targetName tgtName) ] + Target{..} <- view (the @Target) + deps <- getTransitiveDeps targetDependencies + traverse_ output + $ fmap unSourcePath + $ getGlobsSourcePaths + $ getGlobs deps AllSources targetSourcePaths diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index 4ea465829..f77fb1cab 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -108,18 +108,18 @@ withInstallEnv -> RIO env a withInstallEnv = withInstallEnv' Nothing -withLsEnv +withInstallEnv2 :: (HasEnv env) => TargetName - -> RIO LsEnv a + -> RIO InstallEnv2 a -> RIO env a -withLsEnv tgtName app = do +withInstallEnv2 tgtName app = do Env{..} <- getEnv envConfig@Config{..} <- getConfig envTarget <- getTarget tgtName targets let envPackageSet = packageSet envTargetName = tgtName - runRIO LsEnv{..} app + runRIO InstallEnv2{..} app withVerifyEnv :: HasEnv env From a2d255743ff6e5497a306ec1242c8749b536998c Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Sat, 14 Aug 2021 21:46:25 -0700 Subject: [PATCH 13/32] Update install to support targets --- app/Spago.hs | 2 +- src/Spago/Packages.hs | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index c507459d4..fceae4999 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -71,7 +71,7 @@ main = withUtf8 $ do $ Ls.listPackageSet jsonFlag -- ### Commands that need an "install environment": global options and a Config - Install _ packageNames -> Run.withInstallEnv + Install targetName packageNames -> Run.withInstallEnv2 targetName $ Spago.Packages.install packageNames ListDeps targetName jsonFlag transitiveFlag -> Run.withInstallEnv2 targetName $ Ls.listPackages transitiveFlag jsonFlag diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 3221914b3..47b425d0b 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -170,18 +170,25 @@ getReverseDeps dep = do -- | Fetch all dependencies into `.spago/` -install :: (HasEnv env, HasConfig env) => [PackageName] -> RIO env () +install :: (HasEnv env, HasConfig env, HasTarget env, HasTargetName env) => [PackageName] -> RIO env () install newPackages = do logDebug "Running `spago install`" config@Config{ packageSet = PackageSet{..}, ..} <- view (the @Config) + tgtName <- view (the @TargetName) + target@Target{..} <- view (the @Target) existingNewPackages <- reportMissingPackages $ classifyPackages packagesDB newPackages -- Try fetching the dependencies with the new names too - let newConfig :: Config - newConfig = config { Config.dependencies = dependencies <> existingNewPackages } + let + newTarget = target { targetDependencies = targetDependencies <> existingNewPackages } + newConfig :: Config + newConfig = config + { Config.dependencies = dependencies <> existingNewPackages + , Config.targets = Map.adjust (const newTarget) tgtName targets + } mapRIO (set (the @Config) newConfig) $ do - deps <- getProjectDeps + deps <- getTransitiveTargetDeps -- If the above doesn't fail, write the new packages to the config -- Also skip the write if there are no new packages to be written From f869dd5769c92e038ab860881b98759ae5bceeca Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 07:11:16 -0700 Subject: [PATCH 14/32] Support targets for build, run, test, bundle-* --- app/Spago.hs | 14 +++++++------- src/Spago/Build.hs | 32 ++++++++++++++++++-------------- src/Spago/Env.hs | 28 ++++++++++++++++++++++++++++ src/Spago/RunEnv.hs | 33 +++++++++++++++++++++++++++++++++ 4 files changed, 86 insertions(+), 21 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index fceae4999..24312c59d 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -55,10 +55,10 @@ main = withUtf8 $ do -> Path.showPaths buildOptions whichPath Repl targetName replPackageNames paths pursArgs depsOnly -> Spago.Build.repl targetName replPackageNames paths pursArgs depsOnly - BundleApp _ modName tPath shouldBuild buildOptions - -> Spago.Build.bundleApp WithMain modName tPath shouldBuild buildOptions globalUsePsa - BundleModule _ modName tPath shouldBuild buildOptions - -> Spago.Build.bundleModule modName tPath shouldBuild buildOptions globalUsePsa + BundleApp targetName modName tPath shouldBuild buildOptions + -> Spago.Build.bundleApp targetName WithMain modName tPath shouldBuild buildOptions globalUsePsa + BundleModule targetName modName tPath shouldBuild buildOptions + -> Spago.Build.bundleModule targetName modName tPath shouldBuild buildOptions globalUsePsa Script modulePath tag dependencies scriptBuildOptions -> Spago.Build.script modulePath tag dependencies scriptBuildOptions @@ -89,7 +89,7 @@ main = withUtf8 $ do $ Verify.verify checkUniqueModules Nothing -- ### Commands that need a build environment: a config, build options and access to purs - Build _ buildOptions -> Run.withBuildEnv globalUsePsa buildOptions + Build targetName buildOptions -> Run.withBuildEnv2 targetName globalUsePsa buildOptions $ Spago.Build.build Nothing Search _ -> Run.withBuildEnv globalUsePsa defaultBuildOptions $ Spago.Build.search @@ -98,9 +98,9 @@ main = withUtf8 $ do opts = defaultBuildOptions { depsOnly = depsOnly, sourcePaths = sourcePaths } in Run.withBuildEnv globalUsePsa opts $ Spago.Build.docs format noSearch openDocs - Test _ modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions + Test targetName modName buildOptions nodeArgs -> Run.withBuildEnv2 targetName globalUsePsa buildOptions $ Spago.Build.test modName nodeArgs - Run _ modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions + Run targetName modName buildOptions nodeArgs -> Run.withBuildEnv2 targetName globalUsePsa buildOptions $ Spago.Build.run modName nodeArgs -- ### Legacy commands, here for smoother migration path to new ones diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index 91352b077..53861c8c2 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -35,6 +35,7 @@ import qualified Spago.FetchPackage as Fetch import qualified Spago.Messages as Messages import qualified Spago.Packages as Packages import qualified Spago.Purs as Purs +import qualified Spago.Targets as Targets import qualified Spago.Templates as Templates import qualified Spago.Watch as Watch @@ -49,15 +50,16 @@ prepareBundleDefaults maybeModuleName maybeTargetPath = (moduleName, targetPath) targetPath = fromMaybe (TargetPath "index.js") maybeTargetPath -- eventually running some other action after the build -build :: HasBuildEnv env => Maybe (RIO Env ()) -> RIO env () +build :: HasBuildEnv2 env => Maybe (RIO Env ()) -> RIO env () build maybePostBuild = do logDebug "Running `spago build`" BuildOptions{..} <- view (the @BuildOptions) Config{..} <- view (the @Config) - deps <- Packages.getProjectDeps - let partitionedGlobs@(Packages.Globs{..}) = Packages.getGlobs deps depsOnly configSourcePaths + Target{..} <- view (the @Target) + deps <- Packages.getTransitiveTargetDeps + let partitionedGlobs@(Packages.Globs{..}) = Packages.getGlobs deps depsOnly targetSourcePaths allPsGlobs = Packages.getGlobsSourcePaths partitionedGlobs <> sourcePaths - allJsGlobs = Packages.getJsGlobs deps depsOnly configSourcePaths <> sourcePaths + allJsGlobs = Packages.getJsGlobs deps depsOnly targetSourcePaths <> sourcePaths checkImports = do maybeGraph <- view (the @Graph) @@ -247,7 +249,7 @@ repl tgtName newPackages sourcePaths pursArgs depsOnly = do -- | Test the project: compile and run "Test.Main" -- (or the provided module name) with node -test :: HasBuildEnv env => Maybe ModuleName -> [BackendArg] -> RIO env () +test :: HasBuildEnv2 env => Maybe ModuleName -> [BackendArg] -> RIO env () test maybeModuleName extraArgs = do logDebug "Running `Spago.Build.test`" let moduleName = fromMaybe (ModuleName "Test.Main") maybeModuleName @@ -265,7 +267,7 @@ test maybeModuleName extraArgs = do -- | Run the project: compile and run "Main" -- (or the provided module name) with node -run :: HasBuildEnv env => Maybe ModuleName -> [BackendArg] -> RIO env () +run :: HasBuildEnv2 env => Maybe ModuleName -> [BackendArg] -> RIO env () run maybeModuleName extraArgs = do Config.Config { alternateBackend } <- view (the @Config) let moduleName = fromMaybe (ModuleName "Main") maybeModuleName @@ -311,7 +313,7 @@ script modulePath tag packageDeps opts = do let runDirs :: RunDirectories runDirs = RunDirectories scriptDirPath currentDir - Run.withBuildEnv' (Just config) NoPsa buildOpts (runAction runDirs) + Run.withBuildEnv2' Targets.mainTarget (Just config) NoPsa buildOpts (runAction runDirs) where buildOpts = fromScriptOptions defaultBuildOptions opts runAction dirs = runBackend Nothing dirs (ModuleName "Main") Nothing "Script failed to run; " [] @@ -322,7 +324,7 @@ data RunDirectories = RunDirectories { sourceDir :: FilePath, executeDir :: File -- | Run the project with node (or the chosen alternate backend): -- compile and run the provided ModuleName runBackend - :: HasBuildEnv env + :: HasBuildEnv2 env => Maybe Text -> RunDirectories -> ModuleName @@ -373,30 +375,32 @@ runBackend maybeBackend RunDirectories{ sourceDir, executeDir } moduleName maybe -- | Bundle the project to a js file bundleApp :: HasEnv env - => WithMain + => TargetName + -> WithMain -> Maybe ModuleName -> Maybe TargetPath -> NoBuild -> BuildOptions -> UsePsa -> RIO env () -bundleApp withMain maybeModuleName maybeTargetPath noBuild buildOpts usePsa = +bundleApp tgtName withMain maybeModuleName maybeTargetPath noBuild buildOpts usePsa = let (moduleName, targetPath) = prepareBundleDefaults maybeModuleName maybeTargetPath bundleAction = Purs.bundle withMain (withSourceMap buildOpts) moduleName targetPath in case noBuild of - DoBuild -> Run.withBuildEnv usePsa buildOpts $ build (Just bundleAction) + DoBuild -> Run.withBuildEnv2 tgtName usePsa buildOpts $ build (Just bundleAction) NoBuild -> Run.getEnv >>= (flip runRIO) bundleAction -- | Bundle into a CommonJS module bundleModule :: HasEnv env - => Maybe ModuleName + => TargetName + -> Maybe ModuleName -> Maybe TargetPath -> NoBuild -> BuildOptions -> UsePsa -> RIO env () -bundleModule maybeModuleName maybeTargetPath noBuild buildOpts usePsa = do +bundleModule tgtName maybeModuleName maybeTargetPath noBuild buildOpts usePsa = do logDebug "Running `bundleModule`" let (moduleName, targetPath) = prepareBundleDefaults maybeModuleName maybeTargetPath jsExport = Text.unpack $ "\nmodule.exports = PS[\""<> unModuleName moduleName <> "\"];" @@ -411,7 +415,7 @@ bundleModule maybeModuleName maybeTargetPath noBuild buildOpts usePsa = do Right _ -> logInfo $ display $ "Make module succeeded and output file to " <> unTargetPath targetPath Left (n :: SomeException) -> die [ "Make module failed: " <> repr n ] case noBuild of - DoBuild -> Run.withBuildEnv usePsa buildOpts $ build (Just bundleAction) + DoBuild -> Run.withBuildEnv2 tgtName usePsa buildOpts $ build (Just bundleAction) NoBuild -> Run.getEnv >>= (flip runRIO) bundleAction docsSearchTemplate :: (HasType LogFunc env, HasType PursCmd env) => RIO env Text diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 239a31d65..a5df03e2d 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -9,6 +9,7 @@ module Spago.Env , InstallEnv(..) , PublishEnv(..) , VerifyEnv(..) + , BuildEnv2(..) , BuildEnv(..) , PursEnv(..) @@ -17,6 +18,7 @@ module Spago.Env , HasVerifyEnv , HasPublishEnv , HasBuildEnv + , HasBuildEnv2 , HasPursEnv -- | Simple capabilities @@ -102,6 +104,17 @@ type HasBuildEnv env = , HasBuildOptions env ) +type HasBuildEnv2 env = + ( HasEnv env + , HasPurs env + , HasGit env + , HasConfig env + , HasMaybeGraph env + , HasBuildOptions env + , HasTarget env + , HasTargetName env + ) + type HasPursEnv env = ( HasEnv env , HasPurs env @@ -168,6 +181,21 @@ data PublishEnv = PublishEnv , envBowerCmd :: !BowerCmd } deriving (Generic) +data BuildEnv2 = BuildEnv2 + { envLogFunc :: !LogFunc + , envJobs :: !Jobs + , envConfigPath :: !ConfigPath + , envGlobalCache :: !GlobalCache + , envPursCmd :: !PursCmd + , envGitCmd :: !GitCmd + , envPackageSet :: !PackageSet + , envConfig :: !Config + , envGraph :: !(Maybe ModuleGraph) + , envBuildOptions :: !BuildOptions + , envTarget :: !Target + , envTargetName :: !TargetName + } deriving (Generic) + data BuildEnv = BuildEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index f77fb1cab..0fbe3de34 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -151,6 +151,39 @@ withPublishEnv app = do _ -> findExecutableOrDie "bower" runRIO PublishEnv{..} app +withBuildEnv2' + :: HasEnv env + => TargetName + -> Maybe Config + -> UsePsa + -> BuildOptions + -> RIO BuildEnv2 a + -> RIO env a +withBuildEnv2' tgtName maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = do + Env{..} <- getEnv + envPursCmd <- getPurs usePsa + envConfig@Config{..} <- maybe getConfig pure maybeConfig + envTarget <- getTarget tgtName targets + let envPackageSet = packageSet + let envTargetName = tgtName + deps <- runRIO InstallEnv2{..} $ do + deps <- Packages.getTransitiveTargetDeps + when (noInstall == DoInstall) $ FetchPackage.fetchPackages deps + pure deps + envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envConfig deps) + envGitCmd <- getGit + logDebug "Running in `BuildEnv`" + runRIO BuildEnv2{..} app + +withBuildEnv2 + :: HasEnv env + => TargetName + -> UsePsa + -> BuildOptions + -> RIO BuildEnv2 a + -> RIO env a +withBuildEnv2 tgtName = withBuildEnv2' tgtName Nothing + withBuildEnv' :: HasEnv env => Maybe Config From 4c829ca5d3dee7317ff0e62cdb5d7e548d0b5dac Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 07:13:07 -0700 Subject: [PATCH 15/32] Support targets for search --- app/Spago.hs | 2 +- src/Spago/Build.hs | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 24312c59d..3c1898ad5 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -91,7 +91,7 @@ main = withUtf8 $ do -- ### Commands that need a build environment: a config, build options and access to purs Build targetName buildOptions -> Run.withBuildEnv2 targetName globalUsePsa buildOptions $ Spago.Build.build Nothing - Search _ -> Run.withBuildEnv globalUsePsa defaultBuildOptions + Search targetName -> Run.withBuildEnv2 targetName globalUsePsa defaultBuildOptions $ Spago.Build.search Docs _ format sourcePaths depsOnly noSearch openDocs -> let diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index 53861c8c2..5cb626575 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -473,14 +473,15 @@ docs format noSearch open = do openLink link = liftIO $ Browser.openBrowser (Text.unpack link) -- | Start a search REPL. -search :: HasBuildEnv env => RIO env () +search :: HasBuildEnv2 env => RIO env () search = do Config{..} <- view (the @Config) - deps <- Packages.getProjectDeps + Target{..} <- view (the @Target) + deps <- Packages.getTransitiveTargetDeps logInfo "Building module metadata..." - Purs.compile (Packages.getGlobsSourcePaths (Packages.getGlobs deps Packages.AllSources configSourcePaths)) + Purs.compile (Packages.getGlobsSourcePaths (Packages.getGlobs deps Packages.AllSources targetSourcePaths)) [ PursArg "--codegen" , PursArg "docs" ] From ff1f12e9d79b13b3f203dd250ea1b82de643dc13 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 08:26:58 -0700 Subject: [PATCH 16/32] Support targets for docs --- app/Spago.hs | 4 ++-- src/Spago/Build.hs | 7 ++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 3c1898ad5..53e482185 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -93,10 +93,10 @@ main = withUtf8 $ do $ Spago.Build.build Nothing Search targetName -> Run.withBuildEnv2 targetName globalUsePsa defaultBuildOptions $ Spago.Build.search - Docs _ format sourcePaths depsOnly noSearch openDocs -> + Docs targetName format sourcePaths depsOnly noSearch openDocs -> let opts = defaultBuildOptions { depsOnly = depsOnly, sourcePaths = sourcePaths } - in Run.withBuildEnv globalUsePsa opts + in Run.withBuildEnv2 targetName globalUsePsa opts $ Spago.Build.docs format noSearch openDocs Test targetName modName buildOptions nodeArgs -> Run.withBuildEnv2 targetName globalUsePsa buildOptions $ Spago.Build.test modName nodeArgs diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index 5cb626575..8eb7aaa56 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -430,7 +430,7 @@ docsSearchAppTemplate = ifM (Purs.hasMinPursVersion "0.14.0") -- | Generate docs for the `sourcePaths` and run `purescript-docs-search build-index` to patch them. docs - :: HasBuildEnv env + :: HasBuildEnv2 env => Maybe Purs.DocsFormat -> NoSearch -> OpenDocs @@ -439,9 +439,10 @@ docs format noSearch open = do logDebug "Running `spago docs`" BuildOptions { sourcePaths, depsOnly } <- view (the @BuildOptions) Config{..} <- view (the @Config) - deps <- Packages.getProjectDeps + Target{..} <- view (the @Target) + deps <- Packages.getTransitiveTargetDeps logInfo "Generating documentation for the project. This might take a while..." - Purs.docs docsFormat $ Packages.getGlobsSourcePaths (Packages.getGlobs deps depsOnly configSourcePaths) <> sourcePaths + Purs.docs docsFormat $ Packages.getGlobsSourcePaths (Packages.getGlobs deps depsOnly targetSourcePaths) <> sourcePaths when isHTMLFormat $ do when (noSearch == AddSearch) $ do From 4a608289ace321b27795ad2b677ed961bdebb495 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 07:19:45 -0700 Subject: [PATCH 17/32] Drop '2' suffix on replacement Env; drop old Env --- app/Spago.hs | 16 +++++------ src/Spago/Build.hs | 18 ++++++------ src/Spago/Env.hs | 38 ++----------------------- src/Spago/RunEnv.hs | 68 +++++++-------------------------------------- 4 files changed, 29 insertions(+), 111 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 53e482185..49dea9e0a 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -71,11 +71,11 @@ main = withUtf8 $ do $ Ls.listPackageSet jsonFlag -- ### Commands that need an "install environment": global options and a Config - Install targetName packageNames -> Run.withInstallEnv2 targetName + Install targetName packageNames -> Run.withInstallEnv targetName $ Spago.Packages.install packageNames - ListDeps targetName jsonFlag transitiveFlag -> Run.withInstallEnv2 targetName + ListDeps targetName jsonFlag transitiveFlag -> Run.withInstallEnv targetName $ Ls.listPackages transitiveFlag jsonFlag - Sources targetName -> Run.withInstallEnv2 targetName + Sources targetName -> Run.withInstallEnv targetName $ Spago.Packages.sources -- ### Commands that need a "publish env": install env + git and bower @@ -89,18 +89,18 @@ main = withUtf8 $ do $ Verify.verify checkUniqueModules Nothing -- ### Commands that need a build environment: a config, build options and access to purs - Build targetName buildOptions -> Run.withBuildEnv2 targetName globalUsePsa buildOptions + Build targetName buildOptions -> Run.withBuildEnv targetName globalUsePsa buildOptions $ Spago.Build.build Nothing - Search targetName -> Run.withBuildEnv2 targetName globalUsePsa defaultBuildOptions + Search targetName -> Run.withBuildEnv targetName globalUsePsa defaultBuildOptions $ Spago.Build.search Docs targetName format sourcePaths depsOnly noSearch openDocs -> let opts = defaultBuildOptions { depsOnly = depsOnly, sourcePaths = sourcePaths } - in Run.withBuildEnv2 targetName globalUsePsa opts + in Run.withBuildEnv targetName globalUsePsa opts $ Spago.Build.docs format noSearch openDocs - Test targetName modName buildOptions nodeArgs -> Run.withBuildEnv2 targetName globalUsePsa buildOptions + Test targetName modName buildOptions nodeArgs -> Run.withBuildEnv targetName globalUsePsa buildOptions $ Spago.Build.test modName nodeArgs - Run targetName modName buildOptions nodeArgs -> Run.withBuildEnv2 targetName globalUsePsa buildOptions + Run targetName modName buildOptions nodeArgs -> Run.withBuildEnv targetName globalUsePsa buildOptions $ Spago.Build.run modName nodeArgs -- ### Legacy commands, here for smoother migration path to new ones diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index 8eb7aaa56..8c28f03b3 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -50,7 +50,7 @@ prepareBundleDefaults maybeModuleName maybeTargetPath = (moduleName, targetPath) targetPath = fromMaybe (TargetPath "index.js") maybeTargetPath -- eventually running some other action after the build -build :: HasBuildEnv2 env => Maybe (RIO Env ()) -> RIO env () +build :: HasBuildEnv env => Maybe (RIO Env ()) -> RIO env () build maybePostBuild = do logDebug "Running `spago build`" BuildOptions{..} <- view (the @BuildOptions) @@ -249,7 +249,7 @@ repl tgtName newPackages sourcePaths pursArgs depsOnly = do -- | Test the project: compile and run "Test.Main" -- (or the provided module name) with node -test :: HasBuildEnv2 env => Maybe ModuleName -> [BackendArg] -> RIO env () +test :: HasBuildEnv env => Maybe ModuleName -> [BackendArg] -> RIO env () test maybeModuleName extraArgs = do logDebug "Running `Spago.Build.test`" let moduleName = fromMaybe (ModuleName "Test.Main") maybeModuleName @@ -267,7 +267,7 @@ test maybeModuleName extraArgs = do -- | Run the project: compile and run "Main" -- (or the provided module name) with node -run :: HasBuildEnv2 env => Maybe ModuleName -> [BackendArg] -> RIO env () +run :: HasBuildEnv env => Maybe ModuleName -> [BackendArg] -> RIO env () run maybeModuleName extraArgs = do Config.Config { alternateBackend } <- view (the @Config) let moduleName = fromMaybe (ModuleName "Main") maybeModuleName @@ -313,7 +313,7 @@ script modulePath tag packageDeps opts = do let runDirs :: RunDirectories runDirs = RunDirectories scriptDirPath currentDir - Run.withBuildEnv2' Targets.mainTarget (Just config) NoPsa buildOpts (runAction runDirs) + Run.withBuildEnv' Targets.mainTarget (Just config) NoPsa buildOpts (runAction runDirs) where buildOpts = fromScriptOptions defaultBuildOptions opts runAction dirs = runBackend Nothing dirs (ModuleName "Main") Nothing "Script failed to run; " [] @@ -324,7 +324,7 @@ data RunDirectories = RunDirectories { sourceDir :: FilePath, executeDir :: File -- | Run the project with node (or the chosen alternate backend): -- compile and run the provided ModuleName runBackend - :: HasBuildEnv2 env + :: HasBuildEnv env => Maybe Text -> RunDirectories -> ModuleName @@ -387,7 +387,7 @@ bundleApp tgtName withMain maybeModuleName maybeTargetPath noBuild buildOpts use let (moduleName, targetPath) = prepareBundleDefaults maybeModuleName maybeTargetPath bundleAction = Purs.bundle withMain (withSourceMap buildOpts) moduleName targetPath in case noBuild of - DoBuild -> Run.withBuildEnv2 tgtName usePsa buildOpts $ build (Just bundleAction) + DoBuild -> Run.withBuildEnv tgtName usePsa buildOpts $ build (Just bundleAction) NoBuild -> Run.getEnv >>= (flip runRIO) bundleAction -- | Bundle into a CommonJS module @@ -415,7 +415,7 @@ bundleModule tgtName maybeModuleName maybeTargetPath noBuild buildOpts usePsa = Right _ -> logInfo $ display $ "Make module succeeded and output file to " <> unTargetPath targetPath Left (n :: SomeException) -> die [ "Make module failed: " <> repr n ] case noBuild of - DoBuild -> Run.withBuildEnv2 tgtName usePsa buildOpts $ build (Just bundleAction) + DoBuild -> Run.withBuildEnv tgtName usePsa buildOpts $ build (Just bundleAction) NoBuild -> Run.getEnv >>= (flip runRIO) bundleAction docsSearchTemplate :: (HasType LogFunc env, HasType PursCmd env) => RIO env Text @@ -430,7 +430,7 @@ docsSearchAppTemplate = ifM (Purs.hasMinPursVersion "0.14.0") -- | Generate docs for the `sourcePaths` and run `purescript-docs-search build-index` to patch them. docs - :: HasBuildEnv2 env + :: HasBuildEnv env => Maybe Purs.DocsFormat -> NoSearch -> OpenDocs @@ -474,7 +474,7 @@ docs format noSearch open = do openLink link = liftIO $ Browser.openBrowser (Text.unpack link) -- | Start a search REPL. -search :: HasBuildEnv2 env => RIO env () +search :: HasBuildEnv env => RIO env () search = do Config{..} <- view (the @Config) Target{..} <- view (the @Target) diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index a5df03e2d..26b29f9d0 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -5,11 +5,9 @@ module Spago.Env , Env(..) , PackageSetEnv(..) , ReplEnv(..) - , InstallEnv2(..) , InstallEnv(..) , PublishEnv(..) , VerifyEnv(..) - , BuildEnv2(..) , BuildEnv(..) , PursEnv(..) @@ -18,7 +16,6 @@ module Spago.Env , HasVerifyEnv , HasPublishEnv , HasBuildEnv - , HasBuildEnv2 , HasPursEnv -- | Simple capabilities @@ -96,15 +93,6 @@ type HasPublishEnv env = ) type HasBuildEnv env = - ( HasEnv env - , HasPurs env - , HasGit env - , HasConfig env - , HasMaybeGraph env - , HasBuildOptions env - ) - -type HasBuildEnv2 env = ( HasEnv env , HasPurs env , HasGit env @@ -152,7 +140,7 @@ data ReplEnv = ReplEnv , envTarget :: !Target } deriving (Generic) -data InstallEnv2 = InstallEnv2 +data InstallEnv = InstallEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs , envConfigPath :: !ConfigPath @@ -163,15 +151,6 @@ data InstallEnv2 = InstallEnv2 , envTargetName :: !TargetName } deriving (Generic) -data InstallEnv = InstallEnv - { envLogFunc :: !LogFunc - , envJobs :: !Jobs - , envConfigPath :: !ConfigPath - , envGlobalCache :: !GlobalCache - , envPackageSet :: !PackageSet - , envConfig :: !Config - } deriving (Generic) - data PublishEnv = PublishEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs @@ -181,7 +160,7 @@ data PublishEnv = PublishEnv , envBowerCmd :: !BowerCmd } deriving (Generic) -data BuildEnv2 = BuildEnv2 +data BuildEnv = BuildEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs , envConfigPath :: !ConfigPath @@ -196,19 +175,6 @@ data BuildEnv2 = BuildEnv2 , envTargetName :: !TargetName } deriving (Generic) -data BuildEnv = BuildEnv - { envLogFunc :: !LogFunc - , envJobs :: !Jobs - , envConfigPath :: !ConfigPath - , envGlobalCache :: !GlobalCache - , envPursCmd :: !PursCmd - , envGitCmd :: !GitCmd - , envPackageSet :: !PackageSet - , envConfig :: !Config - , envGraph :: !(Maybe ModuleGraph) - , envBuildOptions :: !BuildOptions - } deriving (Generic) - data PursEnv = PursEnv { envLogFunc :: !LogFunc , envJobs :: !Jobs diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index 0fbe3de34..445367e16 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -89,37 +89,18 @@ withReplEnv Config{..} target app = do envTarget = target runRIO ReplEnv{..} app -withInstallEnv' - :: (HasEnv env) - => Maybe Config - -> RIO InstallEnv a - -> RIO env a -withInstallEnv' maybeConfig app = do - Env{..} <- getEnv - envConfig@Config{..} <- case maybeConfig of - Just c -> pure c - Nothing -> getConfig - let envPackageSet = packageSet - runRIO InstallEnv{..} app - withInstallEnv - :: (HasEnv env) - => RIO InstallEnv a - -> RIO env a -withInstallEnv = withInstallEnv' Nothing - -withInstallEnv2 :: (HasEnv env) => TargetName - -> RIO InstallEnv2 a + -> RIO InstallEnv a -> RIO env a -withInstallEnv2 tgtName app = do +withInstallEnv tgtName app = do Env{..} <- getEnv envConfig@Config{..} <- getConfig envTarget <- getTarget tgtName targets let envPackageSet = packageSet envTargetName = tgtName - runRIO InstallEnv2{..} app + runRIO InstallEnv{..} app withVerifyEnv :: HasEnv env @@ -151,53 +132,23 @@ withPublishEnv app = do _ -> findExecutableOrDie "bower" runRIO PublishEnv{..} app -withBuildEnv2' +withBuildEnv' :: HasEnv env => TargetName -> Maybe Config -> UsePsa -> BuildOptions - -> RIO BuildEnv2 a + -> RIO BuildEnv a -> RIO env a -withBuildEnv2' tgtName maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = do +withBuildEnv' tgtName maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = do Env{..} <- getEnv envPursCmd <- getPurs usePsa envConfig@Config{..} <- maybe getConfig pure maybeConfig envTarget <- getTarget tgtName targets let envPackageSet = packageSet let envTargetName = tgtName - deps <- runRIO InstallEnv2{..} $ do - deps <- Packages.getTransitiveTargetDeps - when (noInstall == DoInstall) $ FetchPackage.fetchPackages deps - pure deps - envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envConfig deps) - envGitCmd <- getGit - logDebug "Running in `BuildEnv`" - runRIO BuildEnv2{..} app - -withBuildEnv2 - :: HasEnv env - => TargetName - -> UsePsa - -> BuildOptions - -> RIO BuildEnv2 a - -> RIO env a -withBuildEnv2 tgtName = withBuildEnv2' tgtName Nothing - -withBuildEnv' - :: HasEnv env - => Maybe Config - -> UsePsa - -> BuildOptions - -> RIO BuildEnv a - -> RIO env a -withBuildEnv' maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = do - Env{..} <- getEnv - envPursCmd <- getPurs usePsa - envConfig@Config{..} <- maybe getConfig pure maybeConfig - let envPackageSet = packageSet deps <- runRIO InstallEnv{..} $ do - deps <- Packages.getProjectDeps + deps <- Packages.getTransitiveTargetDeps when (noInstall == DoInstall) $ FetchPackage.fetchPackages deps pure deps envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envConfig deps) @@ -207,11 +158,12 @@ withBuildEnv' maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = withBuildEnv :: HasEnv env - => UsePsa + => TargetName + -> UsePsa -> BuildOptions -> RIO BuildEnv a -> RIO env a -withBuildEnv = withBuildEnv' Nothing +withBuildEnv tgtName = withBuildEnv' tgtName Nothing withPursEnv :: HasEnv env From 09ae7d1cd1fb165adbb19793a272f585b4393b4e Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 08:45:45 -0700 Subject: [PATCH 18/32] Reduce diff: swap order of args --- src/Spago/Build.hs | 2 +- src/Spago/RunEnv.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index 8c28f03b3..b960b6b5c 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -313,7 +313,7 @@ script modulePath tag packageDeps opts = do let runDirs :: RunDirectories runDirs = RunDirectories scriptDirPath currentDir - Run.withBuildEnv' Targets.mainTarget (Just config) NoPsa buildOpts (runAction runDirs) + Run.withBuildEnv' (Just config) Targets.mainTarget NoPsa buildOpts (runAction runDirs) where buildOpts = fromScriptOptions defaultBuildOptions opts runAction dirs = runBackend Nothing dirs (ModuleName "Main") Nothing "Script failed to run; " [] diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index 445367e16..d01ad28a2 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -134,13 +134,13 @@ withPublishEnv app = do withBuildEnv' :: HasEnv env - => TargetName - -> Maybe Config + => Maybe Config + -> TargetName -> UsePsa -> BuildOptions -> RIO BuildEnv a -> RIO env a -withBuildEnv' tgtName maybeConfig usePsa envBuildOptions@BuildOptions{ noInstall } app = do +withBuildEnv' maybeConfig tgtName usePsa envBuildOptions@BuildOptions{ noInstall } app = do Env{..} <- getEnv envPursCmd <- getPurs usePsa envConfig@Config{..} <- maybe getConfig pure maybeConfig @@ -163,7 +163,7 @@ withBuildEnv -> BuildOptions -> RIO BuildEnv a -> RIO env a -withBuildEnv tgtName = withBuildEnv' tgtName Nothing +withBuildEnv = withBuildEnv' Nothing withPursEnv :: HasEnv env From d33989a1bfe1b99dbbe726674f940ca1c9869b56 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Tue, 17 Aug 2021 16:38:10 -0700 Subject: [PATCH 19/32] Remove unneeded whitespace --- templates/spago.dhall | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/templates/spago.dhall b/templates/spago.dhall index 9372b0db4..8c8aaa110 100644 --- a/templates/spago.dhall +++ b/templates/spago.dhall @@ -10,11 +10,11 @@ When creating a new Spago project, you can use `spago init --no-comments` or `spago init -C` to generate this file without the comments in this block. -} -let main = +let main = { dependencies = [ "console", "effect", "prelude", "psci-support" ] , sources = [ "src/**/*.purs" ] } -let test = +let test = { dependencies = main.dependencies # [ "spec" ] , sources = main.sources # [ "test/**/*.purs" ] } @@ -22,8 +22,8 @@ let test = in { name = "my-project" , packages = ./packages.dhall - , targets = - { main = main + , targets = + { main = main , test = test } } From cb896ec4d132816be5495959b7e48a5f199dc6c9 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Wed, 18 Aug 2021 21:48:19 -0700 Subject: [PATCH 20/32] Implement addRawDeps for targets --- src/Spago/Config.hs | 132 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index bac313902..7645d5a87 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -342,6 +342,138 @@ updateName newName (Dhall.RecordLit kvs) $ Dhall.Map.insert "name" (Dhall.makeRecordField $ Dhall.toTextLit newName) kvs updateName _ other = other +addRawDeps2 :: HasLogFunc env => Config -> TargetName -> [PackageName] -> Expr -> RIO env Expr +addRawDeps2 config tgtName newPackages rawExpr = + case NonEmpty.nonEmpty notInPackageSet of + Just pkgs -> do + logWarn $ display $ Messages.failedToAddDeps $ NonEmpty.map packageName pkgs + pure rawExpr + Nothing -> case rawExpr of + Dhall.RecordLit kvs -> Dhall.RecordLit <$> insertDepsIntoTargetsMap kvs + l@(Dhall.Let b inExpr) -> do + bindingName <- findBindingName l + case bindingName of + Just name -> + insertDepsIntoBinding name l + Nothing -> + Dhall.Let b <$> insertDepsIntoLetExpr inExpr + pure $ Dhall.Let b inExpr + other -> do + logWarn $ "Expression was not a record but was " <> display (pretty other) + pure rawExpr + where + Config { packageSet = PackageSet{..} } = config + notInPackageSet = filter (\p -> Map.notMember p packagesDB) newPackages + + -- | Code from https://stackoverflow.com/questions/45757839 + nubSeq :: Ord a => Seq a -> Seq a + nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens) + where + seens = Seq.scanl (flip Set.insert) Set.empty xs + + -- | Adds the new packages to the rightmost `ListLit` in case there are multiple + -- | `ListAppend` values + -- | + -- | ``` + -- | [ "old" ] -> [ "old", "new" ] + -- | list # [ "old" ] -> list # [ "old", "new" ] + -- | list1 # list2 # [ "old" ] -> list1 # list2 # [ "old", "new" ] + -- | ``` + modifyRightmostListLit = \case + Dhall.ListLit x dependencies -> do + Dhall.ListLit x <$> addNewDeps dependencies + Dhall.ListAppend leftList rightList -> do + Dhall.ListAppend leftList <$> modifyRightmostListLit rightList + other -> pure other + + -- | Takes the rightmost `ListLit`'s `dependencies` value + -- | and combines the newPackages with the original dependencies + addNewDeps dependencies = do + oldPackages <- traverse (throws . Dhall.fromTextLit) dependencies + pure + $ fmap (Dhall.toTextLit . packageName) + $ Seq.sort $ nubSeq (Seq.fromList newPackages <> fmap PackageName oldPackages) + + -- | Finds the corresponding binding name that contains target info (if any) + findBindingName = \case + Dhall.RecordLit kvs -> case Dhall.Map.lookup "targets" kvs of + Nothing -> do + pure Nothing + Just Dhall.RecordField { recordFieldValue = targetsFieldVal } -> case targetsFieldVal of + Dhall.RecordLit targets -> case Dhall.Map.lookup (targetName tgtName) targets of + Nothing -> do + pure Nothing + Just Dhall.RecordField { recordFieldValue = tgt } -> case tgt of + Dhall.Var (Dhall.V bindingName _) -> pure $ Just bindingName + _ -> pure Nothing + _ -> do + pure Nothing + Dhall.Let _ inExpr -> findBindingName inExpr + _ -> pure Nothing + + -- | Inserts the new dependencies into the target's corresponding binding + insertDepsIntoBinding name = \case + Dhall.Let b@Dhall.Binding { variable = varName, value = v } inExpr + | varName == name -> + (\newV -> Dhall.Let (Dhall.makeBinding varName newV) inExpr) <$> insertDepsIntoTarget v + | otherwise -> + Dhall.Let b <$> insertDepsIntoBinding name inExpr + other -> pure other + + -- | Although "let bindings" are used in the expression, the target does not use a binding + -- | but stores the target 'as is' in the final RecordLit expresion. + insertDepsIntoLetExpr = \case + Dhall.RecordLit kvs -> + Dhall.RecordLit <$> insertDepsIntoTargetsMap kvs + Dhall.Let b inExpr -> + Dhall.Let b <$> insertDepsIntoLetExpr inExpr + other -> pure other + + -- | Inserts the new dependencies into the 'targets' field of a RecordLit + insertDepsIntoTargetsMap kvs = case Dhall.Map.lookup "targets" kvs of + Nothing -> do + logWarn "Failed to find the 'targets' field in the record." + pure kvs + Just Dhall.RecordField { recordFieldValue = targetsFieldVal } -> case targetsFieldVal of + Dhall.RecordLit targets -> case Dhall.Map.lookup (targetName tgtName) targets of + Nothing -> do + logWarn $ "Failed to find the target '" <> display (targetName tgtName) <> "' in the 'targets' field" + pure kvs + Just Dhall.RecordField { recordFieldValue = tgt } -> do + newTarget <- insertDepsIntoTarget tgt + pure + $ flip (Dhall.Map.insert "targets") kvs + $ Dhall.makeRecordField + $ Dhall.RecordLit + $ flip (Dhall.Map.insert (targetName tgtName)) targets + $ Dhall.makeRecordField newTarget + other -> do + logWarn $ "The 'targets' field's value was not a record but was " <> display (pretty other) + pure kvs + + -- | Inserts the new packages into the target's `dependencies` list + insertDepsIntoTarget tgt = case tgt of + Dhall.RecordLit tgtValue -> case Dhall.Map.lookup "dependencies" tgtValue of + Nothing -> do + logWarn $ "Target '" <> display (targetName tgtName) <> "' does not have a 'dependencies' field." + pure tgt + Just Dhall.RecordField { recordFieldValue = depsFieldVal } -> do + newVal <- case depsFieldVal of + Dhall.ListLit x dependencies -> do + newDeps <- addNewDeps dependencies + pure $ Dhall.ListLit x newDeps + Dhall.ListAppend leftList rightList -> do + newRight <- modifyRightmostListLit rightList + pure $ Dhall.ListAppend leftList newRight + other -> pure other + pure + $ Dhall.RecordLit + $ flip (Dhall.Map.insert "dependencies") tgtValue + $ Dhall.makeRecordField newVal + other -> do + logWarn $ "The target '" <> display (targetName tgtName) <> "' was not a record but was " <> display (pretty other) + pure other + addRawDeps :: HasLogFunc env => Config -> [PackageName] -> Expr -> RIO env Expr addRawDeps config newPackages r@(Dhall.RecordLit kvs) = case Dhall.Map.lookup "dependencies" kvs of Just (Dhall.RecordField { recordFieldValue = Dhall.ListLit _ dependencies }) -> do From 62260177404afdc8e1663b804452d05f56081863 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Wed, 18 Aug 2021 21:49:23 -0700 Subject: [PATCH 21/32] Migrate psc-package: use target-based add deps --- src/Spago/Config.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 7645d5a87..b95385878 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -242,7 +242,7 @@ makeConfig force comments = do logInfo "Found a \"psc-package.json\" file, migrating to a new Spago config.." -- try to update the dependencies (will fail if not found in package set) let pscPackages = map PackageName $ PscPackage.depends pscConfig - void $ withConfigAST ( addRawDeps config pscPackages + void $ withConfigAST ( addRawDeps2 config Targets.mainTarget pscPackages . updateName (PscPackage.name pscConfig)) (_, True) -> do -- read the bowerfile From fc98b778f08ff3f1b1b90da15f7f4436374fd370 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 06:55:41 -0700 Subject: [PATCH 22/32] Migrate bower: add target deps --- src/Spago/Config.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index b95385878..4e56ccf0c 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -254,8 +254,10 @@ makeConfig force comments = do logInfo "Found a \"bower.json\" file, migrating to a new Spago config.." -- then try to update the dependencies. We'll migrates the ones that we can, -- and print a message to the user to fix the missing ones - let (bowerName, packageResults) = migrateBower packageMeta packageSet - (bowerErrors, bowerPackages) = partitionEithers packageResults + let (bowerName, deps, devDeps) = migrateBower packageMeta packageSet + (bowerMainErrors, bowerMainPackages) = partitionEithers deps + (bowerDevErrors, bowerDevPackages) = partitionEithers devDeps + bowerErrors = bowerMainErrors <> bowerDevErrors if null bowerErrors then do @@ -264,8 +266,10 @@ makeConfig force comments = do else do logWarn $ display $ showBowerErrors bowerErrors - void $ withConfigAST ( addRawDeps config bowerPackages - . updateName bowerName) + void $ withConfigAST $ \expr -> do + let withBowerName = updateName bowerName expr + addRawDeps2 config Targets.mainTarget bowerMainPackages withBowerName + >>= addRawDeps2 config Targets.testTarget bowerDevPackages _ -> pure () -- at last we return the new config @@ -274,10 +278,11 @@ makeConfig force comments = do Left err -> die [err] -migrateBower :: Bower.PackageMeta -> PackageSet -> (Text, [Either BowerDependencyError PackageName]) -migrateBower Bower.PackageMeta{..} PackageSet{..} = (packageName, dependencies) +migrateBower :: Bower.PackageMeta -> PackageSet -> (Text, [Either BowerDependencyError PackageName], [Either BowerDependencyError PackageName]) +migrateBower Bower.PackageMeta{..} PackageSet{..} = (packageName, dependencies, devDependencies) where - dependencies = map migratePackage (bowerDependencies <> bowerDevDependencies) + dependencies = map migratePackage bowerDependencies + devDependencies = map migratePackage bowerDevDependencies -- | For each Bower dependency, we: -- * try to parse the range into a SemVer.Range From e07400b86ed6cefbbf34c4bddb692130d61f8a76 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 06:56:10 -0700 Subject: [PATCH 23/32] Use one traversal to handle let bindings --- src/Spago/Config.hs | 94 +++++++++++++++++++++++++++------------------ 1 file changed, 57 insertions(+), 37 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 4e56ccf0c..987df1010 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -348,21 +348,23 @@ updateName newName (Dhall.RecordLit kvs) updateName _ other = other addRawDeps2 :: HasLogFunc env => Config -> TargetName -> [PackageName] -> Expr -> RIO env Expr -addRawDeps2 config tgtName newPackages rawExpr = +addRawDeps2 config tgtName newPackages rawExpr = case NonEmpty.nonEmpty notInPackageSet of Just pkgs -> do logWarn $ display $ Messages.failedToAddDeps $ NonEmpty.map packageName pkgs pure rawExpr Nothing -> case rawExpr of Dhall.RecordLit kvs -> Dhall.RecordLit <$> insertDepsIntoTargetsMap kvs - l@(Dhall.Let b inExpr) -> do - bindingName <- findBindingName l - case bindingName of - Just name -> - insertDepsIntoBinding name l - Nothing -> - Dhall.Let b <$> insertDepsIntoLetExpr inExpr - pure $ Dhall.Let b inExpr + Dhall.Let b@Dhall.Binding { variable = varName, value = v } inExpr -> do + (mbBindingName, newInExpr) <- updateOrFindBindingName inExpr + case mbBindingName of + Nothing -> pure $ Dhall.Let b newInExpr + Just bindingName + | bindingName == varName -> do + (\newV -> Dhall.Let (Dhall.makeBinding varName newV) inExpr) <$> insertDepsIntoTarget v + | otherwise -> do + logWarn $ "Binding for variable '" <> display bindingName <> "' could not be found." + pure rawExpr other -> do logWarn $ "Expression was not a record but was " <> display (pretty other) pure rawExpr @@ -399,40 +401,58 @@ addRawDeps2 config tgtName newPackages rawExpr = $ fmap (Dhall.toTextLit . packageName) $ Seq.sort $ nubSeq (Seq.fromList newPackages <> fmap PackageName oldPackages) - -- | Finds the corresponding binding name that contains target info (if any) - findBindingName = \case - Dhall.RecordLit kvs -> case Dhall.Map.lookup "targets" kvs of + -- | This functions traversals down the AST to determine whether the target is a literal value + -- | in the final `RecordLit`'s "targets" field or whether it will refer to a binding + -- | declared previously in the AST. Once identified, the traversal up the AST will + -- | reconstruct the AST with the update. Either the packages will be added in the final + -- | `RecordLit` when no bindings are used or it will be added at the binding. + -- | + -- | Since this returns `(Maybe Text, expr)`. the `Maybe Text` represents whether + -- | a binding was used. If it is `Nothing`, then either no binding was used or + -- | a binding was used but the update has already occurred at a binding "lower" + -- | in the AST. If it is `Just bindingName`, then a binding was used and hasn't + -- | yet been updated. + updateOrFindBindingName = \case + expr@(Dhall.RecordLit kvs) -> case Dhall.Map.lookup "targets" kvs of Nothing -> do - pure Nothing + logWarn "The 'targets' field was not found" + pure (Nothing, expr) Just Dhall.RecordField { recordFieldValue = targetsFieldVal } -> case targetsFieldVal of Dhall.RecordLit targets -> case Dhall.Map.lookup (targetName tgtName) targets of Nothing -> do - pure Nothing + logWarn $ "The target named '" <> display (targetName tgtName) <> "' was not found" + pure (Nothing, expr) Just Dhall.RecordField { recordFieldValue = tgt } -> case tgt of - Dhall.Var (Dhall.V bindingName _) -> pure $ Just bindingName - _ -> pure Nothing + Dhall.RecordLit _ -> do + -- no binding was used, so do the update in the record + newTarget <- insertDepsIntoTarget tgt + let + newExpr = + Dhall.RecordLit + $ flip (Dhall.Map.insert "targets") kvs + $ Dhall.makeRecordField + $ Dhall.RecordLit + $ flip (Dhall.Map.insert (targetName tgtName)) targets + $ Dhall.makeRecordField newTarget + pure (Nothing, newExpr) + Dhall.Var (Dhall.V bindingName _) -> + -- binding was used, so return the binding name + pure (Just bindingName, expr) + _ -> + pure (Nothing, expr) _ -> do - pure Nothing - Dhall.Let _ inExpr -> findBindingName inExpr - _ -> pure Nothing - - -- | Inserts the new dependencies into the target's corresponding binding - insertDepsIntoBinding name = \case - Dhall.Let b@Dhall.Binding { variable = varName, value = v } inExpr - | varName == name -> - (\newV -> Dhall.Let (Dhall.makeBinding varName newV) inExpr) <$> insertDepsIntoTarget v - | otherwise -> - Dhall.Let b <$> insertDepsIntoBinding name inExpr - other -> pure other - - -- | Although "let bindings" are used in the expression, the target does not use a binding - -- | but stores the target 'as is' in the final RecordLit expresion. - insertDepsIntoLetExpr = \case - Dhall.RecordLit kvs -> - Dhall.RecordLit <$> insertDepsIntoTargetsMap kvs - Dhall.Let b inExpr -> - Dhall.Let b <$> insertDepsIntoLetExpr inExpr - other -> pure other + pure (Nothing, expr) + l@(Dhall.Let b@Dhall.Binding { variable = varName, value = v } inExpr) -> do + (mbBindingName, newInExpr) <- updateOrFindBindingName inExpr + case mbBindingName of + Nothing -> pure (Nothing, Dhall.Let b newInExpr) + Just bindingName + | bindingName == varName -> do + newTarget <- insertDepsIntoTarget v + pure (Nothing, Dhall.Let (Dhall.makeBinding varName newTarget) inExpr) + | otherwise -> do + pure (mbBindingName, l) + other -> pure (Nothing, other) -- | Inserts the new dependencies into the 'targets' field of a RecordLit insertDepsIntoTargetsMap kvs = case Dhall.Map.lookup "targets" kvs of From d81287d4216abfefc52c5252c2974be96e4d1bce Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 18:54:34 -0700 Subject: [PATCH 24/32] Make install handle more Dhall expressions --- src/Spago/Config.hs | 48 ++++++++----------------------------------- src/Spago/Packages.hs | 2 +- 2 files changed, 9 insertions(+), 41 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 987df1010..47bc7a2be 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -242,7 +242,7 @@ makeConfig force comments = do logInfo "Found a \"psc-package.json\" file, migrating to a new Spago config.." -- try to update the dependencies (will fail if not found in package set) let pscPackages = map PackageName $ PscPackage.depends pscConfig - void $ withConfigAST ( addRawDeps2 config Targets.mainTarget pscPackages + void $ withConfigAST ( addRawDeps config Targets.mainTarget pscPackages . updateName (PscPackage.name pscConfig)) (_, True) -> do -- read the bowerfile @@ -268,8 +268,8 @@ makeConfig force comments = do void $ withConfigAST $ \expr -> do let withBowerName = updateName bowerName expr - addRawDeps2 config Targets.mainTarget bowerMainPackages withBowerName - >>= addRawDeps2 config Targets.testTarget bowerDevPackages + addRawDeps config Targets.mainTarget bowerMainPackages withBowerName + >>= addRawDeps config Targets.testTarget bowerDevPackages _ -> pure () -- at last we return the new config @@ -347,8 +347,8 @@ updateName newName (Dhall.RecordLit kvs) $ Dhall.Map.insert "name" (Dhall.makeRecordField $ Dhall.toTextLit newName) kvs updateName _ other = other -addRawDeps2 :: HasLogFunc env => Config -> TargetName -> [PackageName] -> Expr -> RIO env Expr -addRawDeps2 config tgtName newPackages rawExpr = +addRawDeps :: HasLogFunc env => Config -> TargetName -> [PackageName] -> Expr -> RIO env Expr +addRawDeps config tgtName newPackages rawExpr = case NonEmpty.nonEmpty notInPackageSet of Just pkgs -> do logWarn $ display $ Messages.failedToAddDeps $ NonEmpty.map packageName pkgs @@ -499,38 +499,6 @@ addRawDeps2 config tgtName newPackages rawExpr = logWarn $ "The target '" <> display (targetName tgtName) <> "' was not a record but was " <> display (pretty other) pure other -addRawDeps :: HasLogFunc env => Config -> [PackageName] -> Expr -> RIO env Expr -addRawDeps config newPackages r@(Dhall.RecordLit kvs) = case Dhall.Map.lookup "dependencies" kvs of - Just (Dhall.RecordField { recordFieldValue = Dhall.ListLit _ dependencies }) -> do - case NonEmpty.nonEmpty notInPackageSet of - -- If none of the newPackages are outside of the set, add them to existing dependencies - Nothing -> do - oldPackages <- traverse (throws . Dhall.fromTextLit) dependencies - let newDepsExpr - = Dhall.makeRecordField - $ Dhall.ListLit Nothing $ fmap (Dhall.toTextLit . packageName) - $ Seq.sort $ nubSeq (Seq.fromList newPackages <> fmap PackageName oldPackages) - pure $ Dhall.RecordLit $ Dhall.Map.insert "dependencies" newDepsExpr kvs - Just pkgs -> do - logWarn $ display $ Messages.failedToAddDeps $ NonEmpty.map packageName pkgs - pure r - where - Config { packageSet = PackageSet{..} } = config - notInPackageSet = filter (\p -> Map.notMember p packagesDB) newPackages - - -- | Code from https://stackoverflow.com/questions/45757839 - nubSeq :: Ord a => Seq a -> Seq a - nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens) - where - seens = Seq.scanl (flip Set.insert) Set.empty xs - Just _ -> do - logWarn "Failed to add dependencies. The `dependencies` field wasn't a List of Strings." - pure r - Nothing -> do - logWarn "Failed to add dependencies. You should have a record with the `dependencies` key for this to work." - pure r -addRawDeps _ _ other = pure other - addSourcePaths :: Expr -> Expr addSourcePaths (Dhall.RecordLit kvs) | isConfigV1 kvs = @@ -596,9 +564,9 @@ transformMExpr rules = -- dependencies, and write the Config back to file. addDependencies :: (HasLogFunc env, HasConfigPath env) - => Config -> [PackageName] + => Config -> TargetName -> [PackageName] -> RIO env () -addDependencies config newPackages = do - configHasChanged <- withConfigAST $ addRawDeps config newPackages +addDependencies config tgtName newPackages = do + configHasChanged <- withConfigAST $ addRawDeps config tgtName newPackages unless configHasChanged $ logWarn "Configuration file was not updated." diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 47b425d0b..5a8ac3eaf 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -194,7 +194,7 @@ install newPackages = do -- Also skip the write if there are no new packages to be written case existingNewPackages of [] -> pure () - additional -> Config.addDependencies config additional + additional -> Config.addDependencies config tgtName additional Fetch.fetchPackages deps From d8245fb2fe701e7a372b3de88c6451ffeaee4463 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 19:26:17 -0700 Subject: [PATCH 25/32] Migrate v1 and v2 configs to v3 Dhall expr --- src/Spago/Config.hs | 45 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 40 insertions(+), 5 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 47bc7a2be..181873472 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -500,11 +500,46 @@ addRawDeps config tgtName newPackages rawExpr = pure other addSourcePaths :: Expr -> Expr -addSourcePaths (Dhall.RecordLit kvs) - | isConfigV1 kvs = - let sources = Dhall.ListLit Nothing $ fmap Dhall.toTextLit $ Seq.fromList ["src/**/*.purs", "test/**/*.purs"] - in Dhall.RecordLit (Dhall.Map.insert "sources" (Dhall.makeRecordField sources) kvs) -addSourcePaths expr = expr +addSourcePaths = \case + Dhall.RecordLit kvs + | isConfigV1 kvs -> do + let + mainDeps = fromMaybe (Dhall.makeRecordField $ Dhall.ListLit Nothing [] ) $ Dhall.Map.lookup "dependencies" kvs + mainSources = Dhall.makeRecordField $ mkSources "src/**/*.purs" + Dhall.Let (mainTargetBinding mainDeps mainSources) + $ Dhall.Let testTargetBinding + $ Dhall.RecordLit + $ Dhall.Map.delete "dependencies" + $ Dhall.Map.delete "sources" kvs + | isConfigV2 kvs -> do + let + mainDeps = fromMaybe (Dhall.makeRecordField $ Dhall.ListLit Nothing [] ) $ Dhall.Map.lookup "dependencies" kvs + mainSources = fromMaybe (Dhall.makeRecordField $ Dhall.ListLit Nothing [] ) $ Dhall.Map.lookup "sources" kvs + Dhall.Let (mainTargetBinding mainDeps mainSources) + $ Dhall.Let testTargetBinding + $ Dhall.RecordLit + $ Dhall.Map.delete "dependencies" + $ Dhall.Map.delete "sources" kvs + expr -> expr + where + mkSources txt = Dhall.ListLit Nothing [ Dhall.toTextLit txt ] + + mainTargetBinding deps sources = + Dhall.makeBinding "main" + $ Dhall.RecordLit + $ Dhall.Map.fromList + [ ("dependencies", deps ) + , ("sources", sources ) + ] + testTargetBinding = + Dhall.makeBinding "test" + $ Dhall.RecordLit + $ Dhall.Map.fromList + [ ("dependencies", Dhall.makeRecordField $ Dhall.ListAppend (referToRecordBinding "main" 0 "dependencies") $ Dhall.ListLit Nothing [] ) + , ("sources", Dhall.makeRecordField $ Dhall.ListAppend (referToRecordBinding "main" 0 "sources") (mkSources "test/**/*.purs") ) + ] + + referToRecordBinding varName idx field = Dhall.Field (Dhall.Var (Dhall.V varName idx)) $ Dhall.makeFieldSelection field isConfigV1, isConfigV2 :: Dhall.Map.Map Text v -> Bool isConfigV1 (Set.fromList . Dhall.Map.keys -> configKeySet) = From 72c4711fc1c739007f173021d829fea3a36e8b35 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 19:29:19 -0700 Subject: [PATCH 26/32] Normalize dhall expression before parsing --- src/Spago/Config.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 181873472..2960bc967 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -139,7 +139,7 @@ parseConfig = do ConfigPath path <- view (the @ConfigPath) expr <- liftIO $ Dhall.inputExpr $ "./" <> path - case expr of + case Dhall.normalize expr of Dhall.RecordLit ks' -> do let ks = Dhall.extractRecordValues ks' name <- Dhall.requireTypedKey ks "name" Dhall.strictText @@ -161,7 +161,7 @@ parseConfig = do something -> throwM $ Dhall.PackagesIsNotRecord something) pure Config{..} - _ -> case Dhall.TypeCheck.typeOf expr of + _ -> case Dhall.TypeCheck.typeOf $ Dhall.normalize expr of Right e -> throwM $ Dhall.ConfigIsNotRecord e Left err -> throwM err From 834d0345f796c194fd90fa15294c4f84c97b0784 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 19:59:49 -0700 Subject: [PATCH 27/32] Make bumpVersion require a target --- app/Spago.hs | 2 +- src/Spago/CLI.hs | 4 ++-- src/Spago/Env.hs | 2 ++ src/Spago/RunEnv.hs | 10 +++++++--- 4 files changed, 12 insertions(+), 6 deletions(-) diff --git a/app/Spago.hs b/app/Spago.hs index 49dea9e0a..7cbdd0b54 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -79,7 +79,7 @@ main = withUtf8 $ do $ Spago.Packages.sources -- ### Commands that need a "publish env": install env + git and bower - BumpVersion dryRun spec -> Run.withPublishEnv + BumpVersion targetName dryRun spec -> Run.withPublishEnv targetName $ Spago.Version.bumpVersion dryRun spec -- ### Commands that need a "verification env": a Package Set + purs diff --git a/src/Spago/CLI.hs b/src/Spago/CLI.hs index 316ecf23c..a3ac807fa 100644 --- a/src/Spago/CLI.hs +++ b/src/Spago/CLI.hs @@ -41,7 +41,7 @@ data Command | ListDeps TargetName JsonFlag IncludeTransitive -- | Bump and tag a new version in preparation for release. - | BumpVersion DryRun VersionBump + | BumpVersion TargetName DryRun VersionBump -- | Upgrade the package-set to the latest release | PackageSetUpgrade (Maybe Text) @@ -312,7 +312,7 @@ parser = do bumpVersion = ( "bump-version" , "Bump and tag a new version, and generate bower.json, in preparation for release." - , BumpVersion <$> dryRun <*> versionBump + , BumpVersion <$> targetNameDefaultMain <*> dryRun <*> versionBump ) otherCommands = CLI.subcommandGroup "Other commands:" diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index 26b29f9d0..f1d54c92b 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -158,6 +158,8 @@ data PublishEnv = PublishEnv , envPackageSet :: !PackageSet , envGitCmd :: !GitCmd , envBowerCmd :: !BowerCmd + , envTarget :: !Target + , envTargetName :: !TargetName } deriving (Generic) data BuildEnv = BuildEnv diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index d01ad28a2..cf4f890a2 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -116,12 +116,16 @@ withVerifyEnv usePsa app = do withPublishEnv :: HasEnv env - => RIO PublishEnv a + => TargetName + -> RIO PublishEnv a -> RIO env a -withPublishEnv app = do +withPublishEnv tgtName app = do Env{..} <- getEnv envConfig@Config{..} <- getConfig - let envPackageSet = packageSet + envTarget <- getTarget tgtName targets + let + envPackageSet = packageSet + envTargetName = tgtName envGitCmd <- getGit envBowerCmd <- BowerCmd <$> -- workaround windows issue: https://github.com/haskell/process/issues/140 From efd44fd7151d0d9b8b075fa314a74cc154e59119 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 20:04:23 -0700 Subject: [PATCH 28/32] Make bumpVersion use target's dependencies --- src/Spago/Bower.hs | 2 +- src/Spago/Env.hs | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Spago/Bower.hs b/src/Spago/Bower.hs index 01aa3836e..316f16b97 100644 --- a/src/Spago/Bower.hs +++ b/src/Spago/Bower.hs @@ -117,7 +117,7 @@ mkBowerVersion packageName version (Repo repo) = do mkDependencies :: forall env. HasPublishEnv env => RIO env [(Bower.PackageName, Bower.VersionRange)] mkDependencies = do - deps <- Packages.getDirectDeps + deps <- Packages.getTransitiveTargetDeps Jobs jobs <- getJobs diff --git a/src/Spago/Env.hs b/src/Spago/Env.hs index f1d54c92b..619b6f4d2 100644 --- a/src/Spago/Env.hs +++ b/src/Spago/Env.hs @@ -90,6 +90,8 @@ type HasPublishEnv env = , HasConfig env , HasBower env , HasGit env + , HasTarget env + , HasTargetName env ) type HasBuildEnv env = From 5105bd95975a948b44de45c6a8996ad4458ad49d Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 20:09:03 -0700 Subject: [PATCH 29/32] Remove configSourcePaths from Config --- src/Spago/Config.hs | 5 ++--- src/Spago/Packages.hs | 8 ++++---- src/Spago/RunEnv.hs | 8 ++++---- src/Spago/Types.hs | 1 - 4 files changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 2960bc967..c2fcb30b8 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -144,7 +144,6 @@ parseConfig = do let ks = Dhall.extractRecordValues ks' name <- Dhall.requireTypedKey ks "name" Dhall.strictText dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType - configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType targets <- Dhall.requireKey ks "targets" (\case Dhall.RecordLit tgts -> parseTargets (Dhall.extractRecordValues tgts) something -> throwM $ Dhall.TargetsIsNotRecord something) @@ -190,9 +189,9 @@ makeTempConfig -> [SourcePath] -> Maybe Text -> RIO env Config -makeTempConfig dependencies alternateBackend configSourcePaths maybeTag = do +makeTempConfig dependencies alternateBackend targetSourcePaths maybeTag = do PursCmd { compilerVersion } <- view (the @PursCmd) - let targets = Map.singleton Targets.mainTarget (Target { targetDependencies = dependencies, targetSourcePaths = configSourcePaths }) + let targets = Map.singleton Targets.mainTarget (Target { targetDependencies = dependencies, targetSourcePaths = targetSourcePaths }) tag <- case maybeTag of Nothing -> PackageSet.getLatestSetForCompilerVersion compilerVersion "purescript" "package-sets" >>= \case diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 5a8ac3eaf..a8b7eaed5 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -36,11 +36,11 @@ getGlobsSourcePaths :: Globs -> [SourcePath] getGlobsSourcePaths Globs{..} = Map.elems depsGlobs <> fromMaybe [] projectGlobs getGlobs :: [(PackageName, Package)] -> DepsOnly -> [SourcePath] -> Globs -getGlobs deps depsOnly configSourcePaths = do +getGlobs deps depsOnly targetSourcePaths = do let projectGlobs = case depsOnly of DepsOnly -> Nothing - AllSources -> Just configSourcePaths + AllSources -> Just targetSourcePaths depsGlobs = Map.fromList $ map (\pair@(packageName,_) -> (packageName, SourcePath $ Text.pack $ Fetch.getLocalCacheDir pair <> "/src/**/*.purs")) deps @@ -49,14 +49,14 @@ getGlobs deps depsOnly configSourcePaths = do getJsGlobs :: [(PackageName, Package)] -> DepsOnly -> [SourcePath] -> [SourcePath] -getJsGlobs deps depsOnly configSourcePaths +getJsGlobs deps depsOnly targetSourcePaths = map (\pair -> SourcePath $ Text.pack $ Fetch.getLocalCacheDir pair <> "/src/**/*.js") deps <> case depsOnly of DepsOnly -> [] AllSources -> SourcePath . Text.replace ".purs" ".js" . unSourcePath - <$> configSourcePaths + <$> targetSourcePaths -- | Return the direct dependencies of the current target diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index cf4f890a2..ad0afa336 100644 --- a/src/Spago/RunEnv.hs +++ b/src/Spago/RunEnv.hs @@ -155,7 +155,7 @@ withBuildEnv' maybeConfig tgtName usePsa envBuildOptions@BuildOptions{ noInstall deps <- Packages.getTransitiveTargetDeps when (noInstall == DoInstall) $ FetchPackage.fetchPackages deps pure deps - envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envConfig deps) + envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envTarget deps) envGitCmd <- getGit logDebug "Running in `BuildEnv`" runRIO BuildEnv{..} app @@ -226,10 +226,10 @@ getPackageSet = do Right Config{ packageSet } -> pure packageSet Left err -> die [ display Messages.couldNotVerifySet, "Error was:", display err ] -getMaybeGraph :: HasPursEnv env => BuildOptions -> Config -> [(PackageName, Package)] -> RIO env Graph -getMaybeGraph BuildOptions{ depsOnly, sourcePaths } Config{ configSourcePaths } deps = do +getMaybeGraph :: HasPursEnv env => BuildOptions -> Target -> [(PackageName, Package)] -> RIO env Graph +getMaybeGraph BuildOptions{ depsOnly, sourcePaths } Target{ targetSourcePaths } deps = do logDebug "Running `getMaybeGraph`" - let partitionedGlobs = Packages.getGlobs deps depsOnly configSourcePaths + let partitionedGlobs = Packages.getGlobs deps depsOnly targetSourcePaths globs = Packages.getGlobsSourcePaths partitionedGlobs <> sourcePaths supportsGraph <- Purs.hasMinPursVersion "0.14.0" if not supportsGraph diff --git a/src/Spago/Types.hs b/src/Spago/Types.hs index a05803204..48fdfbdfd 100644 --- a/src/Spago/Types.hs +++ b/src/Spago/Types.hs @@ -189,7 +189,6 @@ data Config = Config , packageSet :: PackageSet , targets :: Map TargetName Target , alternateBackend :: Maybe Text - , configSourcePaths :: [SourcePath] , publishConfig :: Either (Dhall.ReadError Void) PublishConfig } deriving (Show, Generic) From cd108f2b444113434dd85db613610ad62dc42f2c Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 19 Aug 2021 20:13:12 -0700 Subject: [PATCH 30/32] Remove dependencies from Config type --- src/Spago/Build.hs | 2 +- src/Spago/Config.hs | 1 - src/Spago/Packages.hs | 27 +-------------------------- src/Spago/Types.hs | 1 - 4 files changed, 2 insertions(+), 29 deletions(-) diff --git a/src/Spago/Build.hs b/src/Spago/Build.hs index b960b6b5c..86598711a 100644 --- a/src/Spago/Build.hs +++ b/src/Spago/Build.hs @@ -105,7 +105,7 @@ build maybePostBuild = do $ Set.toList importedPackageModules dependencyPackages :: Set PackageName - dependencyPackages = Set.fromList dependencies + dependencyPackages = Set.fromList targetDependencies let unusedPackages = diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index c2fcb30b8..78386a139 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -143,7 +143,6 @@ parseConfig = do Dhall.RecordLit ks' -> do let ks = Dhall.extractRecordValues ks' name <- Dhall.requireTypedKey ks "name" Dhall.strictText - dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType targets <- Dhall.requireKey ks "targets" (\case Dhall.RecordLit tgts -> parseTargets (Dhall.extractRecordValues tgts) something -> throwM $ Dhall.TargetsIsNotRecord something) diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index a8b7eaed5..dfe95a903 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -6,8 +6,6 @@ module Spago.Packages , getJsGlobs , getDirectTargetDeps , getTransitiveTargetDeps - , getDirectDeps - , getProjectDeps , getReverseDeps , getTransitiveDeps , DepsOnly(..) @@ -81,26 +79,6 @@ getTransitiveTargetDeps = do Target{ targetDependencies } <- view (the @Target) getTransitiveDeps targetDependencies --- | Return the direct dependencies of the current project -getDirectDeps - :: (HasLogFunc env, HasConfig env) - => RIO env [(PackageName, Package)] -getDirectDeps = do - Config { packageSet = PackageSet{..}, dependencies } <- view (the @Config) - for dependencies $ \dep -> - case Map.lookup dep packagesDB of - Nothing -> - die [ display $ pkgNotFoundMsg packagesDB (NotFoundError dep) ] - Just pkg -> - pure (dep, pkg) - -getProjectDeps - :: (HasLogFunc env, HasConfig env) - => RIO env [(PackageName, Package)] -getProjectDeps = do - Config{ dependencies } <- view (the @Config) - getTransitiveDeps dependencies - -- | Return the transitive dependencies of a list of packages getTransitiveDeps :: (HasLogFunc env, HasPackageSet env) @@ -183,10 +161,7 @@ install newPackages = do let newTarget = target { targetDependencies = targetDependencies <> existingNewPackages } newConfig :: Config - newConfig = config - { Config.dependencies = dependencies <> existingNewPackages - , Config.targets = Map.adjust (const newTarget) tgtName targets - } + newConfig = config { Config.targets = Map.adjust (const newTarget) tgtName targets } mapRIO (set (the @Config) newConfig) $ do deps <- getTransitiveTargetDeps diff --git a/src/Spago/Types.hs b/src/Spago/Types.hs index 48fdfbdfd..f6342e4fc 100644 --- a/src/Spago/Types.hs +++ b/src/Spago/Types.hs @@ -185,7 +185,6 @@ data ScriptBuildOptions = ScriptBuildOptions -- | Spago configuration file type data Config = Config { name :: Text - , dependencies :: [PackageName] , packageSet :: PackageSet , targets :: Map TargetName Target , alternateBackend :: Maybe Text From 8d79077f0c19626e82d5f9b521911b95dbc081a7 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Fri, 20 Aug 2021 06:27:58 -0700 Subject: [PATCH 31/32] Drop 'o' shorthand for target --- src/Spago/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spago/CLI.hs b/src/Spago/CLI.hs index a3ac807fa..62c414544 100644 --- a/src/Spago/CLI.hs +++ b/src/Spago/CLI.hs @@ -154,7 +154,7 @@ parser = do chkModsUniq = bool DoCheckModulesUnique NoCheckModulesUnique <$> CLI.switch "no-check-modules-unique" 'M' "Skip checking whether modules names are unique across all packages." transitive = bool NoIncludeTransitive IncludeTransitive <$> CLI.switch "transitive" 't' "Include transitive dependencies" - mkTargetNameOption val = TargetName <$> Opts.strOption (Opts.long "target" <> Opts.short 'o' <> Opts.help "Which target to use as defined in `spago.dhall`" <> Opts.value val <> Opts.showDefault) + mkTargetNameOption val = TargetName <$> Opts.strOption (Opts.long "target" <> Opts.help "Which target to use as defined in `spago.dhall`" <> Opts.value val <> Opts.showDefault) targetNameDefaultMain = mkTargetNameOption "main" targetNameDefaultTest = mkTargetNameOption "test" From 0c0f912e6357d6297aea64839079bc58a5f60874 Mon Sep 17 00:00:00 2001 From: Jordan Martinez Date: Thu, 26 Aug 2021 19:04:14 -0700 Subject: [PATCH 32/32] Add new deps to first ListLit found or create one --- src/Spago/Config.hs | 43 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 34 insertions(+), 9 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 78386a139..707690768 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -376,20 +376,31 @@ addRawDeps config tgtName newPackages rawExpr = where seens = Seq.scanl (flip Set.insert) Set.empty xs - -- | Adds the new packages to the rightmost `ListLit` in case there are multiple - -- | `ListAppend` values + -- | Adds the new packages to the first `ListLit` it finds, traversing from + -- | left to right, in case there are multiple `ListAppend` values -- | -- | ``` -- | [ "old" ] -> [ "old", "new" ] + -- | [ "old" ] # list1 -> [ "old", "new" ] # list1 -- | list # [ "old" ] -> list # [ "old", "new" ] -- | list1 # list2 # [ "old" ] -> list1 # list2 # [ "old", "new" ] -- | ``` - modifyRightmostListLit = \case + modifyFirstListLitIfExist = \case Dhall.ListLit x dependencies -> do - Dhall.ListLit x <$> addNewDeps dependencies + Just . Dhall.ListLit x <$> addNewDeps dependencies Dhall.ListAppend leftList rightList -> do - Dhall.ListAppend leftList <$> modifyRightmostListLit rightList - other -> pure other + mbLeft <- modifyFirstListLitIfExist leftList + case mbLeft of + Just left -> do + pure $ Just $ Dhall.ListAppend left rightList + Nothing -> do + mbRight <- modifyFirstListLitIfExist rightList + case mbRight of + Just right -> do + pure $ Just $ Dhall.ListAppend leftList right + Nothing -> do + pure Nothing + _ -> pure Nothing -- | Takes the rightmost `ListLit`'s `dependencies` value -- | and combines the newPackages with the original dependencies @@ -485,9 +496,23 @@ addRawDeps config tgtName newPackages rawExpr = Dhall.ListLit x dependencies -> do newDeps <- addNewDeps dependencies pure $ Dhall.ListLit x newDeps - Dhall.ListAppend leftList rightList -> do - newRight <- modifyRightmostListLit rightList - pure $ Dhall.ListAppend leftList newRight + original@(Dhall.ListAppend leftList rightList) -> do + mbLeft <- modifyFirstListLitIfExist leftList + case mbLeft of + Just newLeft -> do + pure $ Dhall.ListAppend newLeft rightList + Nothing -> do + mbRight <- modifyFirstListLitIfExist rightList + case mbRight of + Just newRight -> do + pure $ Dhall.ListAppend leftList newRight + Nothing -> do + -- if a ListLit was not found (e.g. `one.deps # two.deps`), + -- then we add one ourselves (e.g. `one.deps # two.deps # [ "new "]`) + newListLit <- Dhall.ListLit Nothing <$> addNewDeps [] + let + newRight = Dhall.ListAppend rightList newListLit + pure $ Dhall.ListAppend leftList newRight other -> pure other pure $ Dhall.RecordLit