git.iko.soy/typeable/cabal2nix
on v20160611 help sign in
typeable/cabal2nix/hackage2nix/src/Main.hs
259 lines 13 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
4module Main ( main ) where
6import Control.Lens
7import Control.Monad
8import Control.Monad.Par.Combinator
9import Control.Monad.Par.IO
10import Control.Monad.Trans ( liftIO )
11import Data.List
12import Data.Map.Strict ( Map )
13import qualified Data.Map.Strict as Map
14import Data.Maybe
15import Data.Monoid
16import Data.Set ( Set )
17import qualified Data.Set as Set
18import Data.String
19import Distribution.Nixpkgs.Fetch
20import Distribution.Nixpkgs.Haskell as Derivation
21import Distribution.Nixpkgs.Haskell.Constraint
22import Distribution.Nixpkgs.Haskell.FromCabal
23import Distribution.Nixpkgs.Haskell.FromCabal.Configuration as Config
24import Distribution.Nixpkgs.Haskell.FromCabal.Flags
25import Distribution.Nixpkgs.Meta
26import Distribution.Nixpkgs.PackageMap
27import Distribution.Package
28import Distribution.PackageDescription hiding ( options, buildDepends, extraLibs, buildTools )
29import Distribution.System
30import Distribution.Text
31import Distribution.Version
32import HackageGit
33import Language.Nix
34import Options.Applicative
35import qualified Paths_hackage2nix as Main
36import Stackage
37import System.FilePath
38import System.IO
39import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
41type PackageSet = Map PackageName Version
42type PackageMultiSet = Map PackageName (Set Version)
44data CLI = CLI
45 { hackageRepository :: FilePath
46 , preferredVersionsFile :: Maybe FilePath
47 , nixpkgsRepository :: FilePath
48 , ltsHaskellRepository :: FilePath
49 , stackageNightlyRepository :: FilePath
50 , configFile :: FilePath
51 , targetPlatform :: Platform
52 }
53 deriving (Show)
55main :: IO ()
56main = do
57 let cliOptions :: Parser CLI
58 cliOptions = CLI
59 <$> strOption (long "hackage" <> help "path to Hackage git repository" <> value "hackage" <> showDefaultWith id <> metavar "PATH")
60 <*> optional (strOption (long "preferred-versions" <> help "path to Hackage preferred-versions file" <> value "hackage/preferred-versions" <> showDefault <> metavar "PATH"))
61 <*> strOption (long "nixpkgs" <> help "path to Nixpkgs repository" <> value "nixpkgs" <> showDefaultWith id <> metavar "PATH")
62 <*> strOption (long "lts-haskell" <> help "path to LTS Haskell repository" <> value "lts-haskell" <> showDefaultWith id <> metavar "PATH")
63 <*> strOption (long "stackage-nightly" <> help "path to Stackage Nightly repository" <> value "stackage-nightly" <> showDefaultWith id <> metavar "PATH")
64 <*> strOption (long "config" <> help "path to configuration file inside of Nixpkgs" <> value "pkgs/development/haskell-modules/configuration-hackage2nix.yaml" <> showDefaultWith id <> metavar "PATH")
65 <*> option (fmap fromString str) (long "platform" <> help "target platform to generate package set for" <> value "x86_64-linux" <> showDefaultWith display <> metavar "PLATFORM")
67 pinfo :: ParserInfo CLI
68 pinfo = info
69 ( helper
70 <*> infoOption ("hackage2nix " ++ display Main.version) (long "version" <> help "Show version number")
71 <*> cliOptions
72 )
73 ( fullDesc
74 <> header "hackage2nix converts a Hackage database into a hackage-packages.nix file."
75 )
76 CLI {..} <- execParser pinfo
78 config' <- readConfiguration (nixpkgsRepository </> configFile)
79 nixpkgs <- readNixpkgPackageMap nixpkgsRepository Nothing
80 preferredVersions <- readPreferredVersions (fromMaybe (hackageRepository </> "preferred-versions") preferredVersionsFile)
81 let fixup = Map.delete "acme-everything" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
82 . Map.delete "som" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
83 . Map.delete "type" -- TODO: https://github.com/NixOS/cabal2nix/issues/163
84 hackage <- fixup <$> readHackage hackageRepository
85 snapshots <- runParIO (readLTSHaskell ltsHaskellRepository)
86 nightly <- readStackageNightly stackageNightlyRepository
87 let
88 config :: Configuration
89 config = config' { defaultPackageOverrides = [ Dependency n (thisVersion (Stackage.version spec)) | (n, spec) <- Map.toList (packages nightly) ] }
91 hackagePackagesFile :: FilePath
92 hackagePackagesFile = nixpkgsRepository </> "pkgs/development/haskell-modules/hackage-packages.nix"
94 corePackageSet :: PackageSet
95 corePackageSet = Map.fromList [ (name, v) | PackageIdentifier name v <- Set.toList (Config.corePackages config) ]
97 latestVersionSet :: PackageSet
98 latestVersionSet = Map.map Set.findMax (Map.filter (not . Set.null) (Map.mapWithKey (enforcePreferredVersions preferredVersions) hackage))
100 defaultPackageOverridesSet :: PackageSet
101 defaultPackageOverridesSet = Map.fromList [ (name, resolveConstraint c hackage) | c@(Dependency name _) <- defaultPackageOverrides config ]
103 generatedDefaultPackageSet :: PackageSet
104 generatedDefaultPackageSet = (defaultPackageOverridesSet `Map.union` latestVersionSet) `Map.difference` corePackageSet
106 latestCorePackageSet :: PackageSet
107 latestCorePackageSet = latestVersionSet `Map.intersection` corePackageSet
109 latestOverridePackageSet :: PackageSet
110 latestOverridePackageSet = latestVersionSet `Map.intersection` defaultPackageOverridesSet
112 extraPackageSet :: PackageMultiSet
113 extraPackageSet = Map.unionsWith Set.union
114 [ Map.singleton name (Set.singleton (resolveConstraint c hackage)) | c@(Dependency name _) <- extraPackages config ]
116 stackagePackageSet :: Map PackageName (Map Version Spec)
117 stackagePackageSet = Map.fromListWith (Map.unionWith mergeSpecs) [ (n, Map.singleton (Stackage.version spec) spec) | snapshot <- nightly:snapshots, (n, spec) <- Map.toList (packages snapshot) ]
119 db :: PackageMultiSet
120 db = Map.unionsWith Set.union [ Map.map Set.singleton generatedDefaultPackageSet
121 , Map.map Set.singleton latestCorePackageSet
122 , Map.map Set.singleton latestOverridePackageSet
123 , extraPackageSet
124 , Map.map Map.keysSet stackagePackageSet
125 ]
127 haskellResolver :: Dependency -> Bool
128 haskellResolver (Dependency name vrange)
129 | Just v <- Map.lookup name corePackageSet = v `withinRange` vrange
130 | Just v <- Map.lookup name generatedDefaultPackageSet = v `withinRange` vrange
131 | otherwise = False
133 nixpkgsResolver :: Identifier -> Maybe Binding
134 nixpkgsResolver = resolve (Map.map (Set.map (over path ("pkgs":))) nixpkgs)
136 globalPackageMaintainers :: Map PackageName (Set Identifier)
137 globalPackageMaintainers = Map.unionsWith Set.union [ Map.singleton p (Set.singleton m) | (m,ps) <- Map.toList (packageMaintainers config), p <- Set.toList ps ]
139 pkgs <- runParIO $ flip parMapM (Map.toAscList db) $ \(name, vs) -> do
140 defs <- forM (Set.toAscList vs) $ \v -> liftIO $ do
141 let pkgId :: PackageIdentifier
142 pkgId = PackageIdentifier name v
144 (descr, cabalSHA256) <- readPackage hackageRepository pkgId
145 meta <- readPackageMeta hackageRepository pkgId
147 let isInDefaultPackageSet :: Bool
148 isInDefaultPackageSet = maybe False (== v) (Map.lookup name generatedDefaultPackageSet)
150 tarballSHA256 :: SHA256Hash
151 tarballSHA256 = fromMaybe (error (display pkgId ++ ": meta data has no hash for the tarball"))
152 (view (hashes . at "SHA256") meta)
154 spec :: Spec
155 spec = Spec v True True `fromMaybe` (Map.lookup name stackagePackageSet >>= Map.lookup v)
157 flagAssignment :: FlagAssignment -- We don't use the flags from Stackage Nightly here, because
158 flagAssignment = configureCabalFlags pkgId -- they are chosen specifically for GHC 7.10.2.
160 attr :: String
161 attr = if isInDefaultPackageSet then unPackageName name else mangle pkgId
163 drv :: Derivation
164 drv = fromGenericPackageDescription haskellResolver nixpkgsResolver targetPlatform (compilerInfo config) flagAssignment [] descr
165 & src .~ DerivationSource "url" ("mirror://hackage/" ++ display pkgId ++ ".tar.gz") "" tarballSHA256
166 & editedCabalFile .~ cabalSHA256
167 & Derivation.runHaddock &&~ Stackage.runHaddock spec
168 & doCheck &&~ runTests spec
169 & metaSection.hydraPlatforms %~ (`Set.difference` Map.findWithDefault Set.empty name (dontDistributePackages config))
170 & metaSection.maintainers .~ Map.findWithDefault Set.empty name globalPackageMaintainers
171 & metaSection.hydraPlatforms %~ (if isInDefaultPackageSet then id else const Set.empty)
173 overrides :: Doc
174 overrides = fcat $ punctuate space [ disp b <> semi | b <- Set.toList (view (dependencies . each) drv), not (isFromHackage b) ]
175 return $ render $ nest 2 $
176 hang (doubleQuotes (text attr) <+> equals <+> text "callPackage") 2 (parens (pPrint drv)) <+> (braces overrides <> semi)
178 return (intercalate "\n\n" defs)
180 withFile hackagePackagesFile WriteMode $ \h -> do
181 hPutStrLn h "/* hackage-packages.nix is an auto-generated file -- DO NOT EDIT! */"
182 hPutStrLn h ""
183 hPutStrLn h "{ pkgs, stdenv, callPackage }:"
184 hPutStrLn h ""
185 hPutStrLn h "self: {"
186 hPutStrLn h ""
187 mapM_ (\pkg -> hPutStrLn h pkg >> hPutStrLn h "") pkgs
188 hPutStrLn h "}"
190 void $ runParIO $ flip parMapM snapshots $ \Snapshot {..} -> liftIO $ do
191 let allPackages :: PackageSet
192 allPackages = Map.difference
193 (Map.fromList [ (name, Stackage.version spec) | (name, spec) <- Map.toList packages ] `Map.union` generatedDefaultPackageSet)
194 corePackages'
196 ltsConfigFile :: FilePath
197 ltsConfigFile = nixpkgsRepository </> "pkgs/development/haskell-modules/configuration-" ++ show (pPrint snapshot) ++ ".nix"
199 corePackages' :: PackageSet
200 corePackages' = corePackages `Map.union` Map.fromList [("Cabal", Version [] []), ("rts", Version [] [])]
202 withFile ltsConfigFile WriteMode $ \h -> do
203 hPutStrLn h "{ pkgs }:"
204 hPutStrLn h ""
205 hPutStrLn h "with import ./lib.nix { inherit pkgs; };"
206 hPutStrLn h ""
207 hPutStrLn h "self: super: {"
208 hPutStrLn h ""
209 hPutStrLn h " # core libraries provided by the compiler"
210 forM_ (Map.keys corePackages') $ \n ->
211 unless (n == "ghc") (hPutStrLn h (" " ++ unPackageName n ++ " = null;"))
212 hPutStrLn h ""
213 hPutStrLn h (" # " ++ show (pPrint snapshot) ++ " packages")
214 forM_ (Map.toList allPackages) $ \(name, v) -> do
215 let pkgId = PackageIdentifier name v
217 isInDefaultPackageSet :: Bool
218 isInDefaultPackageSet = maybe False (== v) (Map.lookup name generatedDefaultPackageSet)
220 isInStackage :: Bool
221 isInStackage = isJust (Map.lookup name packages)
222 case (isInStackage,isInDefaultPackageSet) of
223 (True,True) -> return () -- build is visible and enabled
224 (True,False) -> hPutStrLn h (" " ++ show (unPackageName name) ++ " = doDistribute super." ++ show (mangle pkgId) ++ ";")
225 (False,True) -> hPutStrLn h (" " ++ show (unPackageName name) ++ " = dontDistribute super." ++ show (unPackageName name) ++ ";")
226 (False,False) -> fail ("logic error processing " ++ display pkgId ++ " in " ++ show (pPrint snapshot))
227 hPutStrLn h ""
228 hPutStrLn h "}"
231isFromHackage :: Binding -> Bool
232isFromHackage b = case view (reference . path) b of
233 ["self",_] -> True
234 _ -> False
236readPreferredVersions :: FilePath -> IO [Constraint]
237readPreferredVersions p = mapMaybe parsePreferredVersionsLine . lines <$> readFile p
239parsePreferredVersionsLine :: String -> Maybe Constraint
240parsePreferredVersionsLine [] = Nothing
241parsePreferredVersionsLine ('-':'-':_) = Nothing
242parsePreferredVersionsLine l = simpleParse l `mplus` error ("invalid preferred-versions line: " ++ show l)
244enforcePreferredVersions :: [Constraint] -> PackageName -> Set Version -> Set Version
245enforcePreferredVersions cs pkg = Set.filter (\v -> PackageIdentifier pkg v `satisfiesConstraints` cs)
247resolveConstraint :: Constraint -> Hackage -> Version
248resolveConstraint c = fromMaybe (error msg) . resolveConstraint' c
249 where msg = "constraint " ++ display c ++ " cannot be resolved in Hackage"
251resolveConstraint' :: Constraint -> Hackage -> Maybe Version
252resolveConstraint' (Dependency name vrange) hackage
253 | Just vset' <- Map.lookup name hackage
254 , vset <- Set.filter (`withinRange` vrange) vset'
255 , not (Set.null vset) = Just (Set.findMax vset)
256 | otherwise = Nothing
258mangle :: PackageIdentifier -> String
259mangle (PackageIdentifier (PackageName name) v) = name ++ '_' : [ if c == '.' then '_' else c | c <- display v ]