git.iko.soy/typeable/cabal2nix
on aedba02 help sign in
typeable/cabal2nix/src/Distribution/Nixpkgs/PackageMap.hs
45 lines 2.0 kB history raw
1module Distribution.Nixpkgs.PackageMap where
3import qualified Data.Aeson as JSON
4import qualified Data.ByteString.Lazy as LBS
5import Data.List.Split
6import qualified Data.Map as Map
7import Data.Map.Strict ( Map )
8import Data.Set ( Set )
9import qualified Data.Set as Set
10import System.Process
11import Internal.Lens
12import Language.Nix.Identifier
13import Language.Nix.Path
14import Data.Maybe
15import Distribution.Nixpkgs.Util.PrettyPrinting
17type PackageMap = Map Identifier (Set Path)
19readNixpkgPackageMap :: FilePath -> Maybe Path -> IO PackageMap
20readNixpkgPackageMap nixpkgs attrpath = fmap identifierSet2PackageMap (readNixpkgSet nixpkgs attrpath)
22readNixpkgSet :: FilePath -> Maybe Path -> IO (Set String)
23readNixpkgSet 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
27 buf <- LBS.hGetContents h
28 let pkgmap :: Either String (Map String JSON.Object)
29 pkgmap = JSON.eitherDecode buf
30 either fail (return . Map.keysSet) pkgmap
32identifierSet2PackageMap :: Set String -> PackageMap
33identifierSet2PackageMap pkgset = foldr (uncurry insertIdentifier) Map.empty pkglist
34 where
35 pkglist :: [(Identifier, Path)]
36 pkglist = mapMaybe parsePackage (Set.toList pkgset)
38 insertIdentifier :: Identifier -> Path -> PackageMap -> PackageMap
39 insertIdentifier i = Map.insertWith Set.union i . Set.singleton
41parsePackage :: String -> Maybe (Identifier, Path)
42parsePackage 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)))