@@ -5,28 +5,24 @@ module Main ( main ) where
55import Cabal2Nix.Flags ( configureCabalFlags )
66import Cabal2Nix.Generate ( cabal2nix' )
77import Cabal2Nix.Hackage ( readHashedHackage, Hackage )
8−-- import Cabal2Nix.Name
98import Cabal2Nix.Package
9+import Data.List
1010import Control.Monad
11−import Control.Applicative hiding ( empty )
1211import Control.Monad.Par.Combinator
1312import Control.Monad.Par.IO
14−-- import Control.Monad.RWS
15−import Control.Monad.Trans
16−import Data.Map ( Map )
17−import qualified Data.Map as Map
13+import Control.Monad.Trans ( liftIO )
14+import Data.Map.Strict ( Map )
15+import qualified Data.Map.Strict as Map
1816import Data.Maybe
1917import Data.Monoid
2018import Data.Set ( Set )
2119import qualified Data.Set as Set
2220import Distribution.Compiler
23−-- import Distribution.Compiler
2421import Distribution.NixOS.Derivation.Cabal
2522import Distribution.NixOS.PackageMap ( PackageMap, readNixpkgPackageMap )
26−import Distribution.NixOS.PrettyPrinting hiding ( (<>) )
23+import Distribution.NixOS.PrettyPrinting hiding ( attr, (<>) )
2724import Distribution.Package
2825import Distribution.PackageDescription hiding ( buildDepends, extraLibs, buildTools )
29−-- import Options.Applicative hiding ( empty )
3026import Distribution.PackageDescription.Configuration
3127import Distribution.System
3228import Distribution.Text
@@ -38,9 +34,6 @@ type PackageMultiSet = Map String (Set Version)
3834
3935type Constraint = Dependency
4036
41−(!) :: Hackage -> String -> Map Version GenericPackageDescription
42−(!) hackage pkg = fromMaybe (error (show pkg ++ " is not a valid hackage package")) (Map.lookup pkg hackage)
43−
4437resolveConstraint :: Constraint -> Hackage -> Version
4538resolveConstraint c = fromMaybe (error ("constraint " ++ display c ++ " cannot be resolved in Hackage")) .
4639 resolveConstraint' c
@@ -48,18 +41,17 @@ resolveConstraint c = fromMaybe (error ("constraint " ++ display c ++ " cannot b
4841resolveConstraint' :: Constraint -> Hackage -> Maybe Version
4942resolveConstraint' (Dependency (PackageName name) vrange) hackage | Set.null vs = Nothing
5043 | otherwise = Just (Set.findMax vs)
51− where vs = Set.filter (`withinRange` vrange) (Map.keysSet (hackage ! name))
44+ where vs = Set.filter (`withinRange` vrange) (Map.keysSet (hackage Map.! name))
5245
5346main :: IO ()
5447main = do
5548 hackage <- readHashedHackage
56− nixpkgs <- readNixpkgPackageMap
49+ nixpkgs <- readNixpkgPackageMap -- TODO: nix barfs at the generated "type" attribute for some reason.
5750 runParIO (generatePackageSet (Map.delete "type" hackage) nixpkgs)
5851
5952generatePackageSet :: Hackage -> Nixpkgs -> ParIO ()
6053generatePackageSet hackage nixpkgs = do
6154 let
62−
6355 corePackageSet :: PackageSet
6456 corePackageSet = Map.fromList [ (name, v) | PackageIdentifier (PackageName name) v <- corePackages ++ hardCorePackages ]
6557
@@ -79,36 +71,24 @@ generatePackageSet hackage nixpkgs = do
7971 latestOverridePackageSet = latestVersionSet `Map.intersection` defaultPackageOverridesSet
8072
8173 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 ]
86−
87− defaultPkgs :: Hackage
88− defaultPkgs = Map.mapWithKey (\k v -> Map.singleton v (hackage ! k Map.! v)) generatedDefaultPackageSet
74+ extraPackageSet = Map.unionsWith Set.union
75+ [ Map.singleton name (Set.singleton (resolveConstraint c hackage)) | c@(Dependency (PackageName name) _) <- extraPackages ]
8976
90− extraPkgs :: Hackage
91− extraPkgs = Map.mapWithKey (\k -> Set.foldr (\v -> Map.insert v (hackage ! k Map.! v)) Map.empty) extraPackageSet
77+ db :: PackageMultiSet
78+ db = Map.unionsWith Set.union [ Map.map Set.singleton generatedDefaultPackageSet
79+ , Map.map Set.singleton latestCorePackageSet
80+ , Map.map Set.singleton latestOverridePackageSet
81+ , extraPackageSet
82+ ]
9283
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
84+ knownAttributesSet :: Set String
85+ knownAttributesSet = Set.union (Map.keysSet hackage) (Map.keysSet corePackageSet)
10386
10487 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) ->
110− when (Map.size vdb /= 1) $
111− fail ("invalid defaut package set: " ++ show (name, Map.keys vdb))
88+ resolver (Dependency (PackageName name) vrange)
89+ | Just v <- Map.lookup name corePackageSet = v `withinRange` vrange
90+ | Just v <- Map.lookup name generatedDefaultPackageSet = v `withinRange` vrange
91+ | otherwise = False
11292
11393 liftIO $ do putStrLn "/* hackage-packages.nix is an auto-generated file -- DO NOT EDIT! */"
11494 putStrLn ""
@@ -116,166 +96,67 @@ generatePackageSet hackage nixpkgs = do
11696 putStrLn ""
11797 putStrLn "self: {"
11898 putStrLn ""
119− pkgs <- flip parMapM (Map.toList db) $ \(name, versions) -> 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−
127− (drv, overrides) <- generatePackage db resolver nixpkgs name version descr
99+ pkgs <- flip parMapM (Map.toAscList db) $ \(name, vs) -> do
100+ defs <- forM (Set.toAscList vs) $ \version -> do
101+ srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display version)
102+ let Just cabalFileHash = lookup "x-cabal-file-hash" (customFieldsPD (packageDescription descr))
128103
129− let nixAttr = name ++ if isDefaultVersion then "" else "_" ++ [ if c == '.' then '_' else c | c <- display version ]
130−
131− let def = nest 2 $ hang (string nixAttr <+> equals <+> text "callPackage") 2 (parens (disp drv)) <+> (braces overrides <> semi)
132− -- let overr = if not isDefaultVersion && isJust (Map.lookup name corePackageSet)
133− -- then nest 2 $ (string name <+> equals <+> text "null") <> semi
134− -- else empty
135−
136− return def -- $+$ overr
137−
138− return (render (vcat pkg $+$ text ""))
139−
140− liftIO $ mapM_ putStrLn pkgs
141− liftIO $ putStrLn "}"
104+ -- TODO: Include list of broken dependencies in the generated output.
105+ descr = hackage Map.! name Map.! version
106+ (_, _, drv') = cabal2nix resolver descr
107+ drv = drv' { src = srcSpec, editedCabalFile = if revision drv == 0 then "" else cabalFileHash }
142108
143−generatePackage :: Hackage -> (Dependency -> Bool) -> Nixpkgs -> String -> Version -> GenericPackageDescription -> ParIO (Derivation, Doc)
144−generatePackage hackage resolver nixpkgs name version descr = do
145− srcSpec <- liftIO $ sourceFromHackage Nothing (name ++ "-" ++ display version)
146− let Just cabalFileHash = lookup "x-cabal-file-hash" (customFieldsPD (packageDescription descr))
109+ missing :: Set String
110+ missing = Set.fromList $
111+ filter (not . isKnownNixpkgAttribute nixpkgs hackage) (extraLibs drv ++ pkgConfDeps drv ++ buildTools drv) ++
112+ filter (flip Set.notMember knownAttributesSet) (buildDepends drv ++ testDepends drv)
147113
148− -- TODO: Include list of broken dependencies in the generated output.
149− -- Currently, we add overrides that set "pkgname = null", but this is
150− -- unsatisfactory because these dependencies may very well work when building
151− -- the same package set with a different GHC version.
152− (_, _, drv') = cabal2nix resolver descr
114+ missingOverrides :: Doc
115+ missingOverrides | Set.null missing = empty
116+ | otherwise = fcat [ text (' ':dep++" = null;") | dep <- Set.toAscList missing ] <> space
153117
154− let drv = drv' { src = srcSpec
155− , editedCabalFile = if revision drv == 0 then "" else cabalFileHash
156− }
118+ conflicts :: Set String
119+ conflicts = Set.intersection knownAttributesSet (Set.fromList (extraLibs drv ++ pkgConfDeps drv))
157120
158− selectHackageNames :: Set String -> Set String
159− selectHackageNames = Set.intersection (Map.keysSet hackage `Set.union` Set.fromList [ n | PackageIdentifier (PackageName n) _ <- corePackages ++ hardCorePackages ])
121+ conflictOverrides :: Doc
122+ conflictOverrides | Set.null conflicts = empty
123+ | otherwise = text " inherit (pkgs) " <> hsep (map text (Set.toAscList conflicts)) <> text "; "
160124
161− selectMissingHackageNames :: Set String -> Set String
162− selectMissingHackageNames = flip Set.difference (Map.keysSet hackage `Set.union` Set.fromList [ n | PackageIdentifier (PackageName n) _ <- corePackages ++ hardCorePackages ])
125+ overrides :: Doc
126+ overrides = conflictOverrides $+$ missingOverrides
163127
164− conflicts :: Set String
165− conflicts = Set.difference (selectHackageNames $ Set.fromList (extraLibs drv ++ pkgConfDeps drv)) missing
128+ attr | Just v <- Map.lookup name generatedDefaultPackageSet, v == version = name
129+ | otherwise = name ++ '_' : [ if c == '.' then '_' else c | c <- display version ]
166130
167− conflictOverrides :: Doc
168− conflictOverrides | Set.null conflicts = empty
169− | otherwise = text " inherit (pkgs) " <> hsep (map text (Set.toAscList conflicts)) <> text "; "
131+ return $ nest 2 $ hang (string attr <+> equals <+> text "callPackage") 2 (parens (disp drv)) <+> (braces overrides <> semi)
132+ return (intercalate "\n\n" (map render defs))
170133
171− missing :: Set String
172− missing = Set.unions
173− [ Set.fromList (filter (not . isKnownNixpkgAttribute nixpkgs hackage) (extraLibs drv ++ pkgConfDeps drv ++ buildTools drv))
174− , selectMissingHackageNames (Set.fromList (buildDepends drv ++ testDepends drv))
175− -- , Set.fromList [ n | Dependency (PackageName n) _ <- missingDeps, n /= name ]
176− ]
177−
178− missingOverrides :: Doc
179− missingOverrides | Set.null missing = empty
180− | otherwise = fcat [ text (' ':dep++" = null;") | dep <- Set.toAscList missing ] <> space
181−
182− overrides :: Doc
183− overrides = conflictOverrides $+$ missingOverrides
184−
185− return (drv, overrides)
134+ liftIO $ mapM_ (\pkg -> putStrLn pkg >> putStrLn "") pkgs
135+ liftIO $ putStrLn "}"
186136
187137isKnownNixpkgAttribute :: Nixpkgs -> Hackage -> String -> Bool
188138isKnownNixpkgAttribute nixpkgs hackage name
189− | '.' `elem` name = True
139+ | '.' `elem` name = True -- TODO: remove this crap once the cuda expression has a proper post-process hook.
190140 | Just _ <- Map.lookup name hackage = True
191141 | otherwise = maybe False goodScope (Map.lookup name nixpkgs)
192142 where
193143 goodScope :: Set [String] -> Bool
194144 goodScope = not . Set.null . Set.intersection (Set.fromList [[], ["xlibs"], ["gnome"]])
195145
196−buildDefaultPackageSet :: Hackage -> [Dependency] -> Hackage
197−buildDefaultPackageSet hackage overrides = Map.unions $ -- unions is left-biased, i.e. overrides trump the latest version
198− [ selectLatestMatchingPackage p hackage | p <- overrides ] ++
199− [ selectLatestMatchingPackage (Dependency (PackageName n) anyVersion) hackage | n <- Map.keys hackage ]
200−
201−buildExtendedPackageSet :: Hackage -> [Dependency] -> Hackage
202−buildExtendedPackageSet hackage extras = Map.unionsWith Map.union
203− [ selectLatestMatchingPackage p hackage | p <- extras ]
204−
205−mergePackageSet :: Hackage -> Hackage -> Hackage
206−mergePackageSet = Map.unionWith Map.union
207−
208146-- These packages replace the latest respective version during dependency resolution.
209−defaultPackageOverrides :: [Dependency]
147+defaultPackageOverrides :: [Constraint]
210148defaultPackageOverrides = map (\s -> fromMaybe (error (show s ++ " is not a valid override selector")) (simpleParse s))
211149 [ "mtl == 2.1.*"
212150 , "monad-control == 0.3.*"
213− ] {- ++
214− [ Dependency n (thisVersion v) | PackageIdentifier n v <- corePackages ]
215− -- TODO: This is necessary because otherwise we may end up having a
216− -- version that's "too new" in the default package set. The problem
217− -- is that we don't want those packages generated, really, so maybe
218− -- we should remove them from the final package set after the
219− -- resover has been constructed?
220− -}
151+ ]
221152
222153-- These packages are added to the generated set, but the play no role during dependency resolution.
223−extraPackages :: [Dependency]
154+extraPackages :: [Constraint]
224155extraPackages =
225− -- map (\(Dependency name _) -> Dependency name anyVersion) defaultPackageOverrides ++
226156 map (\s -> fromMaybe (error (show s ++ " is not a valid extra package selector")) (simpleParse s))
227157 [ "Cabal < 1.22"
228158 ]
229159
230−selectLatestMatchingPackage :: Dependency -> Hackage -> Hackage
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)
235−
236−-- data Options = Options
237−-- { verbose :: Bool
238−-- , compiler :: CompilerId
239−-- }
240−-- deriving (Show)
241−--
242−-- data Config = Config
243−-- { _verbose :: Bool
244−-- , _hackage :: Hackage
245−-- , _nixpkgs :: Nixpkgs
246−-- }
247−-- deriving (Show)
248−--
249−-- type Compile a = RWST Config () (Set PackageId) ParIO a
250−--
251−-- run :: Compile a -> IO a
252−-- run f = do
253−-- (a, st, ws) <- runParIO (runRWST f (Config True Map.empty Map.empty) Set.empty)
254−-- return a
255−--
256−-- parseCommandLine :: IO Options
257−-- parseCommandLine = execParser mainOptions
258−-- where
259−-- parseCompilerId :: Parser CompilerId
260−-- parseCompilerId = option (eitherReader (\s -> maybe (Left (show s ++ " is no valid compiler id")) Right (simpleParse s)))
261−-- ( long "compiler"
262−-- <> help "identifier of the compiler"
263−-- <> metavar "COMPILER-ID"
264−-- <> value (fromJust (simpleParse "ghc-7.8.3"))
265−-- <> showDefaultWith display
266−-- )
267−--
268−-- parseOptions :: Parser Options
269−-- parseOptions = Options
270−-- <$> switch (long "verbose" <> help "enable detailed progress diagnostics")
271−-- <*> parseCompilerId
272−--
273−-- mainOptions :: ParserInfo Options
274−-- mainOptions = info (helper <*> parseOptions)
275−-- ( fullDesc
276−-- <> header "hackage2nix -- convert the Hackage database into Nix build instructions"
277−-- )
278−
279160cabal2nix :: (Dependency -> Bool) -> GenericPackageDescription -> ([Dependency], FlagAssignment, Derivation)
280161cabal2nix resolver cabal = (missingDeps, flags, drv)
281162 where