git.iko.soy/typeable/cabal2nix
on d3bb1da help sign in
typeable/cabal2nix/src/Distribution/Nixpkgs/PackageMap.hs
59 lines 2.5 kB history raw
1module Distribution.Nixpkgs.PackageMap
2 ( PackageMap, readNixpkgPackageMap
3 , resolve
4 ) where
6import qualified Data.Aeson as JSON
7import qualified Data.ByteString.Lazy as LBS
8import Data.Function
9import Data.List as List
10import Data.List.Split
11import qualified Data.Map.Strict as Map
12import Data.Map.Strict ( Map )
13import Data.Maybe
14import Data.Set ( Set )
15import qualified Data.Set as Set
16import Internal.Lens
17import Internal.PrettyPrinting
18import Language.Nix
19import System.Process
21type PackageMap = Map Identifier (Set Path)
23readNixpkgPackageMap :: FilePath -> Maybe Path -> IO PackageMap
24readNixpkgPackageMap nixpkgs attrpath = fmap identifierSet2PackageMap (readNixpkgSet nixpkgs attrpath)
26readNixpkgSet :: FilePath -> Maybe Path -> IO (Set String)
27readNixpkgSet nixpkgs attrpath = do
28 let extraArgs = maybe [] (\p -> ["-A", render (pPrint p)]) attrpath
29 (_, Just h, _, _) <- createProcess (proc "nix-env" (["-qaP", "--json", "-f"++nixpkgs] ++ extraArgs))
30 { std_out = CreatePipe, env = Nothing } -- TODO: ensure that overrides don't screw up our results
31 buf <- LBS.hGetContents h
32 let pkgmap :: Either String (Map String JSON.Object)
33 pkgmap = JSON.eitherDecode buf
34 either fail (return . Map.keysSet) pkgmap
36identifierSet2PackageMap :: Set String -> PackageMap
37identifierSet2PackageMap pkgset = foldr (uncurry insertIdentifier) Map.empty pkglist
38 where
39 pkglist :: [(Identifier, Path)]
40 pkglist = mapMaybe parsePackage (Set.toList pkgset)
42 insertIdentifier :: Identifier -> Path -> PackageMap -> PackageMap
43 insertIdentifier i = Map.insertWith Set.union i . Set.singleton
45parsePackage :: String -> Maybe (Identifier, Path)
46parsePackage x | null x = error "Distribution.Nixpkgs.PackageMap.parsepackage: empty string is no valid identifier"
47 | xs <- splitOn "." x = if needsQuoting (head xs)
48 then Nothing
49 else Just (create ident (last xs), create path (map (create ident) xs))
51resolve :: PackageMap -> Identifier -> Maybe Binding
52resolve nixpkgs i = case Map.lookup i nixpkgs of
53 Nothing -> Nothing
54 Just ps -> let p = chooseShortestPath (Set.toList ps)
55 in Just $ create binding (i,p)
57chooseShortestPath :: [Path] -> Path
58chooseShortestPath [] = error "chooseShortestPath: called with empty list argument"
59chooseShortestPath ps = minimumBy (on compare (view (path . to length))) ps