@@ -8,11 +8,12 @@ import Cabal2Nix.Hackage ( readHashedHackage, Hackage )
88-- import Cabal2Nix.Name
99import Cabal2Nix.Package
1010import Control.Monad
11+import Control.Applicative hiding ( empty )
1112import Control.Monad.Par.Combinator
1213import Control.Monad.Par.IO
1314-- import Control.Monad.RWS
1415import Control.Monad.Trans
15−-- import Data.Map ( Map )
16+import Data.Map ( Map )
1617import qualified Data.Map as Map
1718import Data.Maybe
1819import Data.Monoid
@@ -31,27 +32,81 @@ import Distribution.System
3132import Distribution.Text
3233import Distribution.Version
3334
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+
3453main :: IO ()
3554main = do
3655 hackage <- readHashedHackage
3756 nixpkgs <- readNixpkgPackageMap
38− runParIO (generatePackageSet hackage nixpkgs)
57+ runParIO (generatePackageSet (Map.delete "type" hackage) nixpkgs)
3958
40−generatePackageSet :: Hackage -> PackageMap -> ParIO ()
59+generatePackageSet :: Hackage -> Nixpkgs -> ParIO ()
4160generatePackageSet hackage nixpkgs = do
42− let defaultPackageSet = buildDefaultPackageSet hackage defaultPackageOverrides
43− extendedPackageSet = buildExtendedPackageSet hackage extraPackages
44− db = defaultPackageSet `mergePackageSet` extendedPackageSet
61+ let
62+
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
4577
46− matches :: PackageIdentifier -> Dependency -> Bool
47− matches (PackageIdentifier pn v) (Dependency dn vr) = pn == dn && v `withinRange` vr
78+ latestOverridePackageSet :: PackageSet
79+ latestOverridePackageSet = latestVersionSet `Map.intersection` defaultPackageOverridesSet
4880
49− resolver :: Dependency -> Bool
50− resolver dep@(Dependency (PackageName pkg) vrange) =
51− any (`matches` dep) (corePackages ++ hardCorePackages) ||
52− maybe False (not . Map.null . Map.filterWithKey (\k _ -> k `withinRange` vrange)) (Map.lookup pkg defaultPackageSet)
81+ extraPackageSet :: PackageMultiSet
82+ extraPackageSet = Map.unionsWith Set.union $
83+ [ Map.singleton name (Set.singleton (resolveConstraint c hackage)) | c@(Dependency (PackageName name) _) <- extraPackages ] ++
84+ [ Map.map Set.singleton latestCorePackageSet ] ++
85+ [ Map.map Set.singleton latestOverridePackageSet ]
5386
54− forM_ (Map.assocs defaultPackageSet) $ \(name, vdb) ->
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+
109+ forM_ (Map.assocs defaultPkgs) $ \(name, vdb) ->
55110 when (Map.size vdb /= 1) $
56111 fail ("invalid defaut package set: " ++ show (name, Map.keys vdb))
57112
@@ -62,30 +117,30 @@ generatePackageSet hackage nixpkgs = do
62117 putStrLn "self: {"
63118 putStrLn ""
64119 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−
71120 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+
72127 (drv, overrides) <- generatePackage db resolver nixpkgs name version descr
73128
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 ]
75130
76131 let def = nest 2 $ hang (string nixAttr <+> equals <+> text "callPackage") 2 (parens (disp drv)) <+> (braces overrides <> semi)
77− let overr = if multiVersionPackage && version == defaultVersion
78− then nest 2 $ (string name <+> equals <+> text ("self." ++ show nixAttr)) <> semi
79− else empty
132+ -- let overr = if not isDefaultVersion && isJust (Map.lookup name corePackageSet)
133+ -- then nest 2 $ (string name <+> equals <+> text "null") <> semi
134+ -- else empty
80135
81− return (def $+$ overr)
136+ return (def {- $+$ overr -})
82137
83138 return (render (vcat pkg $+$ text ""))
84139
85140 liftIO $ mapM_ putStrLn pkgs
86141 liftIO $ putStrLn "}"
87142
88−generatePackage :: Hackage -> (Dependency -> Bool) -> PackageMap -> String -> Version -> GenericPackageDescription -> ParIO (Derivation, Doc)
143+generatePackage :: Hackage -> (Dependency -> Bool) -> Nixpkgs -> String -> Version -> GenericPackageDescription -> ParIO (Derivation, Doc)
89144generatePackage hackage resolver nixpkgs name version descr = do
90145 srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display version)
91146 let Just cabalFileHash = lookup "x-cabal-file-hash" (customFieldsPD (packageDescription descr))
@@ -129,7 +184,7 @@ generatePackage hackage resolver nixpkgs name version descr = do
129184
130185 return (drv, overrides)
131186
132−isKnownNixpkgAttribute :: PackageMap -> Hackage -> String -> Bool
187+isKnownNixpkgAttribute :: Nixpkgs -> Hackage -> String -> Bool
133188isKnownNixpkgAttribute nixpkgs hackage name
134189 | '.' `elem` name = True
135190 | Just _ <- Map.lookup name hackage = True
@@ -155,29 +210,28 @@ defaultPackageOverrides :: [Dependency]
155210defaultPackageOverrides = map (\s -> fromMaybe (error (show s ++ " is not a valid override selector")) (simpleParse s))
156211 [ "mtl == 2.1.*"
157212 , "monad-control == 0.3.*"
158− ] ++
213+ ] {- ++
159214 [ Dependency n (thisVersion v) | PackageIdentifier n v <- corePackages ]
160215 -- TODO: This is necessary because otherwise we may end up having a
161216 -- version that's "too new" in the default package set. The problem
162217 -- is that we don't want those packages generated, really, so maybe
163218 -- we should remove them from the final package set after the
164219 -- resover has been constructed?
220+ -}
165221
166222-- These packages are added to the generated set, but the play no role during dependency resolution.
167223extraPackages :: [Dependency]
168224extraPackages =
169− map (\(Dependency name _) -> Dependency name anyVersion) defaultPackageOverrides ++
225+ -- map (\(Dependency name _) -> Dependency name anyVersion) defaultPackageOverrides ++
170226 map (\s -> fromMaybe (error (show s ++ " is not a valid extra package selector")) (simpleParse s))
171227 [ "Cabal < 1.22"
172228 ]
173229
174230selectLatestMatchingPackage :: Dependency -> Hackage -> Hackage
175−selectLatestMatchingPackage (Dependency (PackageName name) vrange) db =
176− case Map.lookup name db of
177− Nothing -> error (show name ++ " is not a valid Hackage package")
178− Just vdb -> let (key,val) = Map.findMax (Map.filterWithKey (\k _ -> k `withinRange` vrange) vdb)
179− in Map.singleton name (Map.singleton key val)
180−
231+selectLatestMatchingPackage (Dependency (PackageName name) vrange) db = Map.singleton name (Map.singleton key val)
232+ where
233+ vdb = db ! name
234+ (key,val) = Map.findMax (Map.filterWithKey (\k _ -> k `withinRange` vrange) vdb)
181235
182236-- data Options = Options
183237-- { verbose :: Bool
@@ -188,7 +242,7 @@ selectLatestMatchingPackage (Dependency (PackageName name) vrange) db =
188242-- data Config = Config
189243-- { _verbose :: Bool
190244-- , _hackage :: Hackage
191−-- , _nixpkgs :: PackageMap
245+-- , _nixpkgs :: Nixpkgs
192246-- }
193247-- deriving (Show)
194248--