Generate GIT-REPO#version versions in bower.json for packages that are not found in Bower.

app/Spago.hs

@@ -64,7 +64,7 @@ data Command
   | Test (Maybe ModuleName) BuildOptions [ExtraArg]
 
   -- | Bump and tag a new version in preparation for release.
-  | BumpVersion DryRun VersionBump
+  | BumpVersion (Maybe Int) DryRun VersionBump
 
   -- | Run the project with some module, default Main
   | Run (Maybe ModuleName) BuildOptions [ExtraArg]
@@ -289,7 +289,7 @@ parser = do
     bumpVersion =
       ( "bump-version"
       , "Bump and tag a new version, and generate bower.json, in preparation for release."
-      , BumpVersion <$> dryRun <*> versionBump
+      , BumpVersion <$> limitJobs <*> dryRun <*> versionBump
       )
 
 
@@ -364,7 +364,7 @@ main = do
       Freeze                                -> Spago.Packages.freeze
       Build buildOptions                    -> Spago.Build.build buildOptions Nothing
       Test modName buildOptions nodeArgs    -> Spago.Build.test modName buildOptions nodeArgs
-      BumpVersion dryRun spec               -> Version.bumpVersion dryRun spec
+      BumpVersion limitJobs dryRun spec     -> Version.bumpVersion limitJobs dryRun spec
       Run modName buildOptions nodeArgs     -> Spago.Build.run modName buildOptions nodeArgs
       Repl limitJobs cacheConfig replPackageNames paths pursArgs -> Spago.Build.repl limitJobs cacheConfig replPackageNames paths pursArgs
       BundleApp modName tPath shouldBuild buildOptions

appveyor.yml

@@ -21,7 +21,6 @@ install:
   - stack setup > nul
   - choco install psc-package
   - npm install -g bower purescript-psa
-  - set PATH=%APPDATA%\npm;%PATH%
   - ps: |
       $releases = "https://api.github.com/repos/purescript/purescript/releases"
       $tag = "v0.13.2"

package.yaml

@@ -44,6 +44,7 @@ library:
   dependencies:
   - base >= 4.7 && < 5
   - text < 1.3
+  - Cabal
   - turtle
   - filepath
   - file-embed
@@ -78,6 +79,7 @@ library:
   - http-conduit
   - time
   - ansi-terminal
+  - unordered-containers
 
 executables:
   spago:

src/Spago/Bower.hs

@@ -9,17 +9,21 @@ import Spago.Prelude
 import qualified Data.Aeson                 as Aeson
 import qualified Data.Aeson.Encode.Pretty   as Pretty
 import qualified Data.ByteString.Lazy       as ByteString
-import qualified Data.Map                   as Map
+import qualified Data.HashMap.Strict        as HashMap
 import           Data.String                (IsString)
+import qualified Data.Text                  as Text
+import           Data.Text.Lazy             (fromStrict)
+import           Data.Text.Lazy.Encoding    (encodeUtf8)
+import qualified Distribution.System        as System
+import           Distribution.System        (OS (..))
+import qualified Turtle
 import           Web.Bower.PackageMeta      (PackageMeta (..))
 import qualified Web.Bower.PackageMeta      as Bower
 
 import           Spago.Config               (Config (..), PublishConfig (..))
 import qualified Spago.Config               as Config
 import           Spago.DryRun               (DryRun (..))
 import qualified Spago.Git                  as Git
-import qualified Spago.GlobalCache          as GlobalCache
-import           Spago.GlobalCache          (RepoMetadataV1 (..), Tag (..))
 import qualified Spago.Packages             as Packages
 import           Spago.PackageSet           (PackageName (..), Package (..), Repo (..))
 import qualified Spago.Templates            as Templates
@@ -29,13 +33,25 @@ bowerPath :: IsString t => t
 bowerPath = "bower.json"
 
 
-writeBowerJson :: Spago m => DryRun -> m ()
-writeBowerJson dryRun = do
+runBower :: Spago m => [Text] -> m (ExitCode, Text, Text)
+runBower args = do
+  -- workaround windows issue: https://github.com/haskell/process/issues/140
+  cmd <- case System.buildOS of
+    Windows -> do
+      let bowers = Turtle.inproc "where" ["bower.cmd"] empty
+      Turtle.lineToText <$> Turtle.single (Turtle.limit 1 bowers)
+    _ ->
+      pure "bower"
+  Turtle.procStrictWithErr cmd args empty
+
+
+writeBowerJson :: Spago m => Maybe Int -> DryRun -> m ()
+writeBowerJson limitJobs dryRun = do
   config@Config{..} <- Config.ensureConfig
   PublishConfig{..} <- Config.ensurePublishConfig
 
   bowerName <- mkPackageName name
-  bowerDependencies <- mkDependencies config
+  bowerDependencies <- mkDependencies limitJobs config
   template <- templateBowerJson
 
   let bowerLicense = [license]
@@ -87,23 +103,44 @@ mkPackageName spagoName = do
       pure name
 
 
-mkDependencies :: Spago m => Config -> m [(Bower.PackageName, Bower.VersionRange)]
-mkDependencies config = do
+-- | If the given version exists in bower, return a shorthand bower
+-- | version, otherwise return a URL#version style bower version.
+mkBowerVersion :: Spago m => Bower.PackageName -> Text -> Text -> m Bower.VersionRange
+mkBowerVersion packageName version repo = do
 
-  reposMeta <- GlobalCache.getMetadata Nothing
-  deps <- Packages.getDirectDeps config
+  let args = ["info", "--json", Bower.runPackageName packageName <> "#" <> version]
+  (code, stdout, stderr) <- runBower args
+
+  when (code /= ExitSuccess) $ do
+    die $ "Failed to run: `bower " <> Text.intercalate " " args <> "`\n" <> stderr
 
-  for deps $ \(PackageName{..}, Package{..}) -> do
-    case repo of
-      Local path ->
-        die $ "Unable to create Bower version for local repo: " <> path
-      Remote _ | not (isTag packageName version reposMeta) ->
-        die $ "Unable to create Bower version from non-tag version: " <> packageName <> " " <> version
-      Remote _ -> do
-        bowerName <- mkPackageName packageName
-        pure (bowerName, Bower.VersionRange $ "^" <> version)
+  info <- case Aeson.decode $ encodeUtf8 $ fromStrict stdout of
+    Just (Object obj) -> pure obj
+    _ -> die $ "Unable to decode output from `bower " <> Text.intercalate " " args <> "`: " <> stdout
+
+  if HashMap.member "version" info
+    then pure $ Bower.VersionRange $ "^" <> version
+    else pure $ Bower.VersionRange $ repo <> "#" <> version
+
+
+mkDependencies :: Spago m => Maybe Int -> Config -> m [(Bower.PackageName, Bower.VersionRange)]
+mkDependencies limitJobs config = do
+  deps <- Packages.getDirectDeps config
+  withTaskGroup' jobs $ \taskGroup ->
+    mapTasks' taskGroup $ mkDependency <$> deps
   where
-    isTag packageName version reposMeta =
-      isJust $ do
-        RepoMetadataV1{..} <- Map.lookup (PackageName packageName) reposMeta
-        Map.lookup (Tag version) tags
+    mkDependency :: Spago m => (PackageName, Package) -> m (Bower.PackageName, Bower.VersionRange)
+    mkDependency (PackageName{..}, Package{..}) =
+      case repo of
+        Local path ->
+          die $ "Unable to create Bower version for local repo: " <> path
+        Remote path -> do
+          bowerName <- mkPackageName packageName
+          bowerVersion <- mkBowerVersion bowerName version path
+          pure (bowerName, bowerVersion)
+
+    jobs = case System.buildOS of
+      -- Windows sucks so lets make it slow for them!
+      -- (just kidding, its a bug: https://github.com/bower/spec/issues/79)
+      Windows -> 1
+      _       -> fromMaybe 10 limitJobs

src/Spago/Prelude.hs

@@ -63,6 +63,7 @@ module Spago.Prelude
   , with
   , appendonly
   , async'
+  , mapTasks'
   , withTaskGroup'
   , Turtle.mktempdir
   , getModificationTime
@@ -198,6 +199,8 @@ withTaskGroup' n action = withRunInIO $ \run -> Async.withTaskGroup n (\taskGrou
 async' :: Spago m => Async.TaskGroup -> m a -> m (Async.Async a)
 async' taskGroup action = withRunInIO $ \run -> Async.async taskGroup (run action)
 
+mapTasks' :: (Spago m, Traversable t) => Async.TaskGroup -> t (m a) -> m (t a)
+mapTasks' taskGroup actions = withRunInIO $ \run -> Async.mapTasks taskGroup (run <$> actions)
 
 -- | Code from: https://github.com/dhall-lang/dhall-haskell/blob/d8f2787745bb9567a4542973f15e807323de4a1a/dhall/src/Dhall/Import.hs#L578
 assertDirectory :: (MonadIO m, MonadThrow m) => FilePath.FilePath -> m ()

src/Spago/Version.hs

@@ -85,16 +85,16 @@ tagNewVersion dryRun oldVersion newVersion = do
 
 
 -- | Bump and tag a new version in preparation for release.
-bumpVersion :: Spago m => DryRun -> VersionBump -> m ()
-bumpVersion dryRun spec = do
+bumpVersion :: Spago m => Maybe Int -> DryRun -> VersionBump -> m ()
+bumpVersion limitJobs dryRun spec = do
   DryRun.showHelp dryRun
 
   Git.requireCleanWorkingTree
 
   oldVersion <- getCurrentVersion
   newVersion <- getNextVersion spec oldVersion
 
-  Bower.writeBowerJson dryRun
+  Bower.writeBowerJson limitJobs dryRun
   Bower.runBowerInstall dryRun
 
   when (dryRun == NoDryRun) $ do

test/BumpVersionSpec.hs

@@ -5,9 +5,10 @@ import qualified System.IO.Temp as Temp
 import           Test.Hspec     (Spec, around_, before_, describe, it, shouldBe)
 import           Turtle         (Text, cp, decodeString, mkdir, mv,
                                  writeTextFile)
-import           Utils          (checkFixture, getHighestTag, git,
-                                 shouldBeFailureInfix, shouldBeSuccess,
-                                 shouldBeSuccessInfix, spago, withCwd)
+import           Utils          (checkFileHasInfix, checkFixture, getHighestTag,
+                                 git, shouldBeFailure, shouldBeFailureInfix,
+                                 shouldBeSuccess, shouldBeSuccessInfix, spago,
+                                 withCwd)
 
 
 -- fix the package set so bower.json is generated with predictable versions
@@ -109,11 +110,11 @@ spec = around_ setup $ do
       spago ["bump-version", "minor"] >>= shouldBeFailureInfix
         "bower.json is being ignored by git - change this before continuing."
 
-    before_ initGit $ it "Spago should fail when spago.dhall references non-tagged dependency" $ do
+    before_ initGit $ it "Spago should generate URL#version for non-tagged dependency" $ do
 
       setOverrides "{ tortellini = upstream.tortellini // { version = \"master\" } }"
-      spago ["bump-version", "minor"] >>= shouldBeFailureInfix
-        "Unable to create Bower version from non-tag version: tortellini master"
+      spago ["bump-version", "--no-dry-run", "minor"] >>= shouldBeFailure
+      checkFileHasInfix "bower.json" "\"purescript-tortellini\": \"https://github.com/justinwoo/purescript-tortellini.git#master\""
 
     before_ initGit $ it "Spago should fail when spago.dhall references local dependency" $ do
 

test/Utils.hs

@@ -1,5 +1,6 @@
 module Utils
   ( checkFixture
+  , checkFileHasInfix
   , readFixture
   , getHighestTag
   , git
@@ -91,6 +92,11 @@ checkFixture path = do
   expected <- readFixture path
   actual `shouldBe` expected
 
+checkFileHasInfix :: HasCallStack => FilePath -> Text -> IO ()
+checkFileHasInfix path needle = do
+  actual <- readTextFile path
+  actual `shouldSatisfy` Text.isInfixOf needle
+
 rmtree :: FilePath -> IO ()
 rmtree = removePathForcibly . encodeString