4624ae2 · stackage · git.iko.soy

Stackage/Build.hs+7−5

compare with master

unifiedsplit

@@ -5,6 +5,7 @@ module Stackage.Build

5import Control.Monad (unless)

6import Stackage.CheckPlan

7import Stackage.InstallInfo

8+import Stackage.Tarballs

8import Stackage.Test

9import Stackage.Test

9import Stackage.Util

10import Stackage.Util

10import System.Exit (ExitCode (ExitSuccess), exitWith)

11import System.Exit (ExitCode (ExitSuccess), exitWith)

@@ -14,17 +15,18 @@ import System.Process (runProcess, waitForProcess)

14build :: IO ()

15build :: IO ()

15build = do

16build = do

16 ii <- getInstallInfo

17 ii <- getInstallInfo

18+

17 checkPlan ii

19 checkPlan ii

20+ putStrLn "No mismatches, starting the sandboxed build."

18

21

19 rm_r "cabal-dev"

22 rm_r "cabal-dev"

20−

21− putStrLn "No mismatches, good to go!"

22−

23 ph <- withBinaryFile "build.log" WriteMode $ \handle ->

24 runProcess "cabal-dev" ("install":"-fnetwork23":iiPackageList ii) Nothing Nothing Nothing (Just handle) (Just handle)

25 ec <- waitForProcess ph

26 unless (ec == ExitSuccess) $ exitWith ec

27

28− putStrLn "Environment built, beginning individual test suites"

28+ putStrLn "Sandbox built, beginning individual test suites"

29−

30 runTestSuites ii

29 runTestSuites ii

30+

31+ putStrLn "All test suites that were expected to pass did pass, building tarballs."

32+ makeTarballs ii

Stackage/Init.hsnew file+32

@@ -0,0 +1,32 @@

1+module Stackage.Init (stackageInit) where

2+

3+import Data.List (isInfixOf, isPrefixOf)

4+import Stackage.Util

5+import System.FilePath ((</>))

6+

7+stackageInit :: IO ()

8+stackageInit = do

9+ c <- getCabalRoot

10+ let config = c </> "config"

11+ orig <- readFile config

12+ -- bypass laziness

13+ _ <- return $! length orig

14+ writeFile config $ unlines $ go $ lines orig

15+ where

16+ go = addStackage

17+ . map commentHackage

18+ . filter (\s -> not $ "stackage" `isInfixOf` s)

19+

20+ addStackage [] = stackageLines []

21+ addStackage (l:ls)

22+ | "remote-repo-cache:" `isPrefixOf` l = stackageLines $ l : ls

23+ | otherwise = l : addStackage ls

24+

25+ stackageLines x =

26+ "remote-repo: stackage:http://hackage.haskell.org/packages/archive"

27+ : "remote-repo: stackage-extra:http://hackage.haskell.org/packages/archive"

28+ : x

29+

30+ commentHackage s

31+ | s == "remote-repo: hackage.haskell.org:http://hackage.haskell.org/packages/archive" = "--" ++ s

32+ | otherwise = s

Stackage/LoadDatabase.hs+3−20

@@ -1,12 +1,9 @@

1module Stackage.LoadDatabase where

2

3import qualified Codec.Archive.Tar as Tar

4−import qualified Codec.Archive.Tar.Entry as TarEntry

5import Control.Exception (throwIO)

4import Control.Exception (throwIO)

6−import Control.Monad (guard)

7import qualified Data.ByteString.Lazy as L

5import qualified Data.ByteString.Lazy as L

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

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

9−import Data.List (stripPrefix)

10import qualified Data.Map as Map

7import qualified Data.Map as Map

11import Data.Monoid (Monoid (..))

8import Data.Monoid (Monoid (..))

12import Data.Set (member)

9import Data.Set (member)

@@ -18,11 +15,9 @@ import Distribution.PackageDescription (condExecutables,

18 condTreeConstraints)

15 condTreeConstraints)

19import Distribution.PackageDescription.Parse (ParseResult (ParseOk),

16import Distribution.PackageDescription.Parse (ParseResult (ParseOk),

20 parsePackageDescription)

17 parsePackageDescription)

21−import Distribution.Text (simpleParse)

22import Distribution.Version (withinRange)

18import Distribution.Version (withinRange)

23import Stackage.Types

19import Stackage.Types

24−import System.Directory (getAppUserDataDirectory)

20+import Stackage.Util

25−import System.FilePath ((</>))

26

21

27-- | Load the raw package database.

22-- | Load the raw package database.

28--

23--

@@ -39,8 +34,7 @@ loadPackageDB :: Set PackageName -- ^ core packages

39 -> Map PackageName VersionRange -- ^ additional deps

34 -> Map PackageName VersionRange -- ^ additional deps

40 -> IO PackageDB

35 -> IO PackageDB

41loadPackageDB core deps = do

36loadPackageDB core deps = do

42− c <- getAppUserDataDirectory "cabal"

37+ tarName <- getTarballName

43− let tarName = c </> "packages" </> "hackage.haskell.org" </> "00-index.tar"

44 lbs <- L.readFile tarName

38 lbs <- L.readFile tarName

45 addEntries mempty $ Tar.read lbs

39 addEntries mempty $ Tar.read lbs

46 where

40 where

@@ -51,7 +45,7 @@ loadPackageDB core deps = do

51

45

52 addEntry :: PackageDB -> Tar.Entry -> IO PackageDB

46 addEntry :: PackageDB -> Tar.Entry -> IO PackageDB

53 addEntry pdb e =

47 addEntry pdb e =

54− case getPackageVersion $ TarEntry.fromTarPathToPosixPath (TarEntry.entryTarPath e) of

48+ case getPackageVersion e of

55 Nothing -> return pdb

49 Nothing -> return pdb

56 Just (p, v)

50 Just (p, v)

57 | p `member` core -> return pdb

51 | p `member` core -> return pdb

@@ -78,14 +72,3 @@ loadPackageDB core deps = do

78 _ -> mempty

72 _ -> mempty

79 where

73 where

80 go = Set.fromList . map (\(Dependency p _) -> p) . condTreeConstraints

74 go = Set.fromList . map (\(Dependency p _) -> p) . condTreeConstraints

81−

82− getPackageVersion :: FilePath -> Maybe (PackageName, Version)

83− getPackageVersion fp = do

84− let (package', s1) = break (== '/') fp

85− package = PackageName package'

86− s2 <- stripPrefix "/" s1

87− let (version', s3) = break (== '/') s2

88− version <- simpleParse version'

89− s4 <- stripPrefix "/" s3

90− guard $ s4 == package' ++ ".cabal"

91− Just (package, version)

Stackage/Tarballs.hsnew file+44

@@ -0,0 +1,44 @@

1+module Stackage.Tarballs

2+ ( makeTarballs

3+ ) where

4+

5+import qualified Codec.Archive.Tar as Tar

6+import Control.Exception (throwIO)

7+import qualified Data.ByteString.Lazy as L

8+import qualified Data.Map as Map

9+import qualified Data.Set as Set

10+import Stackage.Types

11+import Stackage.Util

12+import System.Directory (createDirectoryIfMissing)

13+import System.FilePath (takeDirectory)

14+

15+makeTarballs :: InstallInfo -> IO ()

16+makeTarballs ii = do

17+ tarName <- getTarballName

18+ origEntries <- fmap Tar.read $ L.readFile tarName

19+ (stableEntries, extraEntries) <- loop id id origEntries

20+

21+ (stableTar, extraTar) <- getStackageTarballNames

22+

23+ createDirectoryIfMissing True $ takeDirectory stableTar

24+ L.writeFile stableTar $ Tar.write stableEntries

25+

26+ createDirectoryIfMissing True $ takeDirectory extraTar

27+ L.writeFile extraTar $ Tar.write extraEntries

28+ where

29+ loop _ _ (Tar.Fail err) = throwIO err

30+ loop stable extra Tar.Done = return (stable [], extra [])

31+ loop stable extra (Tar.Next e es) =

32+ loop stable' extra' es

33+ where

34+ (stable', extra') =

35+ case getPackageVersion e of

36+ Nothing -> (stable, extra)

37+ Just (package, version) ->

38+ case Map.lookup package $ iiPackages ii of

39+ Just version'

40+ | version == version' -> (stable . (e:), extra)

41+ | otherwise -> (stable, extra)

42+ Nothing

43+ | package `Set.member` iiCore ii -> (stable, extra)

44+ | otherwise -> (stable, extra . (e:))

Stackage/Test.hs+2−4

@@ -2,7 +2,7 @@ module Stackage.Test

2 ( runTestSuites

3 ) where

4

5−import Control.Monad (foldM, when)

5+import Control.Monad (foldM, unless, when)

6import qualified Data.Map as Map

7import qualified Data.Set as Set

8import Stackage.Config

@@ -21,9 +21,7 @@ runTestSuites ii = do

21 rm_r testdir

22 createDirectory testdir

23 allPass <- foldM (runTestSuite testdir) True $ Map.toList $ iiPackages ii

24− if allPass

25− then putStrLn "All test suites that were expected to pass did pass"

26− else error $ "There were failures, please see the logs in " ++ testdir

24+ unless allPass $ error $ "There were failures, please see the logs in " ++ testdir

27

25

28runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool

26runTestSuite :: FilePath -> Bool -> (PackageName, Version) -> IO Bool

29runTestSuite testdir prevPassed pair@(packageName, _) = do

27runTestSuite testdir prevPassed pair@(packageName, _) = do

Stackage/Util.hs+46−7

@@ -1,13 +1,19 @@

1module Stackage.Util where

2

3+import qualified Codec.Archive.Tar as Tar

4+import qualified Codec.Archive.Tar.Entry as TarEntry

3−import Control.Monad (when)

5+import Control.Monad (guard, when)

6+import Data.List (stripPrefix)

4−import qualified Data.Map as Map

7+import qualified Data.Map as Map

5−import qualified Data.Set as Set

8+import qualified Data.Set as Set

6−import Data.Version (showVersion)

9+import Data.Version (showVersion)

7−import Distribution.Version (thisVersion)

10+import Distribution.Text (simpleParse)

11+import Distribution.Version (thisVersion)

8import Stackage.Types

12import Stackage.Types

9−import System.Directory (doesDirectoryExist,

13+import System.Directory (doesDirectoryExist,

10− removeDirectoryRecursive)

14+ removeDirectoryRecursive)

15+import System.Directory (getAppUserDataDirectory)

16+import System.FilePath ((</>))

11

17

12identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange

18identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange

13identsToRanges =

19identsToRanges =

@@ -22,3 +28,36 @@ rm_r :: FilePath -> IO ()

22rm_r fp = do

28rm_r fp = do

23 exists <- doesDirectoryExist fp

29 exists <- doesDirectoryExist fp

24 when exists $ removeDirectoryRecursive fp

30 when exists $ removeDirectoryRecursive fp

31+

32+getCabalRoot :: IO FilePath

33+getCabalRoot = getAppUserDataDirectory "cabal"

34+

35+-- | Name of the 00-index.tar downloaded from Hackage.

36+getTarballName :: IO FilePath

37+getTarballName = do

38+ c <- getCabalRoot

39+ return $ c </> "packages" </> "hackage.haskell.org" </> "00-index.tar"

40+

41+stableRepoName, extraRepoName :: String

42+stableRepoName = "stackage"

43+extraRepoName = "stackage-extra"

44+

45+-- | Locations for the stackage and stackage-extra tarballs

46+getStackageTarballNames :: IO (FilePath, FilePath)

47+getStackageTarballNames = do

48+ c <- getCabalRoot

49+ let f x = c </> "packages" </> x </> "00-index.tar"

50+ return (f stableRepoName, f extraRepoName)

51+

52+getPackageVersion :: Tar.Entry -> Maybe (PackageName, Version)

53+getPackageVersion e = do

54+ let (package', s1) = break (== '/') fp

55+ package = PackageName package'

56+ s2 <- stripPrefix "/" s1

57+ let (version', s3) = break (== '/') s2

58+ version <- simpleParse version'

59+ s4 <- stripPrefix "/" s3

60+ guard $ s4 == package' ++ ".cabal"

61+ Just (package, version)

62+ where

63+ fp = TarEntry.fromTarPathToPosixPath $ TarEntry.entryTarPath e

app/stackage.hs+16−2

@@ -1,4 +1,18 @@

1−import Stackage.Build (build)

1+import Stackage.Build (build)

2+import Stackage.Init (stackageInit)

3+import System.Environment (getArgs, getProgName)

2

4

3main :: IO ()

5main :: IO ()

4−main = build

6+main = do

7+ args <- getArgs

8+ case args of

9+ ["build"] -> build

10+ ["init"] -> stackageInit

11+ ["update"] -> stackageInit >> error "FIXME update"

12+ _ -> do

13+ pn <- getProgName

14+ putStrLn $ "Usage: " ++ pn ++ " <command>"

15+ putStrLn "Available commands:"

16+ putStrLn " update Download updated Stackage databases. Automatically calls init."

17+ putStrLn " init Initialize your cabal file to use Stackage"

18+ putStrLn " build Build the package databases (maintainers only)"

stackage.cabal+2

@@ -23,8 +23,10 @@ library

23 Stackage.Config

24 Stackage.InstallInfo

25 Stackage.CheckPlan

26+ Stackage.Tarballs

26 Stackage.Test

27 Stackage.Test

27 Stackage.Build

28 Stackage.Build

29+ Stackage.Init

28 build-depends: base >= 4 && < 5

30 build-depends: base >= 4 && < 5

29 , containers

31 , containers

30 , Cabal

32 , Cabal