48c9d56 · stackage · git.iko.soy

Stackage/CheckPlan.hs+19−7

compare with master

unifiedsplit

@@ -2,25 +2,37 @@ module Stackage.CheckPlan

2 ( checkPlan

3 ) where

4

5−import Control.Monad (unless)

5+import Control.Monad (unless, when)

6−import Data.List (sort)

6+import Data.List (isPrefixOf, sort)

7+import qualified Data.Map as Map

8+import qualified Data.Set as Set

7import Stackage.InstallInfo

9import Stackage.InstallInfo

8import Stackage.Types

10import Stackage.Types

11+import Stackage.Util

9−import System.Exit (ExitCode (ExitFailure), exitWith)

12+import System.Exit (ExitCode (ExitFailure, ExitSuccess),

13+ exitWith)

10−import System.Process (readProcess)

14+import System.Process (readProcessWithExitCode)

11

15

12data Mismatch = OnlyDryRun String | OnlySimpleList String

16data Mismatch = OnlyDryRun String | OnlySimpleList String

13 deriving Show

17 deriving Show

14

18

15checkPlan :: InstallInfo -> IO ()

19checkPlan :: InstallInfo -> IO ()

16checkPlan ii = do

20checkPlan ii = do

17− dryRun' <- readProcess "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""

21+ (ec, dryRun', stderr) <- readProcessWithExitCode "cabal-dev" ("install":"--dry-run":"-fnetwork23":iiPackageList ii) ""

22+ when (ec /= ExitSuccess || "Warning:" `isPrefixOf` stderr) $ do

23+ putStr stderr

24+ putStr dryRun'

25+ putStrLn "cabal-dev returned a bad result, exiting"

26+ exitWith ec

18− let dryRun = sort $ drop 2 $ lines dryRun'

27+ let dryRun = sort $ filter notOptionalCore $ map (takeWhile (/= ' ')) $ drop 2 $ lines dryRun'

19− let mismatches = getMismatches dryRun (iiPackageList ii)

28+ let mismatches = getMismatches dryRun (filter notOptionalCore $ iiPackageList ii)

20 unless (null mismatches) $ do

29 unless (null mismatches) $ do

21 putStrLn "Found the following mismtaches"

30 putStrLn "Found the following mismtaches"

22 mapM_ print mismatches

31 mapM_ print mismatches

23 exitWith $ ExitFailure 1

32 exitWith $ ExitFailure 1

33+ where

34+ optionalCore = Set.fromList $ map packageVersionString $ Map.toList $ iiOptionalCore ii

35+ notOptionalCore s = not $ s `Set.member` optionalCore

24

36

25getMismatches :: [String] -> [String] -> [Mismatch]

37getMismatches :: [String] -> [String] -> [Mismatch]

26getMismatches =

38getMismatches =

Stackage/Config.hs−2

@@ -1,11 +1,9 @@

1{-# LANGUAGE CPP #-}

2module Stackage.Config where

3

4−import Control.Monad (unless, when)

5import Control.Monad.Trans.Writer (execWriter, tell)

4import Control.Monad.Trans.Writer (execWriter, tell)

6import qualified Data.Map as Map

5import qualified Data.Map as Map

7import Data.Set (fromList, singleton)

6import Data.Set (fromList, singleton)

8−import Distribution.System (OS (..), buildOS)

9import Distribution.Text (simpleParse)

7import Distribution.Text (simpleParse)

10import Stackage.Types

8import Stackage.Types

11

9

Stackage/InstallInfo.hs+1

@@ -28,6 +28,7 @@ getInstallInfo = do

28 return InstallInfo

29 { iiCore = totalCore

30 , iiPackages = Map.map fst final

31+ , iiOptionalCore = Map.fromList $ map (\(PackageIdentifier p v) -> (p, v)) $ Set.toList $ hplibs hp

31 }

32 }

32

33

33showDep :: (PackageName, (Version, [PackageName])) -> String

34showDep :: (PackageName, (Version, [PackageName])) -> String

Stackage/LoadDatabase.hs−1

@@ -1,7 +1,6 @@

1module Stackage.LoadDatabase where

2

3import qualified Codec.Archive.Tar as Tar

4−import Control.Exception (throwIO)

5import qualified Data.ByteString.Lazy as L

4import qualified Data.ByteString.Lazy as L

6import qualified Data.ByteString.Lazy.Char8 as L8

5import qualified Data.ByteString.Lazy.Char8 as L8

7import qualified Data.Map as Map

6import qualified Data.Map as Map

Stackage/Tarballs.hs−1

@@ -3,7 +3,6 @@ module Stackage.Tarballs

3 ) where

4

5import qualified Codec.Archive.Tar as Tar

6−import Control.Exception (throwIO)

7import qualified Data.ByteString.Lazy as L

6import qualified Data.ByteString.Lazy as L

8import qualified Data.Map as Map

7import qualified Data.Map as Map

9import qualified Data.Set as Set

8import qualified Data.Set as Set

Stackage/Types.hs+4

@@ -42,4 +42,8 @@ instance Monoid HaskellPlatform where

42data InstallInfo = InstallInfo

43 { iiCore :: Set PackageName

44 , iiPackages :: Map PackageName Version

45+ , iiOptionalCore :: Map PackageName Version

46+ -- ^ This is intended to hold onto packages which might be automatically

47+ -- provided in the global package database. In practice, this would be

48+ -- Haskell Platform packages provided by distributions.

45 }

49 }