git.iko.soy/typeable/cabal2nix
on master help sign in
Add stronger types to Nix package map.

This re-factoring introduces proper types for Nixpkgs Identifiers and Paths. The code is still a bit messy, but that's going to change soon.

commitde1550379ee40fdb7d4c7d0a3dffab6ce658977d authorPeter Simons <simons@cryp.to> dateThu 20 Aug 2015, 18:35 (11 years ago) parent7ad6d7d
3 files changed+72−66
compare with master
unifiedsplit
src/Distribution/Nixpkgs/PackageMap.hs+28−24 src/hackage2nix.hs+37−35 test/spec.hs+7−7
src/Distribution/Nixpkgs/PackageMap.hs+28−24
@@ -8,34 +8,38 @@ import Data.Map.Strict ( Map )
88import Data.Set ( Set )
99import qualified Data.Set as Set
1010import System.Process
11−
12−type Attribute = String
13−type Path = [Attribute]
14−
15−readNixpkgAttributeSet :: FilePath -> IO (Set Attribute)
16−readNixpkgAttributeSet nixpkgs = do
17− (_, Just h, _, _) <- createProcess (proc "nix-env" ["-qaP", "--json", "-f"++nixpkgs])
18− { std_out = CreatePipe
19− }
11+import Internal.Lens
12+import Language.Nix.Identifier
13+import Language.Nix.Path
14+import Data.Maybe
15+import Distribution.Nixpkgs.Util.PrettyPrinting
16+
17+type PackageMap = Map Identifier (Set Path)
18+
19+readNixpkgPackageMap :: FilePath -> Maybe Path -> IO PackageMap
20+readNixpkgPackageMap nixpkgs attrpath = fmap identifierSet2PackageMap (readNixpkgSet nixpkgs attrpath)
21+
22+readNixpkgSet :: FilePath -> Maybe Path -> IO (Set String)
23+readNixpkgSet nixpkgs attrpath = do
24+ let extraArgs = maybe [] (\p -> ["-A", render (pPrint p)]) attrpath
25+ (_, Just h, _, _) <- createProcess (proc "nix-env" (["-qaP", "--json", "-f"++nixpkgs] ++ extraArgs))
26+ { std_out = CreatePipe, env = Nothing } -- TODO: ensure that overrides don't screw up our results
2027 buf <- LBS.hGetContents h
21− let pkgmap :: Either String (Map Attribute JSON.Object)
28+ let pkgmap :: Either String (Map String JSON.Object)
2229 pkgmap = JSON.eitherDecode buf
2330 either fail (return . Map.keysSet) pkgmap
2431
25−parsePackage :: Attribute -> (Attribute, Path)
26−parsePackage "" = error "empty string is not a valid package name"
27−parsePackage x = (last xs, init xs) where xs = splitOn "." x
28−
29−type PackageMap = Map Attribute (Set Path)
30−
31−attributeSet2PackageMap :: Set Attribute -> PackageMap
32−attributeSet2PackageMap pkgset = foldr (uncurry insertAttribute) Map.empty pkglist
32+identifierSet2PackageMap :: Set String -> PackageMap
33+identifierSet2PackageMap pkgset = foldr (uncurry insertIdentifier) Map.empty pkglist
3334 where
34− pkglist :: [(Attribute, Path)]
35− pkglist = Set.toList (Set.map parsePackage pkgset)
35+ pkglist :: [(Identifier, Path)]
36+ pkglist = mapMaybe parsePackage (Set.toList pkgset)
3637
37− insertAttribute :: Attribute -> Path -> PackageMap -> PackageMap
38− insertAttribute attr = Map.insertWith Set.union attr . Set.singleton
38+ insertIdentifier :: Identifier -> Path -> PackageMap -> PackageMap
39+ insertIdentifier i = Map.insertWith Set.union i . Set.singleton
3940
40−readNixpkgPackageMap :: FilePath -> IO PackageMap
41−readNixpkgPackageMap nixpkgs = fmap attributeSet2PackageMap (readNixpkgAttributeSet nixpkgs)
41+parsePackage :: String -> Maybe (Identifier, Path)
42+parsePackage x | null x = error "Distribution.Nixpkgs.PackageMap.parsepackage: empty string is no valid identifier"
43+ | xs <- splitOn "." x = if needsQuoting (head xs)
44+ then Nothing
45+ else Just (create ident (last xs), create path (map (create ident) (init xs)))
src/hackage2nix.hs+37−35
@@ -1,3 +1,4 @@
1+{-# LANGUAGE OverloadedStrings #-}
12{-# LANGUAGE RecordWildCards #-}
23
34module Main ( main ) where
@@ -8,7 +9,6 @@ import Cabal2Nix.HackageGit ( readHackage, Hackage )
89import Cabal2Nix.Package
910import Cabal2Nix.Version
1011import Control.Arrow ( second )
11−import Control.Lens
1212import Control.Monad
1313import Control.Monad.Par.Combinator
1414import Control.Monad.Par.IO
@@ -33,7 +33,9 @@ import Distribution.PackageDescription.Configuration
3333import Distribution.System
3434import Distribution.Text
3535import Distribution.Version
36+import Internal.Lens
3637import Language.Nix.Identifier
38+import Language.Nix.Path
3739import Options.Applicative
3840import System.FilePath
3941
@@ -115,7 +117,7 @@ main = do
115117 Options {..} <- execParser pinfo
116118
117119 hackage <- readHackage hackageRepository
118− nixpkgs <- readNixpkgPackageMap nixpkgsRepository
120+ nixpkgs <- readNixpkgPackageMap nixpkgsRepository (Just (create path ["pkgs"]))
119121 preferredVersions <- readPreferredVersions (hackageRepository </> "preferred-versions")
120122 let fixup = Map.delete "acme-everything" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
121123 . Map.delete "som" -- TODO: https://github.com/NixOS/cabal2nix/issues/164
@@ -161,8 +163,8 @@ generatePackageSet config hackage nixpkgs = do
161163 , extraPackageSet
162164 ]
163165
164− knownAttributesSet :: Set String
165− knownAttributesSet = Set.union (Map.keysSet hackage) (Map.keysSet corePackageSet)
166+ knownIdentifierSet :: Set Identifier
167+ knownIdentifierSet = Set.map (create ident) (Set.union (Map.keysSet hackage) (Map.keysSet corePackageSet))
166168
167169 resolver :: Dependency -> Bool
168170 resolver (Dependency (PackageName name) vrange)
@@ -182,33 +184,34 @@ generatePackageSet config hackage nixpkgs = do
182184 descr = hackage Map.! name Map.! pkgversion
183185 (missingDeps, _, drv') = cabal2nix resolver descr
184186
185− haskellDependencies :: Set String
186− haskellDependencies = Set.map (view ident) $ mconcat [ drv'^.x.haskell | x <- [libraryDepends,executableDepends,testDepends] ]
187+ haskellDependencies :: Set Identifier
188+ haskellDependencies = Set.unions [ drv'^.x.haskell | x <- [libraryDepends,executableDepends,testDepends] ]
187189
188− systemDependencies :: Set String
189− systemDependencies = Set.map (view ident) $ mconcat [ drv'^.x.y | x <- [libraryDepends,executableDepends,testDepends], y <- [system,pkgconfig] ]
190+ systemDependencies :: Set Identifier
191+ systemDependencies = Set.unions [ drv'^.x.y | x <- [libraryDepends,executableDepends,testDepends], y <- [system,pkgconfig] ]
190192
191− haskellOrSystemDependencies :: Set String
192− haskellOrSystemDependencies = Set.map (view ident) $ mconcat [ drv'^.x.tool | x <- [libraryDepends,executableDepends,testDepends] ]
193+ haskellOrSystemDependencies :: Set Identifier
194+ haskellOrSystemDependencies = Set.unions [ drv'^.x.tool | x <- [libraryDepends,executableDepends,testDepends] ]
193195
194− missing :: Set String
195− missing = Set.filter (`Set.notMember` knownAttributesSet) haskellDependencies
196+ missing :: Set Identifier
197+ missing = Set.filter (`Set.notMember` knownIdentifierSet) haskellDependencies
196198
197− buildInputs :: Map Attribute (Maybe Path)
199+ buildInputs :: Map Identifier (Maybe Path)
198200 buildInputs = Map.unions
199201 [ Map.fromList [ (n, Nothing) | n <- Set.toList missing ]
200− , Map.fromList [ (n, resolveNixpkgsAttribute nixpkgs n) | n <- Set.toAscList systemDependencies ]
201− , Map.fromList [ (n, resolveHackageThenNixpkgsAttribute nixpkgs hackage n) | n <- Set.toAscList haskellOrSystemDependencies ]
202+ , Map.fromList [ (n, resolveNixpkgsIdentifier nixpkgs n) | n <- Set.toAscList systemDependencies ]
203+ , Map.fromList [ (n, resolveHackageThenNixpkgsIdentifier nixpkgs hackage n) | n <- Set.toAscList haskellOrSystemDependencies ]
202204 ]
203205
204206 systemOverrides :: Doc
205207 systemOverrides = fsep (map (uncurry formatOverride) (Map.toAscList buildInputs))
206208
207− formatOverride :: Attribute -> Maybe Path -> Doc
208− formatOverride n Nothing = space <> text n <> text " = null;" -- missing attribute
209− formatOverride n (Just []) = (text " inherit" <+> text n) <> semi
210− formatOverride _ (Just ["self"]) = mempty -- callPackage finds this package already
211− formatOverride n (Just p) = (text " inherit" <+> parens (text (intercalate "." p)) <+> text n) <> semi
209+ formatOverride :: Identifier -> Maybe Path -> Doc
210+ formatOverride n Nothing = space <> pPrint n <> text " = null;" -- missing dependency
211+ formatOverride n (Just p) = case view path p of
212+ [] -> error ("internal error: " ++ show n ++ "resolved to empty path!")
213+ ["self"] -> mempty -- callPackage finds this package automatically
214+ _ -> (text " inherit" <+> parens (pPrint p) <+> pPrint n) <> semi
212215
213216 overrides :: Doc
214217 overrides = systemOverrides
@@ -235,24 +238,24 @@ generatePackageSet config hackage nixpkgs = do
235238 liftIO $ mapM_ (\pkg -> putStrLn pkg >> putStrLn "") pkgs
236239 liftIO $ putStrLn "}"
237240
238−resolveHackageThenNixpkgsAttribute :: Nixpkgs -> Hackage -> Attribute -> Maybe Path
239−resolveHackageThenNixpkgsAttribute nixpkgs hackage name
240− | Just _ <- Map.lookup name hackage = Just ["self"]
241− | p@(Just _) <- resolveNixpkgsAttribute nixpkgs name = p
241+resolveHackageThenNixpkgsIdentifier :: Nixpkgs -> Hackage -> Identifier -> Maybe Path
242+resolveHackageThenNixpkgsIdentifier nixpkgs hackage name
243+ | Just _ <- Map.lookup (view ident name) hackage = Just (create path ["self"])
244+ | p@(Just _) <- resolveNixpkgsIdentifier nixpkgs name = p
242245 | otherwise = Nothing
243246
244−resolveNixpkgsAttribute :: Nixpkgs -> Attribute -> Maybe Path
245−resolveNixpkgsAttribute nixpkgs name
246− | name `elem` ["clang","lldb","llvm"] = Just ["self","llvmPackages"]
247+resolveNixpkgsIdentifier :: Nixpkgs -> Identifier -> Maybe Path
248+resolveNixpkgsIdentifier nixpkgs name
249+ | name `elem` ["clang","lldb","llvm"] = Just (create path ["self","llvmPackages"])
247250 | Just paths <- Map.lookup name nixpkgs = getShortestPath (Set.toList (paths `Set.intersection` goodScopes))
248251 | otherwise = Nothing
249− where
250− goodScopes :: Set Path
251− goodScopes = Set.fromList [[], ["xlibs"], ["gnome"], ["gnome3"], ["kde4"]]
252252
253− getShortestPath :: [Path] -> Maybe Path
254− getShortestPath [] = Nothing
255− getShortestPath ps = Just ("pkgs" : minimumBy (on compare length) ps)
253+goodScopes :: Set Path
254+goodScopes = Set.fromList ((map (create path . ("pkgs":))) [[], ["xlibs"], ["gnome"], ["gnome3"], ["kde4"]])
255+
256+getShortestPath :: [Path] -> Maybe Path
257+getShortestPath [] = Nothing
258+getShortestPath ps = Just (minimumBy (on compare (view (path . to length))) ps)
256259
257260cabal2nix :: (Dependency -> Bool) -> GenericPackageDescription -> ([Dependency], FlagAssignment, Derivation)
258261cabal2nix resolver cabal = (missingDeps, flags, drv)
@@ -284,8 +287,7 @@ cabal2nix resolver cabal = (missingDeps, flags, drv)
284287 enableTest t = t { testEnabled = True }
285288
286289readPreferredVersions :: FilePath -> IO [Constraint]
287−readPreferredVersions path = mapMaybe parsePreferredVersionsLine . lines <$> readFile path
288−
290+readPreferredVersions p = mapMaybe parsePreferredVersionsLine . lines <$> readFile p
289291
290292parsePreferredVersionsLine :: String -> Maybe Constraint
291293parsePreferredVersionsLine ('-':'-':_) = Nothing
test/spec.hs+7−7
@@ -1,6 +1,6 @@
11module Main ( main ) where
22
3−import Control.Lens
3+import Internal.Lens
44import Control.DeepSeq
55import Control.Exception
66import Distribution.Nixpkgs.License
@@ -13,12 +13,12 @@ main = do
1313 describe "DeepSeq instances work properly for" $ do
1414 it "License" $ mapM_ hitsBottom [Known undefined, Unknown (Just undefined)]
1515 it "Meta" $ do mapM_ hitsBottom
16− [ nullMeta & homepage .~ undefined
17− , nullMeta & description .~ undefined
18− , nullMeta & license .~ undefined
19− , nullMeta & platforms .~ undefined
20− , nullMeta & maintainers .~ undefined
21− , nullMeta & broken .~ undefined
16+ [ def & homepage .~ undefined
17+ , def & description .~ undefined
18+ , def & license .~ undefined
19+ , def & platforms .~ undefined
20+ , def & maintainers .~ undefined
21+ , def & broken .~ undefined
2222 ]
2323
2424hitsBottom :: NFData a => a -> Expectation