Initial code

.gitignore

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

.gitmodules

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

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.

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.

Setup.hs

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

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)

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)

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

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

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)

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

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

haskell-platform

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

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

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