@@ -0,0 +1,78 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE StandaloneDeriving #-}
3+{-# OPTIONS_GHC -fno-warn-orphans #-}
4+
5+module Stackage where
6+
7+import Control.DeepSeq.Generics
8+import Control.Monad
9+import Control.Monad.Par.Combinator
10+import Control.Monad.Par.IO
11+import Control.Monad.Trans
12+import Data.Map as Map
13+import Data.Maybe
14+import Data.Yaml ( decodeFile )
15+import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
16+import Distribution.Package
17+import Distribution.PackageDescription
18+import Distribution.Version
19+import GHC.Generics ( Generic )
20+import Stackage.Types hiding ( display )
21+import System.Directory
22+import System.FilePath
23+import Text.Show.Pretty
24+import Distribution.Compiler
25+
26+yo :: IO ()
27+yo = readView "/home/simons/src/cabal2nix/hackage2nix/stackage-nightly/nightly-2015-09-11.yaml" >>= putStrLn . ppShow
28+
29+data Spec = Spec
30+ { version :: Version
31+ , flagOverrides :: (Map FlagName Bool)
32+ , runTests :: Bool
33+ , runHaddock :: Bool
34+ , runLinuxBuilds :: Bool
35+ }
36+ deriving (Show, Eq, Ord, Generic)
37+
38+data View = View
39+ { compiler :: CompilerId
40+ , corePackages :: Map PackageName Version
41+ , packages :: Map PackageName Spec
42+ }
43+ deriving (Show, Generic)
44+
45+instance NFData Spec where
46+instance NFData View where
47+
48+views :: IO [View]
49+views = runParIO $ readStackage "lts-haskell"
50+
51+readStackage :: FilePath -> ParIO [View]
52+readStackage dirPath = do
53+ filePaths <- liftIO (listFiles dirPath)
54+ parMapM (liftIO . readView) [ dirPath </> p | p <- filePaths, takeExtension p == ".yaml" ]
55+
56+readView :: FilePath -> IO View
57+readView = fmap fromBuildPlan . readBuildPlan
58+
59+fromBuildPlan :: BuildPlan -> View
60+fromBuildPlan bp = View (CompilerId GHC (siGhcVersion (bpSystemInfo bp)))
61+ (siCorePackages (bpSystemInfo bp))
62+ (Map.map fromPackagePlan (bpPackages bp))
63+
64+fromPackagePlan :: PackagePlan -> Spec
65+fromPackagePlan pp = Spec (ppVersion pp)
66+ (pcFlagOverrides ppc)
67+ (pcTests ppc == ExpectSuccess)
68+ (pcHaddocks ppc == ExpectSuccess)
69+ (pcSkipBuild ppc)
70+ where ppc = ppConstraints pp
71+
72+readBuildPlan :: FilePath -> IO BuildPlan
73+readBuildPlan = fmap fromJust . decodeFile
74+
75+listFiles :: FilePath -> IO [FilePath]
76+listFiles path = do
77+ let isFile p = doesFileExist (path </> p)
78+ getDirectoryContents path >>= filterM isFile . Prelude.filter (\x -> head x /= '.')