git.iko.soy/typeable/cabal2nix
on cabal2-support help sign in
typeable/cabal2nix/hackage2nix/Main.hs
214 lines 11 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE RecordWildCards #-}
4module Main ( main ) where
6import HackageGit
8import Control.Lens
9import Control.Monad
10import Control.Monad.Par.Combinator
11import Control.Monad.Par.IO
12import Control.Monad.Trans ( liftIO )
13import Data.List
14import Data.Map.Strict ( Map )
15import qualified Data.Map.Strict as Map
16import Data.Maybe
17import Data.Set ( Set )
18import qualified Data.Set as Set
19import Data.String
20import Distribution.Nixpkgs.Fetch
21import Distribution.Nixpkgs.Haskell as Derivation
22import Distribution.Nixpkgs.Haskell.Constraint
23import Distribution.Nixpkgs.Haskell.FromCabal
24import Distribution.Nixpkgs.Haskell.FromCabal.Configuration as Config
25import Distribution.Nixpkgs.Haskell.FromCabal.Flags
26import Distribution.Nixpkgs.Meta
27import Distribution.Nixpkgs.PackageMap
28import Distribution.Package
29import Distribution.PackageDescription hiding ( options, extraLibs, buildTools, homepage )
30import Distribution.System
31import Distribution.Text
32import Distribution.Version
33import Language.Nix
34import Options.Applicative
35import qualified Paths_cabal2nix as Main
36import System.FilePath
37import System.IO
38import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
40type PackageSet = Map PackageName Version
41type PackageMultiSet = Map PackageName (Set Version)
43data CLI = CLI
44 { hackageRepository :: FilePath
45 , preferredVersionsFile :: Maybe FilePath
46 , nixpkgsRepository :: FilePath
47 , configFile :: FilePath
48 , targetPlatform :: Platform
49 }
50 deriving (Show)
52main :: IO ()
53main = do
54 let cliOptions :: Parser CLI
55 cliOptions = CLI
56 <$> strOption (long "hackage" <> help "path to Hackage git repository" <> value "hackage" <> showDefaultWith id <> metavar "PATH")
57 <*> optional (strOption (long "preferred-versions" <> help "path to Hackage preferred-versions file" <> value "hackage/preferred-versions" <> showDefault <> metavar "PATH"))
58 <*> strOption (long "nixpkgs" <> help "path to Nixpkgs repository" <> value "nixpkgs" <> showDefaultWith id <> metavar "PATH")
59 <*> strOption (long "config" <> help "path to configuration file inside of Nixpkgs" <> value "pkgs/development/haskell-modules/configuration-hackage2nix.yaml" <> showDefaultWith id <> metavar "PATH")
60 <*> option (fmap fromString str) (long "platform" <> help "target platform to generate package set for" <> value "x86_64-linux" <> showDefaultWith display <> metavar "PLATFORM")
62 pinfo :: ParserInfo CLI
63 pinfo = info
64 ( helper
65 <*> infoOption ("hackage2nix " ++ display Main.version) (long "version" <> help "Show version number")
66 <*> cliOptions
67 )
68 ( fullDesc
69 <> header "hackage2nix converts a Hackage database into a hackage-packages.nix file."
70 )
71 CLI {..} <- execParser pinfo
73 config <- readConfiguration (nixpkgsRepository </> configFile)
74 nixpkgs <- readNixpkgPackageMap ["-f", nixpkgsRepository, "--arg", "config", "{ allowAliases = false; }"]
75 preferredVersions <- readPreferredVersions (fromMaybe (hackageRepository </> "preferred-versions") preferredVersionsFile)
76 let fixup = Map.delete "acme-everything" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
77 . Map.delete "som" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
78 . Map.delete "type" -- TODO: https://github.com/NixOS/cabal2nix/issues/163
79 . Map.delete "control-invariants" -- TODO: depends on "assert"
80 . Map.delete "with" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
81 . Map.delete "telega" -- TODO: depends on "with"
82 . over (at "hermes") (fmap (set (contains "1.3.4.3") False)) -- TODO: https://github.com/haskell/hackage-server/issues/436
83 hackage <- fixup <$> readHackage hackageRepository
84 let
85 hackagePackagesFile :: FilePath
86 hackagePackagesFile = nixpkgsRepository </> "pkgs/development/haskell-modules/hackage-packages.nix"
88 corePackageSet :: PackageSet
89 corePackageSet = Map.fromList [ (name, v) | PackageIdentifier name v <- Set.toList (Config.corePackages config) ]
91 latestVersionSet :: PackageSet
92 latestVersionSet = Map.map Set.findMax (Map.filter (not . Set.null) (Map.mapWithKey (enforcePreferredVersions preferredVersions) hackage))
94 defaultPackageOverridesSet :: PackageSet
95 defaultPackageOverridesSet = Map.fromList [ (name, resolveConstraint c hackage) | c@(Dependency name _) <- defaultPackageOverrides config ]
97 generatedDefaultPackageSet :: PackageSet
98 generatedDefaultPackageSet = (defaultPackageOverridesSet `Map.union` latestVersionSet) `Map.difference` corePackageSet
100 latestCorePackageSet :: PackageSet
101 latestCorePackageSet = latestVersionSet `Map.intersection` corePackageSet
103 latestOverridePackageSet :: PackageSet
104 latestOverridePackageSet = latestVersionSet `Map.intersection` defaultPackageOverridesSet
106 extraPackageSet :: PackageMultiSet
107 extraPackageSet = Map.unionsWith Set.union
108 [ Map.singleton name (Set.singleton (resolveConstraint c hackage)) | c@(Dependency name _) <- extraPackages config ]
110 db :: PackageMultiSet
111 db = Map.unionsWith Set.union [ Map.map Set.singleton generatedDefaultPackageSet
112 , Map.map Set.singleton latestCorePackageSet
113 , Map.map Set.singleton latestOverridePackageSet
114 , extraPackageSet
115 ]
117 haskellResolver :: Dependency -> Bool
118 haskellResolver (Dependency name vrange)
119 | Just v <- Map.lookup name corePackageSet = v `withinRange` vrange
120 | Just v <- Map.lookup name generatedDefaultPackageSet = v `withinRange` vrange
121 | otherwise = False
123 nixpkgsResolver :: Identifier -> Maybe Binding
124 nixpkgsResolver = resolve (Map.map (Set.map (over path ("pkgs":))) nixpkgs)
126 globalPackageMaintainers :: Map PackageName (Set Identifier)
127 globalPackageMaintainers = Map.unionsWith Set.union [ Map.singleton p (Set.singleton m) | (m,ps) <- Map.toList (packageMaintainers config), p <- Set.toList ps ]
129 pkgs <- runParIO $ flip parMapM (Map.toAscList db) $ \(name, vs) -> do
130 defs <- forM (Set.toAscList vs) $ \v -> liftIO $ do
131 let pkgId :: PackageIdentifier
132 pkgId = PackageIdentifier name v
134 (descr, cabalSHA256) <- readPackage hackageRepository pkgId
135 meta <- readPackageMeta hackageRepository pkgId
137 let isInDefaultPackageSet, isHydraEnabled, isBroken :: Bool
138 isInDefaultPackageSet = (== Just v) (Map.lookup name generatedDefaultPackageSet)
139 isHydraEnabled = isInDefaultPackageSet && not (isBroken || name `Set.member` dontDistributePackages config)
140 isBroken = any (withinRange v) [ vr | Dependency pn vr <- brokenPackages config, pn == name ]
142 droppedPlatforms :: Set Platform
143 droppedPlatforms = Map.findWithDefault mempty name (unsupportedPlatforms config)
145 tarballSHA256 :: SHA256Hash
146 tarballSHA256 = fromMaybe (error (display pkgId ++ ": meta data has no hash for the tarball"))
147 (view (hashes . at "SHA256") meta)
149 flagAssignment :: FlagAssignment -- We don't use the flags from Stackage Nightly here, because
150 flagAssignment = configureCabalFlags pkgId -- they are chosen specifically for GHC 7.10.2.
152 attr :: String
153 attr = if isInDefaultPackageSet then unPackageName name else mangle pkgId
155 drv :: Derivation
156 drv = fromGenericPackageDescription haskellResolver nixpkgsResolver targetPlatform (compilerInfo config) flagAssignment [] descr
157 & src .~ urlDerivationSource ("mirror://hackage/" ++ display pkgId ++ ".tar.gz") tarballSHA256
158 & editedCabalFile .~ cabalSHA256
159 & metaSection.platforms %~ (`Set.difference` Map.findWithDefault Set.empty name (unsupportedPlatforms config))
160 & metaSection.hydraPlatforms %~ (if Set.null droppedPlatforms then id else (`Set.difference` droppedPlatforms))
161 & metaSection.hydraPlatforms %~ (if isHydraEnabled then id else const Set.empty)
162 & metaSection.broken ||~ isBroken
163 & metaSection.maintainers .~ Map.findWithDefault Set.empty name globalPackageMaintainers
164 & metaSection.homepage .~ ""
166 overrides :: Doc
167 overrides = fcat $ punctuate space [ disp b <> semi | b <- Set.toList (view (dependencies . each) drv `Set.union` view extraFunctionArgs drv), not (isFromHackage b) ]
168 return $ render $ nest 2 $
169 hang (doubleQuotes (text attr) <+> equals <+> text "callPackage") 2 (parens (pPrint drv)) <+> (braces overrides <> semi)
171 return (intercalate "\n\n" defs)
173 withFile hackagePackagesFile WriteMode $ \h -> do
174 hPutStrLn h "/* hackage-packages.nix is an auto-generated file -- DO NOT EDIT! */"
175 hPutStrLn h ""
176 hPutStrLn h "{ pkgs, stdenv, callPackage }:"
177 hPutStrLn h ""
178 hPutStrLn h "self: {"
179 hPutStrLn h ""
180 mapM_ (\pkg -> hPutStrLn h pkg >> hPutStrLn h "") pkgs
181 hPutStrLn h "}"
183isFromHackage :: Binding -> Bool
184isFromHackage b = case view (reference . path) b of
185 ["self",_] -> True
186 _ -> False
188readPreferredVersions :: FilePath -> IO [Constraint]
189readPreferredVersions p = mapMaybe parsePreferredVersionsLine . lines <$> readFile p
191parsePreferredVersionsLine :: String -> Maybe Constraint
192parsePreferredVersionsLine [] = Nothing
193parsePreferredVersionsLine ('-':'-':_) = Nothing
194parsePreferredVersionsLine l = simpleParse l `mplus` error ("invalid preferred-versions line: " ++ show l)
196enforcePreferredVersions :: [Constraint] -> PackageName -> Set Version -> Set Version
197enforcePreferredVersions cs pkg = Set.filter (\v -> PackageIdentifier pkg v `satisfiesConstraints` cs)
199resolveConstraint :: Constraint -> Hackage -> Version
200resolveConstraint c = fromMaybe (error msg) . resolveConstraint' c
201 where msg = unlines [ "constraint " ++ display c ++ " cannot be resolved in Hackage"
202 , "This could be due the package being missing in the hackage directory"
203 , "or the file system not being case sensitive."
204 ]
206resolveConstraint' :: Constraint -> Hackage -> Maybe Version
207resolveConstraint' (Dependency name vrange) hackage
208 | Just vset' <- Map.lookup name hackage
209 , vset <- Set.filter (`withinRange` vrange) vset'
210 , not (Set.null vset) = Just (Set.findMax vset)
211 | otherwise = Nothing
213mangle :: PackageIdentifier -> String
214mangle (PackageIdentifier name v) = unPackageName name ++ '_' : [ if c == '.' then '_' else c | c <- display v ]