de15503 · typeable/cabal2nix

git.iko.soy/typeable/cabal2nix

on master help sign in

Add stronger types to Nix package map.

de15503Peter Simons11 years ago

src/Distribution/Nixpkgs/PackageMap.hs+28−24

compare with master

unifiedsplit

@@ -8,34 +8,38 @@ import Data.Map.Strict ( Map )

8import Data.Set ( Set )

9import qualified Data.Set as Set

10import System.Process

11−

11+import Internal.Lens

12−type Attribute = String

12+import Language.Nix.Identifier

13−type Path = [Attribute]

13+import Language.Nix.Path

14−

14+import Data.Maybe

15−readNixpkgAttributeSet :: FilePath -> IO (Set Attribute)

15+import Distribution.Nixpkgs.Util.PrettyPrinting

16−readNixpkgAttributeSet nixpkgs = do

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

17− (_, Just h, _, _) <- createProcess (proc "nix-env" ["-qaP", "--json", "-f"++nixpkgs])

25+ (_, Just h, _, _) <- createProcess (proc "nix-env" (["-qaP", "--json", "-f"++nixpkgs] ++ extraArgs))

18− { std_out = CreatePipe

26+ { std_out = CreatePipe, env = Nothing } -- TODO: ensure that overrides don't screw up our results

19− }

20 buf <- LBS.hGetContents h

27 buf <- LBS.hGetContents h

21− let pkgmap :: Either String (Map Attribute JSON.Object)

28+ let pkgmap :: Either String (Map String JSON.Object)

22 pkgmap = JSON.eitherDecode buf

29 pkgmap = JSON.eitherDecode buf

23 either fail (return . Map.keysSet) pkgmap

30 either fail (return . Map.keysSet) pkgmap

25−parsePackage :: Attribute -> (Attribute, Path)

32+identifierSet2PackageMap :: Set String -> PackageMap

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

33+identifierSet2PackageMap pkgset = foldr (uncurry insertIdentifier) Map.empty pkglist

33 where

34 where

34− pkglist :: [(Attribute, Path)]

35+ pkglist :: [(Identifier, Path)]

35− pkglist = Set.toList (Set.map parsePackage pkgset)

36+ pkglist = mapMaybe parsePackage (Set.toList pkgset)

37− insertAttribute :: Attribute -> Path -> PackageMap -> PackageMap

38+ insertIdentifier :: Identifier -> Path -> PackageMap -> PackageMap

38− insertAttribute attr = Map.insertWith Set.union attr . Set.singleton

39+ insertIdentifier i = Map.insertWith Set.union i . Set.singleton

40−readNixpkgPackageMap :: FilePath -> IO PackageMap

41+parsePackage :: String -> Maybe (Identifier, Path)

41−readNixpkgPackageMap nixpkgs = fmap attributeSet2PackageMap (readNixpkgAttributeSet nixpkgs)

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 #-}

1{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE RecordWildCards #-}

3module Main ( main ) where

4module Main ( main ) where

@@ -8,7 +9,6 @@ import Cabal2Nix.HackageGit ( readHackage, Hackage )

8import Cabal2Nix.Package

9import Cabal2Nix.Package

9import Cabal2Nix.Version

10import Cabal2Nix.Version

10import Control.Arrow ( second )

11import Control.Arrow ( second )

11−import Control.Lens

12import Control.Monad

13import Control.Monad.Par.Combinator

14import Control.Monad.Par.IO

@@ -33,7 +33,9 @@ import Distribution.PackageDescription.Configuration

33import Distribution.System

34import Distribution.Text

35import Distribution.Version

36+import Internal.Lens

36import Language.Nix.Identifier

37import Language.Nix.Identifier

38+import Language.Nix.Path

37import Options.Applicative

39import Options.Applicative

38import System.FilePath

40import System.FilePath

@@ -115,7 +117,7 @@ main = do

115 Options {..} <- execParser pinfo

117 Options {..} <- execParser pinfo

116

118

117 hackage <- readHackage hackageRepository

119 hackage <- readHackage hackageRepository

118− nixpkgs <- readNixpkgPackageMap nixpkgsRepository

120+ nixpkgs <- readNixpkgPackageMap nixpkgsRepository (Just (create path ["pkgs"]))

119 preferredVersions <- readPreferredVersions (hackageRepository </> "preferred-versions")

121 preferredVersions <- readPreferredVersions (hackageRepository </> "preferred-versions")

120 let fixup = Map.delete "acme-everything" -- TODO: https://github.com/NixOS/cabal2nix/issues/164

122 let fixup = Map.delete "acme-everything" -- TODO: https://github.com/NixOS/cabal2nix/issues/164

121 . Map.delete "som" -- TODO: https://github.com/NixOS/cabal2nix/issues/164

123 . Map.delete "som" -- TODO: https://github.com/NixOS/cabal2nix/issues/164

@@ -161,8 +163,8 @@ generatePackageSet config hackage nixpkgs = do

161 , extraPackageSet

163 , extraPackageSet

162 ]

164 ]

163

165

164− knownAttributesSet :: Set String

166+ knownIdentifierSet :: Set Identifier

165− knownAttributesSet = Set.union (Map.keysSet hackage) (Map.keysSet corePackageSet)

167+ knownIdentifierSet = Set.map (create ident) (Set.union (Map.keysSet hackage) (Map.keysSet corePackageSet))

166

168

167 resolver :: Dependency -> Bool

169 resolver :: Dependency -> Bool

168 resolver (Dependency (PackageName name) vrange)

170 resolver (Dependency (PackageName name) vrange)

@@ -182,33 +184,34 @@ generatePackageSet config hackage nixpkgs = do

182 descr = hackage Map.! name Map.! pkgversion

184 descr = hackage Map.! name Map.! pkgversion

183 (missingDeps, _, drv') = cabal2nix resolver descr

185 (missingDeps, _, drv') = cabal2nix resolver descr

184

186

185− haskellDependencies :: Set String

187+ haskellDependencies :: Set Identifier

186− haskellDependencies = Set.map (view ident) $ mconcat [ drv'^.x.haskell | x <- [libraryDepends,executableDepends,testDepends] ]

188+ haskellDependencies = Set.unions [ drv'^.x.haskell | x <- [libraryDepends,executableDepends,testDepends] ]

187

189

188− systemDependencies :: Set String

190+ systemDependencies :: Set Identifier

189− systemDependencies = Set.map (view ident) $ mconcat [ drv'^.x.y | x <- [libraryDepends,executableDepends,testDepends], y <- [system,pkgconfig] ]

191+ systemDependencies = Set.unions [ drv'^.x.y | x <- [libraryDepends,executableDepends,testDepends], y <- [system,pkgconfig] ]

190

192

191− haskellOrSystemDependencies :: Set String

193+ haskellOrSystemDependencies :: Set Identifier

192− haskellOrSystemDependencies = Set.map (view ident) $ mconcat [ drv'^.x.tool | x <- [libraryDepends,executableDepends,testDepends] ]

194+ haskellOrSystemDependencies = Set.unions [ drv'^.x.tool | x <- [libraryDepends,executableDepends,testDepends] ]

193

195

194− missing :: Set String

196+ missing :: Set Identifier

195− missing = Set.filter (`Set.notMember` knownAttributesSet) haskellDependencies

197+ missing = Set.filter (`Set.notMember` knownIdentifierSet) haskellDependencies

196

198

197− buildInputs :: Map Attribute (Maybe Path)

199+ buildInputs :: Map Identifier (Maybe Path)

198 buildInputs = Map.unions

200 buildInputs = Map.unions

199 [ Map.fromList [ (n, Nothing) | n <- Set.toList missing ]

201 [ Map.fromList [ (n, Nothing) | n <- Set.toList missing ]

200− , Map.fromList [ (n, resolveNixpkgsAttribute nixpkgs n) | n <- Set.toAscList systemDependencies ]

202+ , Map.fromList [ (n, resolveNixpkgsIdentifier nixpkgs n) | n <- Set.toAscList systemDependencies ]

201− , Map.fromList [ (n, resolveHackageThenNixpkgsAttribute nixpkgs hackage n) | n <- Set.toAscList haskellOrSystemDependencies ]

203+ , Map.fromList [ (n, resolveHackageThenNixpkgsIdentifier nixpkgs hackage n) | n <- Set.toAscList haskellOrSystemDependencies ]

202 ]

204 ]

203

205

204 systemOverrides :: Doc

206 systemOverrides :: Doc

205 systemOverrides = fsep (map (uncurry formatOverride) (Map.toAscList buildInputs))

207 systemOverrides = fsep (map (uncurry formatOverride) (Map.toAscList buildInputs))

206

208

207− formatOverride :: Attribute -> Maybe Path -> Doc

209+ formatOverride :: Identifier -> Maybe Path -> Doc

208− formatOverride n Nothing = space <> text n <> text " = null;" -- missing attribute

210+ formatOverride n Nothing = space <> pPrint n <> text " = null;" -- missing dependency

209− formatOverride n (Just []) = (text " inherit" <+> text n) <> semi

211+ formatOverride n (Just p) = case view path p of

212+ [] -> error ("internal error: " ++ show n ++ "resolved to empty path!")

210− formatOverride _ (Just ["self"]) = mempty -- callPackage finds this package already

213+ ["self"] -> mempty -- callPackage finds this package automatically

211− formatOverride n (Just p) = (text " inherit" <+> parens (text (intercalate "." p)) <+> text n) <> semi

214+ _ -> (text " inherit" <+> parens (pPrint p) <+> pPrint n) <> semi

212

215

213 overrides :: Doc

216 overrides :: Doc

214 overrides = systemOverrides

217 overrides = systemOverrides

@@ -235,24 +238,24 @@ generatePackageSet config hackage nixpkgs = do

235 liftIO $ mapM_ (\pkg -> putStrLn pkg >> putStrLn "") pkgs

238 liftIO $ mapM_ (\pkg -> putStrLn pkg >> putStrLn "") pkgs

236 liftIO $ putStrLn "}"

239 liftIO $ putStrLn "}"

237

240

238−resolveHackageThenNixpkgsAttribute :: Nixpkgs -> Hackage -> Attribute -> Maybe Path

241+resolveHackageThenNixpkgsIdentifier :: Nixpkgs -> Hackage -> Identifier -> Maybe Path

239−resolveHackageThenNixpkgsAttribute nixpkgs hackage name

242+resolveHackageThenNixpkgsIdentifier nixpkgs hackage name

240− | Just _ <- Map.lookup name hackage = Just ["self"]

243+ | Just _ <- Map.lookup (view ident name) hackage = Just (create path ["self"])

241− | p@(Just _) <- resolveNixpkgsAttribute nixpkgs name = p

244+ | p@(Just _) <- resolveNixpkgsIdentifier nixpkgs name = p

242 | otherwise = Nothing

245 | otherwise = Nothing

243

246

244−resolveNixpkgsAttribute :: Nixpkgs -> Attribute -> Maybe Path

247+resolveNixpkgsIdentifier :: Nixpkgs -> Identifier -> Maybe Path

245−resolveNixpkgsAttribute nixpkgs name

248+resolveNixpkgsIdentifier nixpkgs name

246− | name `elem` ["clang","lldb","llvm"] = Just ["self","llvmPackages"]

249+ | name `elem` ["clang","lldb","llvm"] = Just (create path ["self","llvmPackages"])

247 | Just paths <- Map.lookup name nixpkgs = getShortestPath (Set.toList (paths `Set.intersection` goodScopes))

250 | Just paths <- Map.lookup name nixpkgs = getShortestPath (Set.toList (paths `Set.intersection` goodScopes))

248 | otherwise = Nothing

251 | otherwise = Nothing

249− where

250− goodScopes :: Set Path

251− goodScopes = Set.fromList [[], ["xlibs"], ["gnome"], ["gnome3"], ["kde4"]]

252

253+goodScopes :: Set Path

254+goodScopes = Set.fromList ((map (create path . ("pkgs":))) [[], ["xlibs"], ["gnome"], ["gnome3"], ["kde4"]])

255+

253− getShortestPath :: [Path] -> Maybe Path

256+getShortestPath :: [Path] -> Maybe Path

254− getShortestPath [] = Nothing

257+getShortestPath [] = Nothing

255− getShortestPath ps = Just ("pkgs" : minimumBy (on compare length) ps)

258+getShortestPath ps = Just (minimumBy (on compare (view (path . to length))) ps)

256

259

257cabal2nix :: (Dependency -> Bool) -> GenericPackageDescription -> ([Dependency], FlagAssignment, Derivation)

260cabal2nix :: (Dependency -> Bool) -> GenericPackageDescription -> ([Dependency], FlagAssignment, Derivation)

258cabal2nix resolver cabal = (missingDeps, flags, drv)

261cabal2nix resolver cabal = (missingDeps, flags, drv)

@@ -284,8 +287,7 @@ cabal2nix resolver cabal = (missingDeps, flags, drv)

284 enableTest t = t { testEnabled = True }

287 enableTest t = t { testEnabled = True }

285

288

286readPreferredVersions :: FilePath -> IO [Constraint]

289readPreferredVersions :: FilePath -> IO [Constraint]

287−readPreferredVersions path = mapMaybe parsePreferredVersionsLine . lines <$> readFile path

290+readPreferredVersions p = mapMaybe parsePreferredVersionsLine . lines <$> readFile p

288−

289

291

290parsePreferredVersionsLine :: String -> Maybe Constraint

292parsePreferredVersionsLine :: String -> Maybe Constraint

291parsePreferredVersionsLine ('-':'-':_) = Nothing

293parsePreferredVersionsLine ('-':'-':_) = Nothing

test/spec.hs+7−7

@@ -1,6 +1,6 @@

1module Main ( main ) where

3−import Control.Lens

3+import Internal.Lens

4import Control.DeepSeq

5import Control.Exception

6import Distribution.Nixpkgs.License

@@ -13,12 +13,12 @@ main = do

13 describe "DeepSeq instances work properly for" $ do

14 it "License" $ mapM_ hitsBottom [Known undefined, Unknown (Just undefined)]

15 it "Meta" $ do mapM_ hitsBottom

16− [ nullMeta & homepage .~ undefined

16+ [ def & homepage .~ undefined

17− , nullMeta & description .~ undefined

17+ , def & description .~ undefined

18− , nullMeta & license .~ undefined

18+ , def & license .~ undefined

19− , nullMeta & platforms .~ undefined

19+ , def & platforms .~ undefined

20− , nullMeta & maintainers .~ undefined

20+ , def & maintainers .~ undefined

21− , nullMeta & broken .~ undefined

21+ , def & broken .~ undefined

22 ]

24hitsBottom :: NFData a => a -> Expectation