git.iko.soy/typeable/cabal2nix
on master help sign in
hackage2nix.hs: re-factor package set generation logic into algebraic set operations
d812561Peter Simons
src/hackage2nix.hs+89−35
compare with master
unifiedsplit
@@ -8,11 +8,12 @@ import Cabal2Nix.Hackage ( readHashedHackage, Hackage )
8-- import Cabal2Nix.Name
8-- import Cabal2Nix.Name
9import Cabal2Nix.Package
9import Cabal2Nix.Package
10import Control.Monad
10import Control.Monad
11+import Control.Applicative hiding ( empty )
11import Control.Monad.Par.Combinator
12import Control.Monad.Par.Combinator
12import Control.Monad.Par.IO
13import Control.Monad.Par.IO
13-- import Control.Monad.RWS
14-- import Control.Monad.RWS
14import Control.Monad.Trans
15import Control.Monad.Trans
15−-- import Data.Map ( Map )
16+import Data.Map ( Map )
16import qualified Data.Map as Map
17import qualified Data.Map as Map
17import Data.Maybe
18import Data.Maybe
18import Data.Monoid
19import Data.Monoid
@@ -31,27 +32,81 @@ import Distribution.System
31import Distribution.Text
32import Distribution.Text
32import Distribution.Version
33import Distribution.Version
33
34
35+type Nixpkgs = PackageMap -- Map String (Set [String])
36+type PackageSet = Map String Version
37+type PackageMultiSet = Map String (Set Version)
38+
39+type Constraint = Dependency
40+
41+(!) :: Hackage -> String -> Map Version GenericPackageDescription
42+(!) hackage pkg = fromMaybe (error (show pkg ++ " is not a valid hackage package")) (Map.lookup pkg hackage)
43+
44+resolveConstraint :: Constraint -> Hackage -> Version
45+resolveConstraint c = fromMaybe (error ("constraint " ++ display c ++ " cannot be resolved in Hackage")) .
46+ resolveConstraint' c
47+
48+resolveConstraint' :: Constraint -> Hackage -> Maybe Version
49+resolveConstraint' (Dependency (PackageName name) vrange) hackage | Set.null vs = Nothing
50+ | otherwise = Just (Set.findMax vs)
51+ where vs = Set.filter (`withinRange` vrange) (Map.keysSet (hackage ! name))
52+
34main :: IO ()
53main :: IO ()
35main = do
54main = do
36 hackage <- readHashedHackage
55 hackage <- readHashedHackage
37 nixpkgs <- readNixpkgPackageMap
56 nixpkgs <- readNixpkgPackageMap
38− runParIO (generatePackageSet hackage nixpkgs)
57+ runParIO (generatePackageSet (Map.delete "type" hackage) nixpkgs)
39
58
40−generatePackageSet :: Hackage -> PackageMap -> ParIO ()
59+generatePackageSet :: Hackage -> Nixpkgs -> ParIO ()
41generatePackageSet hackage nixpkgs = do
60generatePackageSet hackage nixpkgs = do
42− let defaultPackageSet = buildDefaultPackageSet hackage defaultPackageOverrides
61+ let
43− extendedPackageSet = buildExtendedPackageSet hackage extraPackages
62+
44− db = defaultPackageSet `mergePackageSet` extendedPackageSet
63+ corePackageSet :: PackageSet
64+ corePackageSet = Map.fromList [ (name, v) | PackageIdentifier (PackageName name) v <- corePackages ++ hardCorePackages ]
65+
66+ latestVersionSet :: PackageSet
67+ latestVersionSet = Map.map (Set.findMax . Map.keysSet) hackage
68+
69+ defaultPackageOverridesSet :: PackageSet
70+ defaultPackageOverridesSet = Map.fromList [ (name, resolveConstraint c hackage) | c@(Dependency (PackageName name) _) <- defaultPackageOverrides ]
71+
72+ generatedDefaultPackageSet :: PackageSet
73+ generatedDefaultPackageSet = (defaultPackageOverridesSet `Map.union` latestVersionSet) `Map.difference` corePackageSet
74+
75+ latestCorePackageSet :: PackageSet
76+ latestCorePackageSet = latestVersionSet `Map.intersection` corePackageSet
45
77
46− matches :: PackageIdentifier -> Dependency -> Bool
78+ latestOverridePackageSet :: PackageSet
47− matches (PackageIdentifier pn v) (Dependency dn vr) = pn == dn && v `withinRange` vr
79+ latestOverridePackageSet = latestVersionSet `Map.intersection` defaultPackageOverridesSet
48
80
49− resolver :: Dependency -> Bool
81+ extraPackageSet :: PackageMultiSet
50− resolver dep@(Dependency (PackageName pkg) vrange) =
82+ extraPackageSet = Map.unionsWith Set.union $
51− any (`matches` dep) (corePackages ++ hardCorePackages) ||
83+ [ Map.singleton name (Set.singleton (resolveConstraint c hackage)) | c@(Dependency (PackageName name) _) <- extraPackages ] ++
52− maybe False (not . Map.null . Map.filterWithKey (\k _ -> k `withinRange` vrange)) (Map.lookup pkg defaultPackageSet)
84+ [ Map.map Set.singleton latestCorePackageSet ] ++
85+ [ Map.map Set.singleton latestOverridePackageSet ]
53
86
87+ defaultPkgs :: Hackage
88+ defaultPkgs = Map.mapWithKey (\k v -> Map.singleton v (hackage ! k Map.! v)) generatedDefaultPackageSet
89+
90+ extraPkgs :: Hackage
91+ extraPkgs = Map.mapWithKey (\k -> Set.foldr (\v -> Map.insert v (hackage ! k Map.! v)) Map.empty) extraPackageSet
92+
93+ db :: Hackage
94+ db = Map.unionWith Map.union defaultPkgs extraPkgs
95+
96+ {-
97+ defaultPackageSet = buildDefaultPackageSet hackage defaultPackageOverrides
98+ extendedPackageSet = buildExtendedPackageSet hackage extraPackages
99+ db = defaultPackageSet `mergePackageSet` extendedPackageSet
100+ -}
101+ matches :: PackageIdentifier -> Dependency -> Bool
102+ matches (PackageIdentifier pn v) (Dependency dn vr) = pn == dn && v `withinRange` vr
103+
104+ resolver :: Dependency -> Bool
105+ resolver dep@(Dependency (PackageName pkg) vrange) =
106+ any (`matches` dep) (corePackages ++ hardCorePackages) ||
107+ maybe False (not . Map.null . Map.filterWithKey (\k _ -> k `withinRange` vrange)) (Map.lookup pkg defaultPkgs)
108+
54− forM_ (Map.assocs defaultPackageSet) $ \(name, vdb) ->
109+ forM_ (Map.assocs defaultPkgs) $ \(name, vdb) ->
55 when (Map.size vdb /= 1) $
110 when (Map.size vdb /= 1) $
56 fail ("invalid defaut package set: " ++ show (name, Map.keys vdb))
111 fail ("invalid defaut package set: " ++ show (name, Map.keys vdb))
57
112
@@ -62,30 +117,30 @@ generatePackageSet hackage nixpkgs = do
62 putStrLn "self: {"
117 putStrLn "self: {"
63 putStrLn ""
118 putStrLn ""
64 pkgs <- flip parMapM (Map.toList db) $ \(name, versions) -> do
119 pkgs <- flip parMapM (Map.toList db) $ \(name, versions) -> do
65− let multiVersionPackage :: Bool
66− multiVersionPackage = Map.size versions > 1
67−
68− defaultVersion :: Version
69− defaultVersion = fst $ Map.findMax $ (Map.!) defaultPackageSet name
70−
71 pkg <- forM (Map.toList versions) $ \(version, descr) -> do
120 pkg <- forM (Map.toList versions) $ \(version, descr) -> do
121+ let isDefaultVersion :: Bool
122+ isDefaultVersion
123+ | Just _ <- Map.lookup name corePackageSet = False
124+ | Just v <- Map.lookup name generatedDefaultPackageSet = v == version
125+ | otherwise = False
126+
72 (drv, overrides) <- generatePackage db resolver nixpkgs name version descr
127 (drv, overrides) <- generatePackage db resolver nixpkgs name version descr
73
128
74− let nixAttr = name ++ if multiVersionPackage then "_" ++ [ if c == '.' then '_' else c | c <- display version ] else ""
129+ let nixAttr = name ++ if isDefaultVersion then "" else "_" ++ [ if c == '.' then '_' else c | c <- display version ]
75
130
76 let def = nest 2 $ hang (string nixAttr <+> equals <+> text "callPackage") 2 (parens (disp drv)) <+> (braces overrides <> semi)
131 let def = nest 2 $ hang (string nixAttr <+> equals <+> text "callPackage") 2 (parens (disp drv)) <+> (braces overrides <> semi)
77− let overr = if multiVersionPackage && version == defaultVersion
132+ -- let overr = if not isDefaultVersion && isJust (Map.lookup name corePackageSet)
78− then nest 2 $ (string name <+> equals <+> text ("self." ++ show nixAttr)) <> semi
133+ -- then nest 2 $ (string name <+> equals <+> text "null") <> semi
79− else empty
134+ -- else empty
80
135
81− return (def $+$ overr)
136+ return (def {- $+$ overr -})
82
137
83 return (render (vcat pkg $+$ text ""))
138 return (render (vcat pkg $+$ text ""))
84
139
85 liftIO $ mapM_ putStrLn pkgs
140 liftIO $ mapM_ putStrLn pkgs
86 liftIO $ putStrLn "}"
141 liftIO $ putStrLn "}"
87
142
88−generatePackage :: Hackage -> (Dependency -> Bool) -> PackageMap -> String -> Version -> GenericPackageDescription -> ParIO (Derivation, Doc)
143+generatePackage :: Hackage -> (Dependency -> Bool) -> Nixpkgs -> String -> Version -> GenericPackageDescription -> ParIO (Derivation, Doc)
89generatePackage hackage resolver nixpkgs name version descr = do
144generatePackage hackage resolver nixpkgs name version descr = do
90 srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display version)
145 srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display version)
91 let Just cabalFileHash = lookup "x-cabal-file-hash" (customFieldsPD (packageDescription descr))
146 let Just cabalFileHash = lookup "x-cabal-file-hash" (customFieldsPD (packageDescription descr))
@@ -129,7 +184,7 @@ generatePackage hackage resolver nixpkgs name version descr = do
129
184
130 return (drv, overrides)
185 return (drv, overrides)
131
186
132−isKnownNixpkgAttribute :: PackageMap -> Hackage -> String -> Bool
187+isKnownNixpkgAttribute :: Nixpkgs -> Hackage -> String -> Bool
133isKnownNixpkgAttribute nixpkgs hackage name
188isKnownNixpkgAttribute nixpkgs hackage name
134 | '.' `elem` name = True
189 | '.' `elem` name = True
135 | Just _ <- Map.lookup name hackage = True
190 | Just _ <- Map.lookup name hackage = True
@@ -155,29 +210,28 @@ defaultPackageOverrides :: [Dependency]
155defaultPackageOverrides = map (\s -> fromMaybe (error (show s ++ " is not a valid override selector")) (simpleParse s))
210defaultPackageOverrides = map (\s -> fromMaybe (error (show s ++ " is not a valid override selector")) (simpleParse s))
156 [ "mtl == 2.1.*"
211 [ "mtl == 2.1.*"
157 , "monad-control == 0.3.*"
212 , "monad-control == 0.3.*"
158− ] ++
213+ ] {- ++
159 [ Dependency n (thisVersion v) | PackageIdentifier n v <- corePackages ]
214 [ Dependency n (thisVersion v) | PackageIdentifier n v <- corePackages ]
160 -- TODO: This is necessary because otherwise we may end up having a
215 -- TODO: This is necessary because otherwise we may end up having a
161 -- version that's "too new" in the default package set. The problem
216 -- version that's "too new" in the default package set. The problem
162 -- is that we don't want those packages generated, really, so maybe
217 -- is that we don't want those packages generated, really, so maybe
163 -- we should remove them from the final package set after the
218 -- we should remove them from the final package set after the
164 -- resover has been constructed?
219 -- resover has been constructed?
220+ -}
165
221
166-- These packages are added to the generated set, but the play no role during dependency resolution.
222-- These packages are added to the generated set, but the play no role during dependency resolution.
167extraPackages :: [Dependency]
223extraPackages :: [Dependency]
168extraPackages =
224extraPackages =
169− map (\(Dependency name _) -> Dependency name anyVersion) defaultPackageOverrides ++
225+ -- map (\(Dependency name _) -> Dependency name anyVersion) defaultPackageOverrides ++
170 map (\s -> fromMaybe (error (show s ++ " is not a valid extra package selector")) (simpleParse s))
226 map (\s -> fromMaybe (error (show s ++ " is not a valid extra package selector")) (simpleParse s))
171 [ "Cabal < 1.22"
227 [ "Cabal < 1.22"
172 ]
228 ]
173
229
174selectLatestMatchingPackage :: Dependency -> Hackage -> Hackage
230selectLatestMatchingPackage :: Dependency -> Hackage -> Hackage
175−selectLatestMatchingPackage (Dependency (PackageName name) vrange) db =
231+selectLatestMatchingPackage (Dependency (PackageName name) vrange) db = Map.singleton name (Map.singleton key val)
176− case Map.lookup name db of
232+ where
177− Nothing -> error (show name ++ " is not a valid Hackage package")
233+ vdb = db ! name
178− Just vdb -> let (key,val) = Map.findMax (Map.filterWithKey (\k _ -> k `withinRange` vrange) vdb)
234+ (key,val) = Map.findMax (Map.filterWithKey (\k _ -> k `withinRange` vrange) vdb)
179− in Map.singleton name (Map.singleton key val)
180−
181
235
182-- data Options = Options
236-- data Options = Options
183-- { verbose :: Bool
237-- { verbose :: Bool
@@ -188,7 +242,7 @@ selectLatestMatchingPackage (Dependency (PackageName name) vrange) db =
188-- data Config = Config
242-- data Config = Config
189-- { _verbose :: Bool
243-- { _verbose :: Bool
190-- , _hackage :: Hackage
244-- , _hackage :: Hackage
191−-- , _nixpkgs :: PackageMap
245+-- , _nixpkgs :: Nixpkgs
192-- }
246-- }
193-- deriving (Show)
247-- deriving (Show)
194--
248--