@@ -13,6 +13,7 @@ import qualified Control.Foldl as Foldl
13
13
import Control.Concurrent.Async (forConcurrently_ , mapConcurrently )
14
14
import Control.Concurrent.QSem (newQSem , signalQSem , waitQSem )
15
15
import Control.Exception (bracket_ )
16
+ import Control.Monad (filterM )
16
17
import qualified Data.Aeson as Aeson
17
18
import Data.Aeson.Encode.Pretty
18
19
import Data.Either.Combinators (rightToMaybe )
@@ -57,6 +58,10 @@ packageFile = "psc-package.json"
57
58
localPackageSet :: Path. FilePath
58
59
localPackageSet = " packages.json"
59
60
61
+ packageDir :: Text -> PackageName -> Text -> Turtle. FilePath
62
+ packageDir set pkgName version =
63
+ " .psc-package" </> fromText set </> fromText (runPackageName pkgName) </> fromText version
64
+
60
65
data PackageConfig = PackageConfig
61
66
{ name :: PackageName
62
67
, depends :: [PackageName ]
@@ -191,7 +196,7 @@ writeLocalPackageSet = writeTextFile localPackageSet . packageSetToJSON
191
196
192
197
performInstall :: Text -> PackageName -> PackageInfo -> IO Turtle. FilePath
193
198
performInstall set pkgName PackageInfo { repo, version } = do
194
- let pkgDir = " .psc-package " </> fromText set </> fromText (runPackageName pkgName) </> fromText version
199
+ let pkgDir = packageDir set pkgName version
195
200
exists <- testdir pkgDir
196
201
unless exists . void $ do
197
202
echoT (" Installing " <> runPackageName pkgName)
@@ -243,14 +248,21 @@ installImpl :: PackageConfig -> Maybe Int -> IO ()
243
248
installImpl config@ PackageConfig { depends } limitJobs = do
244
249
getPackageSet config
245
250
db <- readPackageSet config
246
- trans <- getTransitiveDeps db depends
247
- echoT (" Installing " <> pack (show (length trans)) <> " packages..." )
251
+ newPkgs <- getNewPackages db
252
+ when (length newPkgs > 1 ) $ do
253
+ echoT (" Installing " <> pack (show (length newPkgs)) <> " new packages..." )
248
254
case limitJobs of
249
255
Nothing ->
250
- forConcurrently_ trans . uncurry $ performInstall $ set config
256
+ forConcurrently_ newPkgs . uncurry $ performInstall $ set config
251
257
Just max' -> do
252
258
sem <- newQSem max'
253
- forConcurrently_ trans . uncurry . (\ x y z -> bracket_ (waitQSem sem) (signalQSem sem) (performInstall x y z)) $ set config
259
+ forConcurrently_ newPkgs . uncurry . (\ x y z -> bracket_ (waitQSem sem) (signalQSem sem) (performInstall x y z)) $ set config
260
+ where
261
+ getNewPackages db =
262
+ getTransitiveDeps db depends >>= filterM isNewPackage
263
+
264
+ isNewPackage (name, info) =
265
+ fmap not $ testdir $ packageDir (set config) name (version info)
254
266
255
267
getPureScriptVersion :: IO Version
256
268
getPureScriptVersion = do
@@ -355,11 +367,7 @@ listPackages sorted = do
355
367
getSourcePaths :: PackageConfig -> PackageSet -> [PackageName ] -> IO [Turtle. FilePath ]
356
368
getSourcePaths PackageConfig {.. } db pkgNames = do
357
369
trans <- getTransitiveDeps db pkgNames
358
- let paths = [ " .psc-package"
359
- </> fromText set
360
- </> fromText (runPackageName pkgName)
361
- </> fromText version
362
- </> " src" </> " **" </> " *.purs"
370
+ let paths = [ packageDir set pkgName version </> " src" </> " **" </> " *.purs"
363
371
| (pkgName, PackageInfo { version }) <- trans
364
372
]
365
373
return paths
0 commit comments