Browse Source

Initial code

fpco
Michael Snoyman 9 years ago
parent
commit
8825105005
  1. 1
      .gitignore
  2. 3
      .gitmodules
  3. 20
      LICENSE
  4. 7
      README.md
  5. 2
      Setup.hs
  6. 53
      Stackage/HaskellPlatform.hs
  7. 92
      Stackage/LoadDatabase.hs
  8. 30
      Stackage/NarrowDatabase.hs
  9. 31
      Stackage/PackageList.hs
  10. 40
      Stackage/Types.hs
  11. 12
      Stackage/Util.hs
  12. 19
      app/gen-install-line.hs
  13. 1
      haskell-platform
  14. 8
      package-list.txt
  15. 37
      stackage.cabal

1
.gitignore

@ -5,3 +5,4 @@ cabal-dev
*.chi
*.chs.h
.virthualenv
*.swp

3
.gitmodules

@ -0,0 +1,3 @@
[submodule "haskell-platform"]
path = haskell-platform
url = https://github.com/haskell/haskell-platform.git

20
LICENSE

@ -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.

7
README.md

@ -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

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

53
Stackage/HaskellPlatform.hs

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -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

@ -0,0 +1 @@
Subproject commit 73a58050d86cef941fc82a82d52e70c906785b7f

8
package-list.txt

@ -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

@ -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…
Cancel
Save