Skip to content

Commit

Permalink
Only show "Installing n packages" when n > 1. (#130)
Browse files Browse the repository at this point in the history
If there are zero packages to install, show nothing. If there is only
one package, then there is no need to provide an indication of how
long it will take.
  • Loading branch information
Dretch authored and justinwoo committed Jul 23, 2018
1 parent 8c25bb5 commit 0f6a2fb
Showing 1 changed file with 18 additions and 10 deletions.
28 changes: 18 additions & 10 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ import qualified Control.Foldl as Foldl
import Control.Concurrent.Async (forConcurrently_, mapConcurrently)
import Control.Concurrent.QSem (newQSem, signalQSem, waitQSem)
import Control.Exception (bracket_)
import Control.Monad (filterM)
import qualified Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty
import Data.Either.Combinators (rightToMaybe)
Expand Down Expand Up @@ -57,6 +58,10 @@ packageFile = "psc-package.json"
localPackageSet :: Path.FilePath
localPackageSet = "packages.json"

packageDir :: Text -> PackageName -> Text -> Turtle.FilePath
packageDir set pkgName version =
".psc-package" </> fromText set </> fromText (runPackageName pkgName) </> fromText version

data PackageConfig = PackageConfig
{ name :: PackageName
, depends :: [PackageName]
Expand Down Expand Up @@ -191,7 +196,7 @@ writeLocalPackageSet = writeTextFile localPackageSet . packageSetToJSON

performInstall :: Text -> PackageName -> PackageInfo -> IO Turtle.FilePath
performInstall set pkgName PackageInfo{ repo, version } = do
let pkgDir = ".psc-package" </> fromText set </> fromText (runPackageName pkgName) </> fromText version
let pkgDir = packageDir set pkgName version
exists <- testdir pkgDir
unless exists . void $ do
echoT ("Installing " <> runPackageName pkgName)
Expand Down Expand Up @@ -243,14 +248,21 @@ installImpl :: PackageConfig -> Maybe Int -> IO ()
installImpl config@PackageConfig{ depends } limitJobs = do
getPackageSet config
db <- readPackageSet config
trans <- getTransitiveDeps db depends
echoT ("Installing " <> pack (show (length trans)) <> " packages...")
newPkgs <- getNewPackages db
when (length newPkgs > 1) $ do
echoT ("Installing " <> pack (show (length newPkgs)) <> " new packages...")
case limitJobs of
Nothing ->
forConcurrently_ trans . uncurry $ performInstall $ set config
forConcurrently_ newPkgs . uncurry $ performInstall $ set config
Just max' -> do
sem <- newQSem max'
forConcurrently_ trans . uncurry . (\x y z -> bracket_ (waitQSem sem) (signalQSem sem) (performInstall x y z)) $ set config
forConcurrently_ newPkgs . uncurry . (\x y z -> bracket_ (waitQSem sem) (signalQSem sem) (performInstall x y z)) $ set config
where
getNewPackages db =
getTransitiveDeps db depends >>= filterM isNewPackage

isNewPackage (name, info) =
fmap not $ testdir $ packageDir (set config) name (version info)

getPureScriptVersion :: IO Version
getPureScriptVersion = do
Expand Down Expand Up @@ -355,11 +367,7 @@ listPackages sorted = do
getSourcePaths :: PackageConfig -> PackageSet -> [PackageName] -> IO [Turtle.FilePath]
getSourcePaths PackageConfig{..} db pkgNames = do
trans <- getTransitiveDeps db pkgNames
let paths = [ ".psc-package"
</> fromText set
</> fromText (runPackageName pkgName)
</> fromText version
</> "src" </> "**" </> "*.purs"
let paths = [ packageDir set pkgName version </> "src" </> "**" </> "*.purs"
| (pkgName, PackageInfo{ version }) <- trans
]
return paths
Expand Down

0 comments on commit 0f6a2fb

Please sign in to comment.