Add output folder sharing and --no-share-output flag to build

CHANGELOG.md

@@ -18,6 +18,7 @@ New features:
 - Add `--open` flag to `spago docs` which opens generated docs in browser (#379)
 - Support building for alternate backends (#355). E.g: Use `backend = "psgo"` entry in `spago.dhall` to compile with `psgo`
 - Add `--no-comments` flag to `spago init` which strips comments from the generated `spago.dhall` and `packages.dhall` configs (#417)
+- Add shared output folder to reduce build duplication. Pass `--no-share-output` flag to `spago build` to disable (#377)
 
 Bugfixes:
 - Warn (but don't error) when trying to watch missing directories (#406)

README.md

@@ -637,6 +637,10 @@ in upstream // overrides
 }
 ```
 
+To avoid building the same packages over, a shared `output` folder will be created next to your root `packages.dhall`. 
+
+To disable this behaviour, pass `--no-share-output` to `spago build`.
+
 ### `devDependencies`, `testDependencies`, or in general a situation with many configurations
 
 You might have a simpler situation than a monorepo, where e.g. you just want to "split" dependencies.

app/Spago.hs

@@ -12,8 +12,8 @@ import qualified Turtle              as CLI
 
 import           Spago.Build         (BuildOptions (..), DepsOnly (..), ExtraArg (..),
                                       ModuleName (..), NoBuild (..), NoInstall (..), NoSearch (..),
-                                      OpenDocs (..), SourcePath (..), TargetPath (..), Watch (..),
-                                      WithMain (..))
+                                      OpenDocs (..), ShareOutput (..), SourcePath (..),
+                                      TargetPath (..), Watch (..), WithMain (..))
 import qualified Spago.Build
 import qualified Spago.Config        as Config
 import           Spago.Dhall         (TemplateComments (..))
@@ -155,8 +155,8 @@ parser = do
     packageName     = CLI.arg (Just . PackageName) "package" "Specify a package name. You can list them with `list-packages`"
     packageNames    = many $ CLI.arg (Just . PackageName) "package" "Package name to add as dependency"
     pursArgs        = many $ CLI.opt (Just . ExtraArg) "purs-args" 'u' "Argument to pass to purs"
-
-    buildOptions  = BuildOptions <$> cacheFlag <*> watch <*> clearScreen <*> sourcePaths <*> noInstall <*> pursArgs <*> depsOnly
+    useSharedOutput = bool ShareOutput NoShareOutput <$> CLI.switch "no-share-output" 'S' "Disabled using a shared output folder in location of root packages.dhall"
+    buildOptions  = BuildOptions <$> cacheFlag <*> watch <*> clearScreen <*> sourcePaths <*> noInstall <*> pursArgs <*> depsOnly <*> useSharedOutput
 
     -- Note: by default we limit concurrency to 20
     globalOptions = GlobalOptions <$> verbose <*> usePsa <*> fmap (fromMaybe 20) jobsLimit <*> fmap (fromMaybe Config.defaultPath) configPath

src/Spago/Build.hs

@@ -10,6 +10,7 @@ module Spago.Build
   , Watch (..)
   , NoBuild (..)
   , NoInstall (..)
+  , ShareOutput (..)
   , BuildOptions (..)
   , Packages.DepsOnly (..)
   , NoSearch (..)
@@ -43,8 +44,8 @@ import qualified Spago.Purs           as Purs
 import qualified Spago.Templates      as Templates
 import qualified Spago.Watch          as Watch
 
-import           Spago.Types          as PackageSet
-
+import qualified Spago.PackageSet     as PackageSet
+import           Spago.Types          as Types
 
 data Watch = Watch | BuildOnce
 
@@ -55,6 +56,9 @@ data NoBuild = NoBuild | DoBuild
 -- | Flag to skip the automatic installation of libraries on build
 data NoInstall = NoInstall | DoInstall
 
+-- | Flag to use shared output folder if possible
+data ShareOutput = ShareOutput | NoShareOutput
+
 data BuildOptions = BuildOptions
   { cacheConfig :: Maybe GlobalCache.CacheFlag
   , shouldWatch :: Watch
@@ -63,6 +67,7 @@ data BuildOptions = BuildOptions
   , noInstall   :: NoInstall
   , pursArgs    :: [Purs.ExtraArg]
   , depsOnly    :: Packages.DepsOnly
+  , shareOutput :: ShareOutput
   }
 
 prepareBundleDefaults
@@ -74,25 +79,25 @@ prepareBundleDefaults maybeModuleName maybeTargetPath = (moduleName, targetPath)
     moduleName = fromMaybe (Purs.ModuleName "Main") maybeModuleName
     targetPath = fromMaybe (Purs.TargetPath "index.js") maybeTargetPath
 
-
--- | Build the project with purs, passing through additional args and
 --   eventually running some other action after the build
 build :: Spago m => BuildOptions -> Maybe (m ()) -> m ()
-build BuildOptions{..} maybePostBuild = do
+build buildOpts@BuildOptions{..} maybePostBuild = do
   echoDebug "Running `spago build`"
-  config@Config.Config{ packageSet = PackageSet.PackageSet{..}, ..} <- Config.ensureConfig
+  config@Config.Config{ packageSet = Types.PackageSet{..}, ..} <- Config.ensureConfig
   deps <- Packages.getProjectDeps config
   case noInstall of
     DoInstall -> Fetch.fetchPackages cacheConfig deps packagesMinPursVersion
     NoInstall -> pure ()
-
+  sharedOutputArgs <- case shareOutput of
+    ShareOutput   -> getBuildArgsForSharedFolder buildOpts
+    NoShareOutput -> pure []
   let allPsGlobs = Packages.getGlobs   deps depsOnly configSourcePaths <> sourcePaths
       allJsGlobs = Packages.getJsGlobs deps depsOnly configSourcePaths <> sourcePaths
 
       buildAction globs = do
         case alternateBackend of
           Nothing ->
-              Purs.compile globs pursArgs
+              Purs.compile globs sharedOutputArgs
           Just backend -> do
               when (Purs.ExtraArg "--codegen" `List.elem` pursArgs) $
                 die "Can't pass `--codegen` option to build when using a backend. Hint: No need to pass `--codegen corefn` explicitly when using the `backend` option. Remove the argument to solve the error"
@@ -133,12 +138,11 @@ build BuildOptions{..} maybePostBuild = do
     wrap   = Purs.SourcePath . Text.pack
     unwrap = Text.unpack . Purs.unSourcePath
 
-
 -- | Start a repl
 repl
   :: Spago m
   => Maybe GlobalCache.CacheFlag
-  -> [PackageSet.PackageName]
+  -> [Types.PackageName]
   -> [Purs.SourcePath]
   -> [Purs.ExtraArg]
   -> Packages.DepsOnly
@@ -159,7 +163,7 @@ repl cacheFlag newPackages sourcePaths pursArgs depsOnly = do
 
         Packages.initProject False Dhall.WithComments
 
-        config@Config.Config{ packageSet = PackageSet.PackageSet{..}, ..} <- Config.ensureConfig
+        config@Config.Config{ packageSet = Types.PackageSet{..}, ..} <- Config.ensureConfig
 
         let updatedConfig = Config.Config name (dependencies <> newPackages) (Config.packageSet config) alternateBackend configSourcePaths publishConfig
 
@@ -193,15 +197,18 @@ runWithNode
   -> m ()
 runWithNode defaultModuleName maybeSuccessMessage failureMessage maybeModuleName buildOpts nodeArgs = do
   echoDebug "Running NodeJS"
-  build buildOpts (Just nodeAction)
+  outputPath <- getOutputPath buildOpts
+  build buildOpts (Just (nodeAction outputPath))
   where
     moduleName = fromMaybe defaultModuleName maybeModuleName
     args = Text.intercalate " " $ map Purs.unExtraArg nodeArgs
-    contents = "#!/usr/bin/env node\n\n" <> "require('../output/" <> Purs.unModuleName moduleName <> "').main()"
+    contents = \outputPath'
+      -> let path = fromMaybe "output" outputPath'
+         in "#!/usr/bin/env node\n\n" <> "require('../" <> Text.pack path <> "/" <> Purs.unModuleName moduleName <> "').main()"
     cmd = "node .spago/run.js " <> args
-    nodeAction = do
+    nodeAction outputPath' = do
       echoDebug $ "Writing .spago/run.js"
-      writeTextFile ".spago/run.js" contents
+      writeTextFile ".spago/run.js" (contents outputPath')
       chmod executable ".spago/run.js"
       shell cmd empty >>= \case
         ExitSuccess   -> fromMaybe (pure ()) (echo <$> maybeSuccessMessage)
@@ -319,3 +326,63 @@ search = do
   let cmd = "node .spago/purescript-docs-search search"
   echoDebug $ "Running `" <> cmd <> "`"
   viewShell $ callCommand $ Text.unpack cmd
+
+
+-- | Find the output path for purs compiler
+-- | This is based on the location of packages.dhall, the shareOutput flag
+-- | and whether the user has manually specified a path in pursArgs
+getOutputPath
+  :: Spago m
+  => BuildOptions
+  -> m (Maybe Sys.FilePath)
+getOutputPath buildOpts = do
+  configPath <- asks globalConfigPath
+  outputPath <- PackageSet.findRootOutputPath (Text.unpack configPath)
+  case findOutputFlag (pursArgs buildOpts) of
+    Just path -> pure (Just path)
+    Nothing   ->
+      case shareOutput buildOpts of
+        NoShareOutput -> pure Nothing
+        ShareOutput   -> pure outputPath
+
+-- | Find an output flag and then return the next item
+-- | which should be the output folder
+findOutputFlag :: [Purs.ExtraArg] -> Maybe Sys.FilePath
+findOutputFlag [] = Nothing
+findOutputFlag (_:[]) = Nothing
+findOutputFlag (x:y:xs)
+  = if isOutputFlag x
+    then Just $ Text.unpack (Purs.unExtraArg y)
+    else findOutputFlag (y : xs)
+
+-- | is this argument specifying an output folder?
+isOutputFlag :: Purs.ExtraArg -> Bool
+isOutputFlag (Purs.ExtraArg a)
+  =  firstWord == "-o"
+  || firstWord == "--output"
+    where
+      firstWord
+        = fromMaybe "" $ case Text.words a of
+             []       -> Nothing
+             (word:_) -> Just word
+
+-- | If we aren't using the --no-share-output flag, calculate the extra args to
+-- | send to Purs compile
+getBuildArgsForSharedFolder
+  :: Spago m
+  => BuildOptions
+  -> m [Purs.ExtraArg]
+getBuildArgsForSharedFolder buildOpts = do
+  let pursArgs'
+        = pursArgs buildOpts
+      pathToOutputArg
+        = Purs.ExtraArg . Text.pack . ((++) "--output ")
+  if (or $ isOutputFlag <$> pursArgs')
+    then do
+      echo "Output path set explicitly - not using shared output path"
+      pure pursArgs'
+    else do
+      outputFolder <- getOutputPath buildOpts
+      case pathToOutputArg <$> outputFolder of
+        Just newArg -> pure (pursArgs' <> [newArg])
+        _           -> pure pursArgs'

src/Spago/PackageSet.hs

@@ -5,6 +5,7 @@ module Spago.PackageSet
   , freeze
   , ensureFrozen
   , packagesPath
+  , findRootOutputPath
   ) where
 
 import           Spago.Prelude
@@ -20,7 +21,7 @@ import           Spago.Messages      as Messages
 import qualified Spago.Purs          as Purs
 import qualified Spago.Templates     as Templates
 import qualified System.IO
-
+import qualified System.FilePath
 
 packagesPath :: IsString t => t
 packagesPath = "packages.dhall"
@@ -220,6 +221,42 @@ localImportPath (Dhall.Import
 localImportPath _ = Nothing
 
 
+rootPackagePath :: Dhall.Import -> Maybe System.IO.FilePath
+rootPackagePath (Dhall.Import
+  { importHashed = Dhall.ImportHashed
+    { importType = localImport@(Dhall.Local _ Dhall.File { file = "packages.dhall" })
+    }
+  , Dhall.importMode = Dhall.Code
+  })              = Just $ Text.unpack $ pretty localImport
+rootPackagePath _ = Nothing
+
+
+-- | In a Monorepo we don't wish to rebuild our shared packages over and over, 
+-- | so we build into an output folder where our root packages.dhall lives
+findRootOutputPath :: Spago m => System.IO.FilePath -> m (Maybe System.IO.FilePath)
+findRootOutputPath path = do
+  echoDebug "Locating root path of packages.dhall"
+  imports <- liftIO $ Dhall.readImports $ Text.pack path
+  let localImports = mapMaybe rootPackagePath imports
+  pure $ (flip System.FilePath.replaceFileName) "output" <$> (findRootPath localImports)
+
+-- | Given a list of filepaths, find the one with the least folders
+findRootPath :: [System.IO.FilePath] -> Maybe System.IO.FilePath
+findRootPath paths 
+  = foldr comparePaths Nothing paths
+  where
+    isLessThan :: Ord a => a -> Maybe a -> Bool
+    isLessThan a maybeA
+      = isNothing maybeA 
+      || fromMaybe False (fmap (\a' -> a < a') maybeA)
+
+    comparePaths path current 
+      = if isLessThan 
+          (length (System.FilePath.splitSearchPath path))
+          (length <$> current)
+        then Just path
+        else current
+
 -- | Freeze the package set remote imports so they will be cached
 freeze :: Spago m => System.IO.FilePath -> m ()
 freeze path = do