diff --git a/app/Spago.hs b/app/Spago.hs index c881559f4..7cbdd0b54 100644 --- a/app/Spago.hs +++ b/app/Spago.hs @@ -53,12 +53,12 @@ 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 - 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 + Repl targetName replPackageNames paths pursArgs depsOnly + -> Spago.Build.repl targetName replPackageNames paths pursArgs depsOnly + 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 @@ -71,15 +71,15 @@ 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.withInstallEnv targetName $ Spago.Packages.install packageNames - ListDeps jsonFlag transitiveFlag -> Run.withInstallEnv + ListDeps targetName jsonFlag transitiveFlag -> Run.withInstallEnv targetName $ Ls.listPackages transitiveFlag jsonFlag - Sources -> Run.withInstallEnv + Sources targetName -> Run.withInstallEnv targetName $ 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 @@ -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 targetName buildOptions -> Run.withBuildEnv targetName globalUsePsa buildOptions $ Spago.Build.build Nothing - Search -> Run.withBuildEnv globalUsePsa defaultBuildOptions + Search targetName -> Run.withBuildEnv 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.withBuildEnv targetName globalUsePsa opts $ Spago.Build.docs format noSearch openDocs - Test modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa buildOptions + Test targetName modName buildOptions nodeArgs -> Run.withBuildEnv targetName globalUsePsa buildOptions $ Spago.Build.test modName nodeArgs - Run modName buildOptions nodeArgs -> Run.withBuildEnv 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/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/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/Build.hs b/src/Spago/Build.hs index c2ce7431f..86598711a 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 @@ -54,10 +55,11 @@ 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) @@ -103,7 +105,7 @@ build maybePostBuild = do $ Set.toList importedPackageModules dependencyPackages :: Set PackageName - dependencyPackages = Set.fromList dependencies + dependencyPackages = Set.fromList targetDependencies let unusedPackages = @@ -197,16 +199,19 @@ 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 + target <- Run.getTarget tgtName (targets config) + Run.withReplEnv config target (replAction purs) Left err -> do logDebug err GlobalCache cacheDir _ <- view (the @GlobalCache) @@ -215,16 +220,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 +242,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 @@ -304,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.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; " [] @@ -366,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.withBuildEnv 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 <> "\"];" @@ -404,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.withBuildEnv tgtName usePsa buildOpts $ build (Just bundleAction) NoBuild -> Run.getEnv >>= (flip runRIO) bundleAction docsSearchTemplate :: (HasType LogFunc env, HasType PursCmd env) => RIO env Text @@ -428,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 @@ -465,11 +477,12 @@ docs format noSearch open = do search :: HasBuildEnv 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" ] diff --git a/src/Spago/CLI.hs b/src/Spago/CLI.hs index eda01025d..62c414544 100644 --- a/src/Spago/CLI.hs +++ b/src/Spago/CLI.hs @@ -29,19 +29,19 @@ 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 + | BumpVersion TargetName DryRun VersionBump -- | Upgrade the package-set to the latest release | PackageSetUpgrade (Maybe Text) @@ -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.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 = @@ -307,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/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/Config.hs b/src/Spago/Config.hs index 0f87296c8..707690768 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) @@ -120,13 +139,13 @@ 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' - 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 @@ -140,7 +159,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 @@ -169,8 +188,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 = targetSourcePaths }) tag <- case maybeTag of Nothing -> PackageSet.getLatestSetForCompilerVersion compilerVersion "purescript" "package-sets" >>= \case @@ -220,7 +240,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 ( addRawDeps config Targets.mainTarget pscPackages . updateName (PscPackage.name pscConfig)) (_, True) -> do -- read the bowerfile @@ -232,8 +252,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 @@ -242,8 +264,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 + addRawDeps config Targets.mainTarget bowerMainPackages withBowerName + >>= addRawDeps config Targets.testTarget bowerDevPackages _ -> pure () -- at last we return the new config @@ -252,10 +276,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 @@ -320,44 +345,224 @@ updateName newName (Dhall.RecordLit kvs) $ Dhall.Map.insert "name" (Dhall.makeRecordField $ Dhall.toTextLit newName) kvs updateName _ other = 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 +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 + pure rawExpr + Nothing -> case rawExpr of + Dhall.RecordLit kvs -> Dhall.RecordLit <$> insertDepsIntoTargetsMap kvs + 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 + 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 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" ] + -- | ``` + modifyFirstListLitIfExist = \case + Dhall.ListLit x dependencies -> do + Just . Dhall.ListLit x <$> addNewDeps dependencies + Dhall.ListAppend leftList rightList -> do + 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 + addNewDeps dependencies = do + oldPackages <- traverse (throws . Dhall.fromTextLit) dependencies + pure + $ fmap (Dhall.toTextLit . packageName) + $ Seq.sort $ nubSeq (Seq.fromList newPackages <> fmap PackageName oldPackages) + + -- | 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 - 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 + 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 + logWarn $ "The target named '" <> display (targetName tgtName) <> "' was not found" + pure (Nothing, expr) + Just Dhall.RecordField { recordFieldValue = tgt } -> case tgt of + 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, 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 + 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 + 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 + $ 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 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) = @@ -417,9 +622,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/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/Env.hs b/src/Spago/Env.hs index 8fc9823bf..619b6f4d2 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(..) @@ -25,6 +26,8 @@ module Spago.Env , HasConfig , HasGit , HasBower + , HasTarget + , HasTargetName , HasPurs -- | Other types @@ -57,6 +60,8 @@ 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 HasTargetName env = HasType TargetName env type HasEnv env = ( HasLogFunc env @@ -85,6 +90,8 @@ type HasPublishEnv env = , HasConfig env , HasBower env , HasGit env + , HasTarget env + , HasTargetName env ) type HasBuildEnv env = @@ -94,6 +101,8 @@ type HasBuildEnv env = , HasConfig env , HasMaybeGraph env , HasBuildOptions env + , HasTarget env + , HasTargetName env ) type HasPursEnv env = @@ -124,6 +133,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 @@ -131,6 +149,8 @@ data InstallEnv = InstallEnv , envGlobalCache :: !GlobalCache , envPackageSet :: !PackageSet , envConfig :: !Config + , envTarget :: !Target + , envTargetName :: !TargetName } deriving (Generic) data PublishEnv = PublishEnv @@ -140,6 +160,8 @@ data PublishEnv = PublishEnv , envPackageSet :: !PackageSet , envGitCmd :: !GitCmd , envBowerCmd :: !BowerCmd + , envTarget :: !Target + , envTargetName :: !TargetName } deriving (Generic) data BuildEnv = BuildEnv @@ -153,6 +175,8 @@ data BuildEnv = BuildEnv , envConfig :: !Config , envGraph :: !(Maybe ModuleGraph) , envBuildOptions :: !BuildOptions + , envTarget :: !Target + , envTargetName :: !TargetName } deriving (Generic) data PursEnv = PursEnv diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index 0a94a6b7f..07b50b0d0 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 @@ -55,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..dfe95a903 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -4,8 +4,8 @@ module Spago.Packages , getGlobs , getGlobsSourcePaths , getJsGlobs - , getDirectDeps - , getProjectDeps + , getDirectTargetDeps + , getTransitiveTargetDeps , getReverseDeps , getTransitiveDeps , DepsOnly(..) @@ -34,11 +34,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 @@ -47,35 +47,37 @@ 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 project -getDirectDeps - :: (HasLogFunc env, HasConfig env) +-- | Return the direct dependencies of the current target +getDirectTargetDeps + :: (HasLogFunc env, HasPackageSet env, HasTarget env) => RIO env [(PackageName, Package)] -getDirectDeps = do - Config { packageSet = PackageSet{..}, dependencies } <- view (the @Config) - for dependencies $ \dep -> +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) -getProjectDeps - :: (HasLogFunc env, HasConfig env) +-- | Return the transitive dependencies of the current target +getTransitiveTargetDeps + :: (HasLogFunc env, HasPackageSet env, HasTarget env) => RIO env [(PackageName, Package)] -getProjectDeps = do - Config{ dependencies } <- view (the @Config) - getTransitiveDeps dependencies +getTransitiveTargetDeps = do + Target{ targetDependencies } <- view (the @Target) + getTransitiveDeps targetDependencies -- | Return the transitive dependencies of a list of packages getTransitiveDeps @@ -146,24 +148,28 @@ 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.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 case existingNewPackages of [] -> pure () - additional -> Config.addDependencies config additional + additional -> Config.addDependencies config tgtName additional Fetch.fetchPackages deps @@ -205,13 +211,12 @@ stripPurescriptPrefix (PackageName name) = -- | Get source globs of dependencies listed in `spago.dhall` -sources :: (HasLogFunc env, HasConfig env) => RIO env () +sources :: (HasLogFunc env, HasConfig env, HasTarget env) => RIO env () sources = do logDebug "Running `spago sources`" - config <- view (the @Config) - deps <- getProjectDeps + Target{..} <- view (the @Target) + deps <- getTransitiveDeps targetDependencies traverse_ output $ fmap unSourcePath $ getGlobsSourcePaths - $ getGlobs deps AllSources - $ configSourcePaths config + $ getGlobs deps AllSources targetSourcePaths diff --git a/src/Spago/RunEnv.hs b/src/Spago/RunEnv.hs index b41d68082..ad0afa336 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 @@ -76,24 +77,30 @@ withPackageSetEnv app = do runRIO PackageSetEnv{..} app -withInstallEnv' +withReplEnv :: (HasEnv env) - => Maybe Config - -> RIO InstallEnv a + => Config + -> Target + -> RIO ReplEnv a -> RIO env a -withInstallEnv' maybeConfig app = do +withReplEnv Config{..} target app = do Env{..} <- getEnv - envConfig@Config{..} <- case maybeConfig of - Just c -> pure c - Nothing -> getConfig let envPackageSet = packageSet - runRIO InstallEnv{..} app + envTarget = target + runRIO ReplEnv{..} app withInstallEnv :: (HasEnv env) - => RIO InstallEnv a + => TargetName + -> RIO InstallEnv a -> RIO env a -withInstallEnv = withInstallEnv' Nothing +withInstallEnv tgtName app = do + Env{..} <- getEnv + envConfig@Config{..} <- getConfig + envTarget <- getTarget tgtName targets + let envPackageSet = packageSet + envTargetName = tgtName + runRIO InstallEnv{..} app withVerifyEnv :: HasEnv env @@ -109,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 @@ -128,27 +139,31 @@ withPublishEnv app = do withBuildEnv' :: HasEnv env => Maybe Config + -> TargetName -> UsePsa -> BuildOptions -> RIO BuildEnv a -> RIO env a -withBuildEnv' 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 + envTarget <- getTarget tgtName targets let envPackageSet = packageSet + let envTargetName = tgtName 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) + envGraph <- runRIO PursEnv{..} (getMaybeGraph envBuildOptions envTarget deps) envGitCmd <- getGit logDebug "Running in `BuildEnv`" runRIO BuildEnv{..} app withBuildEnv :: HasEnv env - => UsePsa + => TargetName + -> UsePsa -> BuildOptions -> RIO BuildEnv a -> RIO env a @@ -177,6 +192,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" @@ -202,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/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" diff --git a/src/Spago/Types.hs b/src/Spago/Types.hs index 4d27d0d41..f6342e4fc 100644 --- a/src/Spago/Types.hs +++ b/src/Spago/Types.hs @@ -185,13 +185,20 @@ data ScriptBuildOptions = ScriptBuildOptions -- | Spago configuration file type data Config = Config { name :: Text - , dependencies :: [PackageName] , packageSet :: PackageSet + , targets :: Map TargetName Target , alternateBackend :: Maybe Text - , configSourcePaths :: [SourcePath] , 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 diff --git a/templates/spago.dhall b/templates/spago.dhall index 2e0e6dcf8..8c8aaa110 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 + } + }