Initial code
This commit is contained in:
parent
7704a9151c
commit
8825105005
15 changed files with 355 additions and 1 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -5,3 +5,4 @@ cabal-dev
|
|||
*.chi
|
||||
*.chs.h
|
||||
.virthualenv
|
||||
*.swp
|
||||
|
|
3
.gitmodules
vendored
Normal file
3
.gitmodules
vendored
Normal file
|
@ -0,0 +1,3 @@
|
|||
[submodule "haskell-platform"]
|
||||
path = haskell-platform
|
||||
url = https://github.com/haskell/haskell-platform.git
|
20
LICENSE
Normal file
20
LICENSE
Normal file
|
@ -0,0 +1,20 @@
|
|||
Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
@ -1,4 +1,9 @@
|
|||
stackage
|
||||
========
|
||||
|
||||
"Stable Hackage," tools for creating a vetted set of packages from Hackage.
|
||||
"Stable Hackage," tools for creating a vetted set of packages from Hackage.
|
||||
|
||||
A note about the codebase: the goal is to minimize dependencies and have
|
||||
the maximum range of supported compiler versions. Therefore, we avoid
|
||||
anything "complicated." For example, instead of using the text package,
|
||||
we use Strings everywhere.
|
||||
|
|
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
53
Stackage/HaskellPlatform.hs
Normal file
53
Stackage/HaskellPlatform.hs
Normal file
|
@ -0,0 +1,53 @@
|
|||
module Stackage.HaskellPlatform
|
||||
( loadHaskellPlatform
|
||||
) where
|
||||
|
||||
import Control.Monad (guard)
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (foldl', isInfixOf, isPrefixOf, stripPrefix)
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Data.Set (singleton)
|
||||
import Distribution.Text (simpleParse)
|
||||
import Stackage.Types
|
||||
|
||||
loadHaskellPlatform :: IO HaskellPlatform
|
||||
loadHaskellPlatform = fmap parseHP $ readFile "haskell-platform/haskell-platform.cabal"
|
||||
|
||||
data HPLine = HPLPackage PackageIdentifier
|
||||
| HPLBeginCore
|
||||
| HPLEndCore
|
||||
| HPLBeginPlatform
|
||||
| HPLEndPlatform
|
||||
deriving Show
|
||||
|
||||
toHPLine :: String -> Maybe HPLine
|
||||
toHPLine s
|
||||
| "begin core packages" `isInfixOf` s = Just HPLBeginCore
|
||||
| "end core packages" `isInfixOf` s = Just HPLEndCore
|
||||
| "begin platform packages" `isInfixOf` s = Just HPLBeginPlatform
|
||||
| "end platform packages" `isInfixOf` s = Just HPLEndPlatform
|
||||
| otherwise = do
|
||||
let s1 = dropWhile isSpace s
|
||||
guard $ not $ "--" `isPrefixOf` s1
|
||||
guard $ not $ null s1
|
||||
guard $ "==" `isInfixOf` s1
|
||||
let (package', s2) = break (== '=') s1
|
||||
package = takeWhile (not . isSpace) package'
|
||||
s3 <- stripPrefix "==" s2
|
||||
version <- simpleParse $ takeWhile (/= ',') s3
|
||||
Just $ HPLPackage $ PackageIdentifier (PackageName package) version
|
||||
|
||||
parseHP :: String -> HaskellPlatform
|
||||
parseHP =
|
||||
snd . foldl' addLine (notInBlock, mempty) . mapMaybe toHPLine . lines
|
||||
where
|
||||
notInBlock _ = mempty
|
||||
inCore x = HaskellPlatform (singleton x) mempty
|
||||
inPlatform x = HaskellPlatform mempty (singleton x)
|
||||
|
||||
addLine (fromPackage, hp) (HPLPackage vp) = (fromPackage, fromPackage vp `mappend` hp)
|
||||
addLine (_, hp) HPLBeginCore = (inCore, hp)
|
||||
addLine (_, hp) HPLEndCore = (notInBlock, hp)
|
||||
addLine (_, hp) HPLBeginPlatform = (inPlatform, hp)
|
||||
addLine (_, hp) HPLEndPlatform = (notInBlock, hp)
|
92
Stackage/LoadDatabase.hs
Normal file
92
Stackage/LoadDatabase.hs
Normal file
|
@ -0,0 +1,92 @@
|
|||
module Stackage.LoadDatabase where
|
||||
|
||||
import qualified Codec.Archive.Tar as Tar
|
||||
import qualified Codec.Archive.Tar.Entry as TarEntry
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad (guard)
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Char8 as L8
|
||||
import Data.List (stripPrefix)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Data.Set (member)
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Package (Dependency (Dependency))
|
||||
import Distribution.PackageDescription (condBenchmarks,
|
||||
condExecutables,
|
||||
condLibrary,
|
||||
condTestSuites,
|
||||
condTreeConstraints)
|
||||
import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
|
||||
parsePackageDescription)
|
||||
import Distribution.Text (simpleParse)
|
||||
import Distribution.Version (withinRange)
|
||||
import Stackage.Types
|
||||
import System.Directory (getAppUserDataDirectory)
|
||||
import System.FilePath ((</>))
|
||||
|
||||
-- | Load the raw package database.
|
||||
--
|
||||
-- We want to put in some restrictions:
|
||||
--
|
||||
-- * Drop all core packages. We never want to install a new version of
|
||||
-- those, nor include them in the package list.
|
||||
--
|
||||
-- * For packages with a specific version bound, find the maximum matching
|
||||
-- version.
|
||||
--
|
||||
-- * For other packages, select the maximum version number.
|
||||
loadPackageDB :: Set PackageName -- ^ core packages
|
||||
-> Map PackageName VersionRange -- ^ additional deps
|
||||
-> IO PackageDB
|
||||
loadPackageDB core deps = do
|
||||
c <- getAppUserDataDirectory "cabal"
|
||||
let tarName = c </> "packages" </> "hackage.haskell.org" </> "00-index.tar"
|
||||
lbs <- L.readFile tarName
|
||||
addEntries mempty $ Tar.read lbs
|
||||
where
|
||||
addEntries :: PackageDB -> Tar.Entries Tar.FormatError -> IO PackageDB
|
||||
addEntries _ (Tar.Fail e) = throwIO e
|
||||
addEntries db Tar.Done = return db
|
||||
addEntries db (Tar.Next e es) = addEntry db e >>= flip addEntries es
|
||||
|
||||
addEntry :: PackageDB -> Tar.Entry -> IO PackageDB
|
||||
addEntry pdb e =
|
||||
case getPackageVersion $ TarEntry.fromTarPathToPosixPath (TarEntry.entryTarPath e) of
|
||||
Nothing -> return pdb
|
||||
Just (p, v)
|
||||
| p `member` core -> return pdb
|
||||
| otherwise ->
|
||||
case Map.lookup p deps of
|
||||
Just vrange
|
||||
| not $ withinRange v vrange -> return pdb
|
||||
_ ->
|
||||
case Tar.entryContent e of
|
||||
Tar.NormalFile bs _ -> return $ mappend pdb $ PackageDB $ Map.singleton p PackageInfo
|
||||
{ piVersion = v
|
||||
, piDeps = parseDeps bs
|
||||
}
|
||||
_ -> return pdb
|
||||
|
||||
parseDeps lbs =
|
||||
case parsePackageDescription $ L8.unpack lbs of
|
||||
ParseOk _ gpd -> mconcat
|
||||
[ maybe mempty go $ condLibrary gpd
|
||||
, mconcat $ map (go . snd) $ condExecutables gpd
|
||||
, mconcat $ map (go . snd) $ condTestSuites gpd
|
||||
, mconcat $ map (go . snd) $ condBenchmarks gpd
|
||||
]
|
||||
_ -> mempty
|
||||
where
|
||||
go = Set.fromList . map (\(Dependency p _) -> p) . condTreeConstraints
|
||||
|
||||
getPackageVersion :: FilePath -> Maybe (PackageName, Version)
|
||||
getPackageVersion fp = do
|
||||
let (package', s1) = break (== '/') fp
|
||||
package = PackageName package'
|
||||
s2 <- stripPrefix "/" s1
|
||||
let (version', s3) = break (== '/') s2
|
||||
version <- simpleParse version'
|
||||
s4 <- stripPrefix "/" s3
|
||||
guard $ s4 == package' ++ ".cabal"
|
||||
Just (package, version)
|
30
Stackage/NarrowDatabase.hs
Normal file
30
Stackage/NarrowDatabase.hs
Normal file
|
@ -0,0 +1,30 @@
|
|||
module Stackage.NarrowDatabase where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Prelude hiding (pi)
|
||||
import Stackage.Types
|
||||
|
||||
-- | Narrow down the database to only the specified packages and all of
|
||||
-- their dependencies.
|
||||
narrowPackageDB :: PackageDB
|
||||
-> Set PackageName
|
||||
-> IO (Map PackageName Version)
|
||||
narrowPackageDB (PackageDB pdb) =
|
||||
loop Map.empty . Set.map ((,) True)
|
||||
where
|
||||
loop result toProcess =
|
||||
case Set.minView toProcess of
|
||||
Nothing -> return result
|
||||
Just ((isOrig, p), toProcess') ->
|
||||
case Map.lookup p pdb of
|
||||
Nothing
|
||||
| isOrig -> error $ "Unknown package: " ++ show p
|
||||
| otherwise -> loop result toProcess'
|
||||
Just pi -> do
|
||||
let result' = Map.insert p (piVersion pi) result
|
||||
loop result' $ Set.foldl' (addDep result') toProcess' $ piDeps pi
|
||||
addDep result toProcess p =
|
||||
case Map.lookup p result of
|
||||
Nothing -> Set.insert (False, p) toProcess
|
||||
Just{} -> toProcess
|
31
Stackage/PackageList.hs
Normal file
31
Stackage/PackageList.hs
Normal file
|
@ -0,0 +1,31 @@
|
|||
module Stackage.PackageList where
|
||||
|
||||
import Control.Monad (foldM)
|
||||
import Data.Char (isSpace)
|
||||
import qualified Data.Map as Map
|
||||
import Distribution.Text (simpleParse)
|
||||
import Distribution.Version (anyVersion)
|
||||
import Stackage.Types
|
||||
|
||||
loadPackageList :: FilePath -> IO (Map PackageName VersionRange)
|
||||
loadPackageList fp =
|
||||
readFile fp >>= foldM addLine Map.empty . lines
|
||||
where
|
||||
addLine ps l'
|
||||
| null l = return ps
|
||||
| otherwise =
|
||||
case parseVersionRange v' of
|
||||
Nothing -> error $ "Invalid version range: " ++ show (p, v')
|
||||
Just v -> return $ Map.insert (PackageName p) v ps
|
||||
where
|
||||
l = cleanup l'
|
||||
(p, v') = break isSpace l
|
||||
cleanup = dropWhile isSpace . reverse . dropWhile isSpace . reverse . stripComments
|
||||
|
||||
parseVersionRange l
|
||||
| null $ cleanup l = Just anyVersion
|
||||
| otherwise = simpleParse l
|
||||
|
||||
stripComments "" = ""
|
||||
stripComments ('-':'-':_) = ""
|
||||
stripComments (c:cs) = c : stripComments cs
|
40
Stackage/Types.hs
Normal file
40
Stackage/Types.hs
Normal file
|
@ -0,0 +1,40 @@
|
|||
module Stackage.Types
|
||||
( module X
|
||||
, module Stackage.Types
|
||||
) where
|
||||
|
||||
import Data.Map as X (Map)
|
||||
import Data.Map (unionWith)
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Data.Set as X (Set)
|
||||
import Data.Version as X (Version)
|
||||
import Distribution.Package as X (PackageIdentifier (..),
|
||||
PackageName (..))
|
||||
import Distribution.Version as X (VersionRange (..))
|
||||
|
||||
newtype PackageDB = PackageDB (Map PackageName PackageInfo)
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
instance Monoid PackageDB where
|
||||
mempty = PackageDB mempty
|
||||
PackageDB x `mappend` PackageDB y =
|
||||
PackageDB $ unionWith newest x y
|
||||
where
|
||||
newest pi1 pi2
|
||||
| piVersion pi1 > piVersion pi2 = pi1
|
||||
| otherwise = pi2
|
||||
|
||||
data PackageInfo = PackageInfo
|
||||
{ piVersion :: Version
|
||||
, piDeps :: Set PackageName
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data HaskellPlatform = HaskellPlatform
|
||||
{ hpcore :: Set PackageIdentifier
|
||||
, hplibs :: Set PackageIdentifier
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
instance Monoid HaskellPlatform where
|
||||
mempty = HaskellPlatform mempty mempty
|
||||
HaskellPlatform a x `mappend` HaskellPlatform b y = HaskellPlatform (mappend a b) (mappend x y)
|
12
Stackage/Util.hs
Normal file
12
Stackage/Util.hs
Normal file
|
@ -0,0 +1,12 @@
|
|||
module Stackage.Util where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Version (thisVersion)
|
||||
import Stackage.Types
|
||||
|
||||
identsToRanges :: Set PackageIdentifier -> Map PackageName VersionRange
|
||||
identsToRanges =
|
||||
Map.unions . map go . Set.toList
|
||||
where
|
||||
go (PackageIdentifier package version) = Map.singleton package $ thisVersion version
|
19
app/gen-install-line.hs
Normal file
19
app/gen-install-line.hs
Normal file
|
@ -0,0 +1,19 @@
|
|||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.Version (showVersion)
|
||||
import Stackage.HaskellPlatform
|
||||
import Stackage.LoadDatabase
|
||||
import Stackage.NarrowDatabase
|
||||
import Stackage.PackageList
|
||||
import Stackage.Types
|
||||
import Stackage.Util
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
userPackages <- loadPackageList "package-list.txt"
|
||||
hp <- loadHaskellPlatform
|
||||
let allPackages = Map.union userPackages $ identsToRanges (hplibs hp)
|
||||
pdb <- loadPackageDB (Set.map (\(PackageIdentifier p _) -> p) (hpcore hp)) allPackages
|
||||
final <- narrowPackageDB pdb $ Set.fromList $ Map.keys allPackages
|
||||
putStr "cabal-dev install -fnetwork23 --enable-tests "
|
||||
mapM_ (\(PackageName p, v) -> putStr $ p ++ "-" ++ showVersion v ++ " ") $ Map.toList final
|
1
haskell-platform
Submodule
1
haskell-platform
Submodule
|
@ -0,0 +1 @@
|
|||
Subproject commit 73a58050d86cef941fc82a82d52e70c906785b7f
|
8
package-list.txt
Normal file
8
package-list.txt
Normal file
|
@ -0,0 +1,8 @@
|
|||
-- Michael Snoyman michael@snoyman.com
|
||||
yesod < 1.4
|
||||
yesod-newsfeed
|
||||
yesod-sitemap
|
||||
yesod-static
|
||||
|
||||
-- Constraints
|
||||
binary == 0.5.1.0
|
37
stackage.cabal
Normal file
37
stackage.cabal
Normal file
|
@ -0,0 +1,37 @@
|
|||
-- Initial stackage.cabal generated by cabal init. For further
|
||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: stackage
|
||||
version: 0.1.0.0
|
||||
synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage.
|
||||
-- description:
|
||||
homepage: https://github.com/snoyberg/stackage
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Michael Snoyman
|
||||
maintainer: michael@snoyman.com
|
||||
category: Distribution
|
||||
build-type: Simple
|
||||
cabal-version: >=1.8
|
||||
|
||||
library
|
||||
exposed-modules: Stackage.PackageList
|
||||
Stackage.NarrowDatabase
|
||||
Stackage.LoadDatabase
|
||||
Stackage.HaskellPlatform
|
||||
Stackage.Util
|
||||
Stackage.Types
|
||||
build-depends: base >= 4 && < 5
|
||||
, containers
|
||||
, Cabal
|
||||
, tar >= 0.4
|
||||
, bytestring
|
||||
, directory
|
||||
, filepath
|
||||
|
||||
executable stackage-gen-install-line
|
||||
hs-source-dirs: app
|
||||
main-is: gen-install-line.hs
|
||||
build-depends: base
|
||||
, stackage
|
||||
, containers
|
Loading…
Reference in a new issue