module Distribution.Nixpkgs.PackageMap
( PackageMap, readNixpkgPackageMap
, resolve
) where
import Control.Lens
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as LBS
import Data.Function
import Data.List (minimumBy)
import Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Set ( Set )
import qualified Data.Set as Set
import Language.Nix
import Paths_distribution_nixpkgs (getDataFileName)
import System.Process
type PackageMap = Map Identifier (Set Path)
readNixpkgPackageMap :: String
-> Maybe String
-> IO PackageMap
readNixpkgPackageMap :: String -> Maybe String -> IO PackageMap
readNixpkgPackageMap String
nixpkgsPath Maybe String
nixpkgsArgs =
Set [String] -> PackageMap
identifierSet2PackageMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String -> IO (Set [String])
readNixpkgSet String
nixpkgsPath Maybe String
nixpkgsArgs
readNixpkgSet :: String -> Maybe String -> IO (Set [String])
readNixpkgSet :: String -> Maybe String -> IO (Set [String])
readNixpkgSet String
nixpkgsPath Maybe String
nixpkgsArgs = do
String
pathsExpr <- String -> IO String
getDataFileName String
"derivation-attr-paths.nix"
let nixInstantiate :: CreateProcess
nixInstantiate = String -> [String] -> CreateProcess
proc String
"nix-instantiate"
[ String
"--strict"
, String
"--json"
, String
"--eval"
, String
pathsExpr
, String
"--arg", String
"nixpkgsPath", String
nixpkgsPath
, String
"--arg", String
"nixpkgsArgs", forall a. a -> Maybe a -> a
fromMaybe String
"{}" Maybe String
nixpkgsArgs
]
(Maybe Handle
_, Just Handle
h, Maybe Handle
_, ProcessHandle
_) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
nixInstantiate { std_out :: StdStream
std_out = StdStream
CreatePipe, env :: Maybe [(String, String)]
env = forall a. Maybe a
Nothing }
ByteString
buf <- Handle -> IO ByteString
LBS.hGetContents Handle
h
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecode ByteString
buf
identifierSet2PackageMap :: Set [String] -> PackageMap
identifierSet2PackageMap :: Set [String] -> PackageMap
identifierSet2PackageMap = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [String] -> PackageMap -> PackageMap
insertIdentifier forall k a. Map k a
Map.empty
where
insertIdentifier :: [String] -> (PackageMap -> PackageMap)
insertIdentifier :: [String] -> PackageMap -> PackageMap
insertIdentifier [String]
rawPath =
case [String] -> Maybe (Identifier, Path)
parsePackage [String]
rawPath of
Maybe (Identifier, Path)
Nothing -> forall a. a -> a
id
Just (Identifier
i, Path
p) -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Ord a => Set a -> Set a -> Set a
Set.union Identifier
i forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton Path
p
parsePackage :: [String] -> Maybe (Identifier, Path)
parsePackage :: [String] -> Maybe (Identifier, Path)
parsePackage [String]
x
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
x =
forall a. HasCallStack => String -> a
error String
"Distribution.Nixpkgs.PackageMap.parsepackage: empty path is no valid identifier"
| Bool
otherwise =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
needsQuoting [String]
x
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# forall a. [a] -> a
last [String]
x, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# forall a b. (a -> b) -> [a] -> [b]
map (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' Identifier String
ident) [String]
x)
resolve :: PackageMap -> Identifier -> Maybe Binding
resolve :: PackageMap -> Identifier -> Maybe Binding
resolve PackageMap
nixpkgs Identifier
i = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
i PackageMap
nixpkgs of
Maybe (Set Path)
Nothing -> forall a. Maybe a
Nothing
Just Set Path
ps -> let p :: Path
p = [Path] -> Path
chooseShortestPath (forall a. Set a -> [a]
Set.toList Set Path
ps)
in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i,Path
p)
chooseShortestPath :: [Path] -> Path
chooseShortestPath :: [Path] -> Path
chooseShortestPath [] = forall a. HasCallStack => String -> a
error String
"chooseShortestPath: called with empty list argument"
chooseShortestPath [Path]
ps = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Iso' Path [Identifier]
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall (t :: * -> *) a. Foldable t => t a -> Int
length))) [Path]
ps