module NixTree.StorePath
  ( StoreName (..),
    storeNameToPath,
    storeNameToText,
    storeNameToShortText,
    storeNameToSplitShortText,
    storeNameToShortTextWithDisambiguation,
    NixPathSignature (..),
    StorePath (..),
    Installable (..),
    StoreEnv (..),
    StoreEnvOptions (..),
    withStoreEnv,
    seLookup,
    seAll,
    seGetRoots,
    seBottomUp,
    seFetchRefs,
    mkStoreName,
    storeEnvToDot,
  )
where

import Data.Aeson (FromJSON (..), Value (..), decode, eitherDecode, (.!=), (.:), (.:?))
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Dot
import System.FilePath.Posix (addTrailingPathSeparator, splitDirectories, (</>))
import System.IO (hPutStrLn)
import System.Process.Typed (proc, readProcessStdout_)

-- Technically these both are filepaths. However, most people use the default "/nix/store",
-- hence special casing it speeds things up.
data NixStore
  = NixStore
  | NixStoreCustom FilePath
  deriving stock (Int -> NixStore -> ShowS
[NixStore] -> ShowS
NixStore -> FilePath
(Int -> NixStore -> ShowS)
-> (NixStore -> FilePath) -> ([NixStore] -> ShowS) -> Show NixStore
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixStore -> ShowS
showsPrec :: Int -> NixStore -> ShowS
$cshow :: NixStore -> FilePath
show :: NixStore -> FilePath
$cshowList :: [NixStore] -> ShowS
showList :: [NixStore] -> ShowS
Show, NixStore -> NixStore -> Bool
(NixStore -> NixStore -> Bool)
-> (NixStore -> NixStore -> Bool) -> Eq NixStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixStore -> NixStore -> Bool
== :: NixStore -> NixStore -> Bool
$c/= :: NixStore -> NixStore -> Bool
/= :: NixStore -> NixStore -> Bool
Eq, Eq NixStore
Eq NixStore =>
(NixStore -> NixStore -> Ordering)
-> (NixStore -> NixStore -> Bool)
-> (NixStore -> NixStore -> Bool)
-> (NixStore -> NixStore -> Bool)
-> (NixStore -> NixStore -> Bool)
-> (NixStore -> NixStore -> NixStore)
-> (NixStore -> NixStore -> NixStore)
-> Ord NixStore
NixStore -> NixStore -> Bool
NixStore -> NixStore -> Ordering
NixStore -> NixStore -> NixStore
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NixStore -> NixStore -> Ordering
compare :: NixStore -> NixStore -> Ordering
$c< :: NixStore -> NixStore -> Bool
< :: NixStore -> NixStore -> Bool
$c<= :: NixStore -> NixStore -> Bool
<= :: NixStore -> NixStore -> Bool
$c> :: NixStore -> NixStore -> Bool
> :: NixStore -> NixStore -> Bool
$c>= :: NixStore -> NixStore -> Bool
>= :: NixStore -> NixStore -> Bool
$cmax :: NixStore -> NixStore -> NixStore
max :: NixStore -> NixStore -> NixStore
$cmin :: NixStore -> NixStore -> NixStore
min :: NixStore -> NixStore -> NixStore
Ord, (forall x. NixStore -> Rep NixStore x)
-> (forall x. Rep NixStore x -> NixStore) -> Generic NixStore
forall x. Rep NixStore x -> NixStore
forall x. NixStore -> Rep NixStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NixStore -> Rep NixStore x
from :: forall x. NixStore -> Rep NixStore x
$cto :: forall x. Rep NixStore x -> NixStore
to :: forall x. Rep NixStore x -> NixStore
Generic)
  deriving anyclass (NixStore -> ()
(NixStore -> ()) -> NFData NixStore
forall a. (a -> ()) -> NFData a
$crnf :: NixStore -> ()
rnf :: NixStore -> ()
NFData, Eq NixStore
Eq NixStore =>
(Int -> NixStore -> Int) -> (NixStore -> Int) -> Hashable NixStore
Int -> NixStore -> Int
NixStore -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NixStore -> Int
hashWithSalt :: Int -> NixStore -> Int
$chash :: NixStore -> Int
hash :: NixStore -> Int
Hashable)

mkNixStore :: FilePath -> NixStore
mkNixStore :: FilePath -> NixStore
mkNixStore FilePath
i' =
  let i :: FilePath
i = ShowS
addTrailingPathSeparator FilePath
i'
   in if FilePath
i FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/nix/store/" then NixStore
NixStore else FilePath -> NixStore
NixStoreCustom FilePath
i

unNixStore :: NixStore -> FilePath
unNixStore :: NixStore -> FilePath
unNixStore NixStore
NixStore = FilePath
"/nix/store/"
unNixStore (NixStoreCustom FilePath
fp) = FilePath
fp

getStoreDir :: Maybe FilePath -> IO NixStore
getStoreDir :: Maybe FilePath -> IO NixStore
getStoreDir Maybe FilePath
seoNixStore = do
  let prog :: FilePath
prog = FilePath
"nix-instantiate"
      args :: [FilePath]
args =
        [FilePath
"--eval", FilePath
"--expr", FilePath
"(builtins.storeDir)", FilePath
"--json"]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ( case Maybe FilePath
seoNixStore of
                 Maybe FilePath
Nothing -> []
                 Just FilePath
url -> [FilePath
"--option", FilePath
"store", FilePath
url]
             )
  Maybe NixStore
out <-
    ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
prog [FilePath]
args)
      IO ByteString
-> (ByteString -> Maybe NixStore) -> IO (Maybe NixStore)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (FilePath -> NixStore) -> Maybe FilePath -> Maybe NixStore
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> NixStore
mkNixStore
      (Maybe FilePath -> Maybe NixStore)
-> (ByteString -> Maybe FilePath) -> ByteString -> Maybe NixStore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
decode @FilePath
  case Maybe NixStore
out of
    Maybe NixStore
Nothing -> FilePath -> IO NixStore
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO NixStore) -> FilePath -> IO NixStore
forall a b. (a -> b) -> a -> b
$ FilePath
"Error interpreting output of: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (FilePath, [FilePath]) -> FilePath
forall b a. (Show a, IsString b) => a -> b
show (FilePath
prog, [FilePath]
args)
    Just NixStore
p -> NixStore -> IO NixStore
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NixStore
p

--------------------------------------------------------------------------------

data StoreName = StoreName NixStore Text
  deriving stock (Int -> StoreName -> ShowS
[StoreName] -> ShowS
StoreName -> FilePath
(Int -> StoreName -> ShowS)
-> (StoreName -> FilePath)
-> ([StoreName] -> ShowS)
-> Show StoreName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreName -> ShowS
showsPrec :: Int -> StoreName -> ShowS
$cshow :: StoreName -> FilePath
show :: StoreName -> FilePath
$cshowList :: [StoreName] -> ShowS
showList :: [StoreName] -> ShowS
Show, StoreName -> StoreName -> Bool
(StoreName -> StoreName -> Bool)
-> (StoreName -> StoreName -> Bool) -> Eq StoreName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreName -> StoreName -> Bool
== :: StoreName -> StoreName -> Bool
$c/= :: StoreName -> StoreName -> Bool
/= :: StoreName -> StoreName -> Bool
Eq, Eq StoreName
Eq StoreName =>
(StoreName -> StoreName -> Ordering)
-> (StoreName -> StoreName -> Bool)
-> (StoreName -> StoreName -> Bool)
-> (StoreName -> StoreName -> Bool)
-> (StoreName -> StoreName -> Bool)
-> (StoreName -> StoreName -> StoreName)
-> (StoreName -> StoreName -> StoreName)
-> Ord StoreName
StoreName -> StoreName -> Bool
StoreName -> StoreName -> Ordering
StoreName -> StoreName -> StoreName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StoreName -> StoreName -> Ordering
compare :: StoreName -> StoreName -> Ordering
$c< :: StoreName -> StoreName -> Bool
< :: StoreName -> StoreName -> Bool
$c<= :: StoreName -> StoreName -> Bool
<= :: StoreName -> StoreName -> Bool
$c> :: StoreName -> StoreName -> Bool
> :: StoreName -> StoreName -> Bool
$c>= :: StoreName -> StoreName -> Bool
>= :: StoreName -> StoreName -> Bool
$cmax :: StoreName -> StoreName -> StoreName
max :: StoreName -> StoreName -> StoreName
$cmin :: StoreName -> StoreName -> StoreName
min :: StoreName -> StoreName -> StoreName
Ord, (forall x. StoreName -> Rep StoreName x)
-> (forall x. Rep StoreName x -> StoreName) -> Generic StoreName
forall x. Rep StoreName x -> StoreName
forall x. StoreName -> Rep StoreName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoreName -> Rep StoreName x
from :: forall x. StoreName -> Rep StoreName x
$cto :: forall x. Rep StoreName x -> StoreName
to :: forall x. Rep StoreName x -> StoreName
Generic)
  deriving anyclass (StoreName -> ()
(StoreName -> ()) -> NFData StoreName
forall a. (a -> ()) -> NFData a
$crnf :: StoreName -> ()
rnf :: StoreName -> ()
NFData, Eq StoreName
Eq StoreName =>
(Int -> StoreName -> Int)
-> (StoreName -> Int) -> Hashable StoreName
Int -> StoreName -> Int
StoreName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StoreName -> Int
hashWithSalt :: Int -> StoreName -> Int
$chash :: StoreName -> Int
hash :: StoreName -> Int
Hashable)

mkStoreName :: NixStore -> FilePath -> Maybe StoreName
mkStoreName :: NixStore -> FilePath -> Maybe StoreName
mkStoreName NixStore
ns FilePath
path = do
  let ps :: FilePath
ps = NixStore -> FilePath
unNixStore NixStore
ns
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ FilePath
ps FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
path
  let ds :: [FilePath]
ds = FilePath -> [FilePath]
splitDirectories (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ps) FilePath
path)
  FilePath
sn <- [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe [FilePath]
ds
  StoreName -> Maybe StoreName
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreName -> Maybe StoreName) -> StoreName -> Maybe StoreName
forall a b. (a -> b) -> a -> b
$ NixStore -> Text -> StoreName
StoreName NixStore
ns (FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
sn)

storeNameToText :: StoreName -> Text
storeNameToText :: StoreName -> Text
storeNameToText (StoreName NixStore
_ Text
n) = Text
n

storeNameToPath :: StoreName -> FilePath
storeNameToPath :: StoreName -> FilePath
storeNameToPath (StoreName NixStore
ns Text
sn) = NixStore -> FilePath
unNixStore NixStore
ns FilePath -> ShowS
</> Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
sn

storeNameToShortText :: StoreName -> Text
storeNameToShortText :: StoreName -> Text
storeNameToShortText = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text)
-> (StoreName -> (Text, Text)) -> StoreName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreName -> (Text, Text)
storeNameToSplitShortText

storeNameToShortTextWithDisambiguation :: Int -> StoreName -> Text
storeNameToShortTextWithDisambiguation :: Int -> StoreName -> Text
storeNameToShortTextWithDisambiguation Int
0 StoreName
sn = StoreName -> Text
storeNameToShortText StoreName
sn
storeNameToShortTextWithDisambiguation Int
n (StoreName NixStore
ns Text
sn) =
  let (Text
f, Text
s) = StoreName -> (Text, Text)
storeNameToSplitShortText (NixStore -> Text -> StoreName
StoreName NixStore
ns Text
sn)
   in Int -> Text -> Text
T.take Int
n Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

storeNameToSplitShortText :: StoreName -> (Text, Text)
storeNameToSplitShortText :: StoreName -> (Text, Text)
storeNameToSplitShortText StoreName
txt =
  case (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ StoreName -> Text
storeNameToText StoreName
txt of
    (Text
f, Text
s) | Just (Char
c, Text
s'') <- Text -> Maybe (Char, Text)
T.uncons Text
s -> (Text -> Char -> Text
T.snoc Text
f Char
c, Text
s'')
    (Text, Text)
e -> (Text, Text)
e

--------------------------------------------------------------------------------

data NixVersion
  = NixOlder
  | Nix2_4
  | NixNewer
  | NixUnknown
  deriving (Int -> NixVersion -> ShowS
[NixVersion] -> ShowS
NixVersion -> FilePath
(Int -> NixVersion -> ShowS)
-> (NixVersion -> FilePath)
-> ([NixVersion] -> ShowS)
-> Show NixVersion
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixVersion -> ShowS
showsPrec :: Int -> NixVersion -> ShowS
$cshow :: NixVersion -> FilePath
show :: NixVersion -> FilePath
$cshowList :: [NixVersion] -> ShowS
showList :: [NixVersion] -> ShowS
Show, NixVersion -> NixVersion -> Bool
(NixVersion -> NixVersion -> Bool)
-> (NixVersion -> NixVersion -> Bool) -> Eq NixVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixVersion -> NixVersion -> Bool
== :: NixVersion -> NixVersion -> Bool
$c/= :: NixVersion -> NixVersion -> Bool
/= :: NixVersion -> NixVersion -> Bool
Eq, Eq NixVersion
Eq NixVersion =>
(NixVersion -> NixVersion -> Ordering)
-> (NixVersion -> NixVersion -> Bool)
-> (NixVersion -> NixVersion -> Bool)
-> (NixVersion -> NixVersion -> Bool)
-> (NixVersion -> NixVersion -> Bool)
-> (NixVersion -> NixVersion -> NixVersion)
-> (NixVersion -> NixVersion -> NixVersion)
-> Ord NixVersion
NixVersion -> NixVersion -> Bool
NixVersion -> NixVersion -> Ordering
NixVersion -> NixVersion -> NixVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NixVersion -> NixVersion -> Ordering
compare :: NixVersion -> NixVersion -> Ordering
$c< :: NixVersion -> NixVersion -> Bool
< :: NixVersion -> NixVersion -> Bool
$c<= :: NixVersion -> NixVersion -> Bool
<= :: NixVersion -> NixVersion -> Bool
$c> :: NixVersion -> NixVersion -> Bool
> :: NixVersion -> NixVersion -> Bool
$c>= :: NixVersion -> NixVersion -> Bool
>= :: NixVersion -> NixVersion -> Bool
$cmax :: NixVersion -> NixVersion -> NixVersion
max :: NixVersion -> NixVersion -> NixVersion
$cmin :: NixVersion -> NixVersion -> NixVersion
min :: NixVersion -> NixVersion -> NixVersion
Ord)

getNixVersion :: IO NixVersion
getNixVersion :: IO NixVersion
getNixVersion = do
  Text
out <- StrictByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (StrictByteString -> Text)
-> (ByteString -> StrictByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StrictByteString
BL.toStrict (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_ (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"nix" [FilePath
"--version"])

  -- Parses strings like:
  --  nix (Nix) 2.6.0pre20211217_6e6e998
  --  nix (Nix) 2.5.1
  NixVersion -> IO NixVersion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NixVersion -> IO NixVersion)
-> (Maybe NixVersion -> NixVersion)
-> Maybe NixVersion
-> IO NixVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixVersion -> Maybe NixVersion -> NixVersion
forall a. a -> Maybe a -> a
fromMaybe NixVersion
NixUnknown (Maybe NixVersion -> IO NixVersion)
-> Maybe NixVersion -> IO NixVersion
forall a b. (a -> b) -> a -> b
$ do
    -- get the last space delimited part
    Text
ver <-
      Text
out
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
" "
        [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& (NonEmpty Text -> Text) -> [Text] -> Maybe Text
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Text -> Text
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last

    -- split by ".", take the first two, and convert them to numbers
    (Natural
major, Natural
minor) <- do
      (Text
maT, Text
miT) <- case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
ver of
        Text
p1 : Text
p2 : [Text]
_ -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
p1, Text
p2)
        [Text]
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
      Natural
ma <- forall a. Read a => FilePath -> Maybe a
readMaybe @Natural (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
maT)
      Natural
mi <- forall a. Read a => FilePath -> Maybe a
readMaybe @Natural (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
miT)
      (Natural, Natural) -> Maybe (Natural, Natural)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural
ma, Natural
mi)

    -- map it to the sum
    NixVersion -> Maybe NixVersion
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (NixVersion -> Maybe NixVersion) -> NixVersion -> Maybe NixVersion
forall a b. (a -> b) -> a -> b
$ case (Natural, Natural) -> (Natural, Natural) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Natural
major, Natural
minor) (Natural
2, Natural
4) of
      Ordering
LT -> NixVersion
NixOlder
      Ordering
EQ -> NixVersion
Nix2_4
      Ordering
GT -> NixVersion
NixNewer

--------------------------------------------------------------------------------

data StorePath ref payload = StorePath
  { forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName,
    forall ref payload. StorePath ref payload -> Int
spSize :: Int,
    forall ref payload. StorePath ref payload -> [ref]
spRefs :: [ref],
    forall ref payload. StorePath ref payload -> payload
spPayload :: payload,
    forall ref payload. StorePath ref payload -> [NixPathSignature]
spSignatures :: [NixPathSignature]
  }
  deriving (Int -> StorePath ref payload -> ShowS
[StorePath ref payload] -> ShowS
StorePath ref payload -> FilePath
(Int -> StorePath ref payload -> ShowS)
-> (StorePath ref payload -> FilePath)
-> ([StorePath ref payload] -> ShowS)
-> Show (StorePath ref payload)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall ref payload.
(Show ref, Show payload) =>
Int -> StorePath ref payload -> ShowS
forall ref payload.
(Show ref, Show payload) =>
[StorePath ref payload] -> ShowS
forall ref payload.
(Show ref, Show payload) =>
StorePath ref payload -> FilePath
$cshowsPrec :: forall ref payload.
(Show ref, Show payload) =>
Int -> StorePath ref payload -> ShowS
showsPrec :: Int -> StorePath ref payload -> ShowS
$cshow :: forall ref payload.
(Show ref, Show payload) =>
StorePath ref payload -> FilePath
show :: StorePath ref payload -> FilePath
$cshowList :: forall ref payload.
(Show ref, Show payload) =>
[StorePath ref payload] -> ShowS
showList :: [StorePath ref payload] -> ShowS
Show, StorePath ref payload -> StorePath ref payload -> Bool
(StorePath ref payload -> StorePath ref payload -> Bool)
-> (StorePath ref payload -> StorePath ref payload -> Bool)
-> Eq (StorePath ref payload)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ref payload.
(Eq ref, Eq payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
$c== :: forall ref payload.
(Eq ref, Eq payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
== :: StorePath ref payload -> StorePath ref payload -> Bool
$c/= :: forall ref payload.
(Eq ref, Eq payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
/= :: StorePath ref payload -> StorePath ref payload -> Bool
Eq, Eq (StorePath ref payload)
Eq (StorePath ref payload) =>
(StorePath ref payload -> StorePath ref payload -> Ordering)
-> (StorePath ref payload -> StorePath ref payload -> Bool)
-> (StorePath ref payload -> StorePath ref payload -> Bool)
-> (StorePath ref payload -> StorePath ref payload -> Bool)
-> (StorePath ref payload -> StorePath ref payload -> Bool)
-> (StorePath ref payload
    -> StorePath ref payload -> StorePath ref payload)
-> (StorePath ref payload
    -> StorePath ref payload -> StorePath ref payload)
-> Ord (StorePath ref payload)
StorePath ref payload -> StorePath ref payload -> Bool
StorePath ref payload -> StorePath ref payload -> Ordering
StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall ref payload.
(Ord ref, Ord payload) =>
Eq (StorePath ref payload)
forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Ordering
forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
$ccompare :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Ordering
compare :: StorePath ref payload -> StorePath ref payload -> Ordering
$c< :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
< :: StorePath ref payload -> StorePath ref payload -> Bool
$c<= :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
<= :: StorePath ref payload -> StorePath ref payload -> Bool
$c> :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
> :: StorePath ref payload -> StorePath ref payload -> Bool
$c>= :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload -> StorePath ref payload -> Bool
>= :: StorePath ref payload -> StorePath ref payload -> Bool
$cmax :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
max :: StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
$cmin :: forall ref payload.
(Ord ref, Ord payload) =>
StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
min :: StorePath ref payload
-> StorePath ref payload -> StorePath ref payload
Ord, (forall a b. (a -> b) -> StorePath ref a -> StorePath ref b)
-> (forall a b. a -> StorePath ref b -> StorePath ref a)
-> Functor (StorePath ref)
forall a b. a -> StorePath ref b -> StorePath ref a
forall a b. (a -> b) -> StorePath ref a -> StorePath ref b
forall ref a b. a -> StorePath ref b -> StorePath ref a
forall ref a b. (a -> b) -> StorePath ref a -> StorePath ref b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall ref a b. (a -> b) -> StorePath ref a -> StorePath ref b
fmap :: forall a b. (a -> b) -> StorePath ref a -> StorePath ref b
$c<$ :: forall ref a b. a -> StorePath ref b -> StorePath ref a
<$ :: forall a b. a -> StorePath ref b -> StorePath ref a
Functor, (forall x. StorePath ref payload -> Rep (StorePath ref payload) x)
-> (forall x.
    Rep (StorePath ref payload) x -> StorePath ref payload)
-> Generic (StorePath ref payload)
forall x. Rep (StorePath ref payload) x -> StorePath ref payload
forall x. StorePath ref payload -> Rep (StorePath ref payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ref payload x.
Rep (StorePath ref payload) x -> StorePath ref payload
forall ref payload x.
StorePath ref payload -> Rep (StorePath ref payload) x
$cfrom :: forall ref payload x.
StorePath ref payload -> Rep (StorePath ref payload) x
from :: forall x. StorePath ref payload -> Rep (StorePath ref payload) x
$cto :: forall ref payload x.
Rep (StorePath ref payload) x -> StorePath ref payload
to :: forall x. Rep (StorePath ref payload) x -> StorePath ref payload
Generic)

instance (NFData a, NFData b) => NFData (StorePath a b)

newtype Installable = Installable {Installable -> Text
installableToText :: Text}

--------------------------------------------------------------------------------

data PathInfoOptions = PathInfoOptions
  { PathInfoOptions -> Bool
pioIsRecursive :: Bool,
    PathInfoOptions -> Bool
pioIsDerivation :: Bool,
    PathInfoOptions -> Bool
pioIsImpure :: Bool,
    PathInfoOptions -> Maybe FilePath
pioStoreURL :: Maybe FilePath,
    PathInfoOptions -> Maybe FilePath
pioFile :: Maybe FilePath
  }

getPathInfo :: NixStore -> NixVersion -> PathInfoOptions -> NonEmpty Installable -> IO (NonEmpty (StorePath StoreName ()))
getPathInfo :: NixStore
-> NixVersion
-> PathInfoOptions
-> NonEmpty Installable
-> IO (NonEmpty (StorePath StoreName ()))
getPathInfo NixStore
nixStore NixVersion
nixVersion PathInfoOptions
options NonEmpty Installable
names = do
  NonEmpty NixPathInfo
infos <-
    forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode @NixPathOutput
      (ByteString -> Either FilePath NixPathOutput)
-> IO ByteString -> IO (Either FilePath NixPathOutput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessConfig () () () -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_
        ( FilePath -> [FilePath] -> ProcessConfig () () ()
proc
            FilePath
"nix"
            ( [FilePath
"path-info", FilePath
"--json"]
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--impure" | PathInfoOptions
options PathInfoOptions -> (PathInfoOptions -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& PathInfoOptions -> Bool
pioIsImpure]
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--recursive" | PathInfoOptions
options PathInfoOptions -> (PathInfoOptions -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& PathInfoOptions -> Bool
pioIsRecursive]
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--derivation" | (PathInfoOptions
options PathInfoOptions -> (PathInfoOptions -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& PathInfoOptions -> Bool
pioIsDerivation) Bool -> Bool -> Bool
&& NixVersion
nixVersion NixVersion -> NixVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NixVersion
Nix2_4]
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ( case PathInfoOptions
options PathInfoOptions
-> (PathInfoOptions -> Maybe FilePath) -> Maybe FilePath
forall a b. a -> (a -> b) -> b
& PathInfoOptions -> Maybe FilePath
pioStoreURL of
                       Maybe FilePath
Nothing -> []
                       Just FilePath
url -> [FilePath
"--store", FilePath
url]
                   )
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ( case PathInfoOptions
options PathInfoOptions
-> (PathInfoOptions -> Maybe FilePath) -> Maybe FilePath
forall a b. a -> (a -> b) -> b
& PathInfoOptions -> Maybe FilePath
pioFile of
                       Maybe FilePath
Nothing -> []
                       Just FilePath
file -> [FilePath
"--file", FilePath
file]
                   )
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if NixVersion
nixVersion NixVersion -> NixVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= NixVersion
Nix2_4 then [FilePath
"--extra-experimental-features", FilePath
"nix-command flakes"] else [])
                [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Installable -> FilePath) -> [Installable] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath)
-> (Installable -> Text) -> Installable -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Installable -> Text
installableToText) (NonEmpty Installable -> [Installable]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Installable
names)
            )
        )
      IO (Either FilePath NixPathOutput)
-> (Either FilePath NixPathOutput -> IO NixPathOutput)
-> IO NixPathOutput
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO NixPathOutput)
-> (NixPathOutput -> IO NixPathOutput)
-> Either FilePath NixPathOutput
-> IO NixPathOutput
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\FilePath
e -> FilePath -> IO NixPathOutput
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO NixPathOutput) -> FilePath -> IO NixPathOutput
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed parsing nix path-info output: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall b a. (Show a, IsString b) => a -> b
show FilePath
e) NixPathOutput -> IO NixPathOutput
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      IO NixPathOutput
-> (NixPathOutput -> IO [NixPathInfo]) -> IO [NixPathInfo]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NixPathInfoResult -> IO NixPathInfo)
-> [NixPathInfoResult] -> IO [NixPathInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM NixPathInfoResult -> IO NixPathInfo
forall {m :: * -> *}.
MonadFail m =>
NixPathInfoResult -> m NixPathInfo
assertValidInfo ([NixPathInfoResult] -> IO [NixPathInfo])
-> (NixPathOutput -> [NixPathInfoResult])
-> NixPathOutput
-> IO [NixPathInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixPathOutput -> [NixPathInfoResult]
npoResults
      IO [NixPathInfo]
-> ([NixPathInfo] -> IO (NonEmpty NixPathInfo))
-> IO (NonEmpty NixPathInfo)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (NonEmpty NixPathInfo)
-> (NonEmpty NixPathInfo -> IO (NonEmpty NixPathInfo))
-> Maybe (NonEmpty NixPathInfo)
-> IO (NonEmpty NixPathInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO (NonEmpty NixPathInfo)
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"invariant violation: getPathInfo returned []") NonEmpty NixPathInfo -> IO (NonEmpty NixPathInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (NonEmpty NixPathInfo) -> IO (NonEmpty NixPathInfo))
-> ([NixPathInfo] -> Maybe (NonEmpty NixPathInfo))
-> [NixPathInfo]
-> IO (NonEmpty NixPathInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NixPathInfo] -> Maybe (NonEmpty NixPathInfo)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty

  (NixPathInfo -> IO (StorePath StoreName ()))
-> NonEmpty NixPathInfo -> IO (NonEmpty (StorePath StoreName ()))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM NixPathInfo -> IO (StorePath StoreName ())
forall {m :: * -> *}.
MonadFail m =>
NixPathInfo -> m (StorePath StoreName ())
infoToStorePath NonEmpty NixPathInfo
infos
  where
    infoToStorePath :: NixPathInfo -> m (StorePath StoreName ())
infoToStorePath NixPathInfo {FilePath
npiPath :: FilePath
npiPath :: NixPathInfo -> FilePath
npiPath, Int
npiNarSize :: Int
npiNarSize :: NixPathInfo -> Int
npiNarSize, [FilePath]
npiReferences :: [FilePath]
npiReferences :: NixPathInfo -> [FilePath]
npiReferences, [NixPathSignature]
npiSignatures :: [NixPathSignature]
npiSignatures :: NixPathInfo -> [NixPathSignature]
npiSignatures} = do
      StoreName
name <- FilePath -> m StoreName
forall {m :: * -> *}. MonadFail m => FilePath -> m StoreName
mkStoreNameIO FilePath
npiPath
      [StoreName]
refs <- (StoreName -> Bool) -> [StoreName] -> [StoreName]
forall a. (a -> Bool) -> [a] -> [a]
filter (StoreName -> StoreName -> Bool
forall a. Eq a => a -> a -> Bool
/= StoreName
name) ([StoreName] -> [StoreName]) -> m [StoreName] -> m [StoreName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m StoreName) -> [FilePath] -> m [StoreName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> m StoreName
forall {m :: * -> *}. MonadFail m => FilePath -> m StoreName
mkStoreNameIO [FilePath]
npiReferences
      StorePath StoreName () -> m (StorePath StoreName ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StorePath StoreName () -> m (StorePath StoreName ()))
-> StorePath StoreName () -> m (StorePath StoreName ())
forall a b. (a -> b) -> a -> b
$
        StorePath
          { spName :: StoreName
spName = StoreName
name,
            spRefs :: [StoreName]
spRefs = [StoreName]
refs,
            spSize :: Int
spSize = Int
npiNarSize,
            spSignatures :: [NixPathSignature]
spSignatures = [NixPathSignature]
npiSignatures,
            spPayload :: ()
spPayload = ()
          }
    mkStoreNameIO :: FilePath -> m StoreName
mkStoreNameIO FilePath
p =
      m StoreName
-> (StoreName -> m StoreName) -> Maybe StoreName -> m StoreName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (FilePath -> m StoreName
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m StoreName) -> FilePath -> m StoreName
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed parsing Nix store path: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall b a. (Show a, IsString b) => a -> b
show FilePath
p)
        StoreName -> m StoreName
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (NixStore -> FilePath -> Maybe StoreName
mkStoreName NixStore
nixStore FilePath
p)

    assertValidInfo :: NixPathInfoResult -> m NixPathInfo
assertValidInfo (NixPathInfoValid NixPathInfo
pathinfo) = NixPathInfo -> m NixPathInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return NixPathInfo
pathinfo
    assertValidInfo (NixPathInfoInvalid FilePath
path) =
      FilePath -> m NixPathInfo
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m NixPathInfo) -> FilePath -> m NixPathInfo
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid path: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
". Make sure that it is built, or pass '--derivation' if you want to work on the derivation."

--------------------------------------------------------------------------------

data StoreEnv payload = StoreEnv
  { forall payload.
StoreEnv payload -> HashMap StoreName (StorePath StoreName payload)
sePaths :: HashMap StoreName (StorePath StoreName payload),
    forall payload. StoreEnv payload -> NonEmpty StoreName
seRoots :: NonEmpty StoreName
  }
  deriving ((forall a b. (a -> b) -> StoreEnv a -> StoreEnv b)
-> (forall a b. a -> StoreEnv b -> StoreEnv a) -> Functor StoreEnv
forall a b. a -> StoreEnv b -> StoreEnv a
forall a b. (a -> b) -> StoreEnv a -> StoreEnv b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> StoreEnv a -> StoreEnv b
fmap :: forall a b. (a -> b) -> StoreEnv a -> StoreEnv b
$c<$ :: forall a b. a -> StoreEnv b -> StoreEnv a
<$ :: forall a b. a -> StoreEnv b -> StoreEnv a
Functor, (forall x. StoreEnv payload -> Rep (StoreEnv payload) x)
-> (forall x. Rep (StoreEnv payload) x -> StoreEnv payload)
-> Generic (StoreEnv payload)
forall x. Rep (StoreEnv payload) x -> StoreEnv payload
forall x. StoreEnv payload -> Rep (StoreEnv payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload x. Rep (StoreEnv payload) x -> StoreEnv payload
forall payload x. StoreEnv payload -> Rep (StoreEnv payload) x
$cfrom :: forall payload x. StoreEnv payload -> Rep (StoreEnv payload) x
from :: forall x. StoreEnv payload -> Rep (StoreEnv payload) x
$cto :: forall payload x. Rep (StoreEnv payload) x -> StoreEnv payload
to :: forall x. Rep (StoreEnv payload) x -> StoreEnv payload
Generic, StoreEnv payload -> ()
(StoreEnv payload -> ()) -> NFData (StoreEnv payload)
forall payload. NFData payload => StoreEnv payload -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall payload. NFData payload => StoreEnv payload -> ()
rnf :: StoreEnv payload -> ()
NFData)

data StoreEnvOptions = StoreEnvOptions
  { StoreEnvOptions -> Bool
seoIsDerivation :: Bool,
    StoreEnvOptions -> Bool
seoIsImpure :: Bool,
    StoreEnvOptions -> Maybe FilePath
seoStoreURL :: Maybe String,
    StoreEnvOptions -> Maybe FilePath
seoFile :: Maybe String
  }

withStoreEnv ::
  forall m a.
  (MonadIO m) =>
  StoreEnvOptions ->
  NonEmpty Installable ->
  (StoreEnv () -> m a) ->
  m a
withStoreEnv :: forall (m :: * -> *) a.
MonadIO m =>
StoreEnvOptions
-> NonEmpty Installable -> (StoreEnv () -> m a) -> m a
withStoreEnv StoreEnvOptions {Bool
seoIsDerivation :: StoreEnvOptions -> Bool
seoIsDerivation :: Bool
seoIsDerivation, Bool
seoIsImpure :: StoreEnvOptions -> Bool
seoIsImpure :: Bool
seoIsImpure, Maybe FilePath
seoStoreURL :: StoreEnvOptions -> Maybe FilePath
seoStoreURL :: Maybe FilePath
seoStoreURL, Maybe FilePath
seoFile :: StoreEnvOptions -> Maybe FilePath
seoFile :: Maybe FilePath
seoFile} NonEmpty Installable
names StoreEnv () -> m a
cb = do
  NixStore
nixStore <- IO NixStore -> m NixStore
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NixStore -> m NixStore) -> IO NixStore -> m NixStore
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> IO NixStore
getStoreDir Maybe FilePath
seoStoreURL

  -- See: https://github.com/utdemir/nix-tree/issues/12
  NixVersion
nixVersion <- IO NixVersion -> m NixVersion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO NixVersion
getNixVersion

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
seoIsDerivation Bool -> Bool -> Bool
&& NixVersion
nixVersion NixVersion -> NixVersion -> Bool
forall a. Ord a => a -> a -> Bool
< NixVersion
Nix2_4) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Warning: --derivation flag is ignored on Nix versions older than 2.4."

  NonEmpty (StorePath StoreName ())
roots <-
    IO (NonEmpty (StorePath StoreName ()))
-> m (NonEmpty (StorePath StoreName ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NonEmpty (StorePath StoreName ()))
 -> m (NonEmpty (StorePath StoreName ())))
-> IO (NonEmpty (StorePath StoreName ()))
-> m (NonEmpty (StorePath StoreName ()))
forall a b. (a -> b) -> a -> b
$
      NixStore
-> NixVersion
-> PathInfoOptions
-> NonEmpty Installable
-> IO (NonEmpty (StorePath StoreName ()))
getPathInfo
        NixStore
nixStore
        NixVersion
nixVersion
        (PathInfoOptions {pioIsDerivation :: Bool
pioIsDerivation = Bool
seoIsDerivation, pioIsRecursive :: Bool
pioIsRecursive = Bool
False, pioIsImpure :: Bool
pioIsImpure = Bool
seoIsImpure, pioStoreURL :: Maybe FilePath
pioStoreURL = Maybe FilePath
seoStoreURL, pioFile :: Maybe FilePath
pioFile = Maybe FilePath
seoFile})
        NonEmpty Installable
names

  NonEmpty (StorePath StoreName ())
paths <-
    IO (NonEmpty (StorePath StoreName ()))
-> m (NonEmpty (StorePath StoreName ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NonEmpty (StorePath StoreName ()))
 -> m (NonEmpty (StorePath StoreName ())))
-> IO (NonEmpty (StorePath StoreName ()))
-> m (NonEmpty (StorePath StoreName ()))
forall a b. (a -> b) -> a -> b
$
      NixStore
-> NixVersion
-> PathInfoOptions
-> NonEmpty Installable
-> IO (NonEmpty (StorePath StoreName ()))
getPathInfo
        NixStore
nixStore
        NixVersion
nixVersion
        (PathInfoOptions {pioIsDerivation :: Bool
pioIsDerivation = Bool
seoIsDerivation, pioIsRecursive :: Bool
pioIsRecursive = Bool
True, pioIsImpure :: Bool
pioIsImpure = Bool
seoIsImpure, pioStoreURL :: Maybe FilePath
pioStoreURL = Maybe FilePath
seoStoreURL, pioFile :: Maybe FilePath
pioFile = Maybe FilePath
seoFile})
        (Text -> Installable
Installable (Text -> Installable)
-> (StorePath StoreName () -> Text)
-> StorePath StoreName ()
-> Installable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (StorePath StoreName () -> FilePath)
-> StorePath StoreName ()
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreName -> FilePath
storeNameToPath (StoreName -> FilePath)
-> (StorePath StoreName () -> StoreName)
-> StorePath StoreName ()
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath StoreName () -> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName (StorePath StoreName () -> Installable)
-> NonEmpty (StorePath StoreName ()) -> NonEmpty Installable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (StorePath StoreName ())
roots)

  let env :: StoreEnv ()
env =
        HashMap StoreName (StorePath StoreName ())
-> NonEmpty StoreName -> StoreEnv ()
forall payload.
HashMap StoreName (StorePath StoreName payload)
-> NonEmpty StoreName -> StoreEnv payload
StoreEnv
          ( NonEmpty (StorePath StoreName ())
paths
              NonEmpty (StorePath StoreName ())
-> (NonEmpty (StorePath StoreName ()) -> [StorePath StoreName ()])
-> [StorePath StoreName ()]
forall a b. a -> (a -> b) -> b
& NonEmpty (StorePath StoreName ()) -> [StorePath StoreName ()]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
              [StorePath StoreName ()]
-> ([StorePath StoreName ()]
    -> [(StoreName, StorePath StoreName ())])
-> [(StoreName, StorePath StoreName ())]
forall a b. a -> (a -> b) -> b
& (StorePath StoreName () -> (StoreName, StorePath StoreName ()))
-> [StorePath StoreName ()]
-> [(StoreName, StorePath StoreName ())]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: StorePath StoreName ()
p@StorePath {StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName
spName} -> (StoreName
spName, StorePath StoreName ()
p))
              [(StoreName, StorePath StoreName ())]
-> ([(StoreName, StorePath StoreName ())]
    -> HashMap StoreName (StorePath StoreName ()))
-> HashMap StoreName (StorePath StoreName ())
forall a b. a -> (a -> b) -> b
& [(StoreName, StorePath StoreName ())]
-> HashMap StoreName (StorePath StoreName ())
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
          )
          (NonEmpty (StorePath StoreName ())
roots NonEmpty (StorePath StoreName ())
-> (StorePath StoreName () -> StoreName) -> NonEmpty StoreName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> StorePath StoreName () -> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName)
  StoreEnv () -> m a
cb StoreEnv ()
env

seLookup :: StoreEnv a -> StoreName -> StorePath StoreName a
seLookup :: forall a. StoreEnv a -> StoreName -> StorePath StoreName a
seLookup StoreEnv {HashMap StoreName (StorePath StoreName a)
sePaths :: forall payload.
StoreEnv payload -> HashMap StoreName (StorePath StoreName payload)
sePaths :: HashMap StoreName (StorePath StoreName a)
sePaths} StoreName
name =
  StorePath StoreName a
-> Maybe (StorePath StoreName a) -> StorePath StoreName a
forall a. a -> Maybe a -> a
fromMaybe
    (Text -> StorePath StoreName a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> StorePath StoreName a) -> Text -> StorePath StoreName a
forall a b. (a -> b) -> a -> b
$ Text
"invariant violation, StoreName not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StoreName -> Text
forall b a. (Show a, IsString b) => a -> b
show StoreName
name)
    (StoreName
-> HashMap StoreName (StorePath StoreName a)
-> Maybe (StorePath StoreName a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup StoreName
name HashMap StoreName (StorePath StoreName a)
sePaths)

seAll :: StoreEnv a -> NonEmpty (StorePath StoreName a)
seAll :: forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seAll StoreEnv {HashMap StoreName (StorePath StoreName a)
sePaths :: forall payload.
StoreEnv payload -> HashMap StoreName (StorePath StoreName payload)
sePaths :: HashMap StoreName (StorePath StoreName a)
sePaths} = case HashMap StoreName (StorePath StoreName a)
-> [StorePath StoreName a]
forall k v. HashMap k v -> [v]
HM.elems HashMap StoreName (StorePath StoreName a)
sePaths of
  [] -> Text -> NonEmpty (StorePath StoreName a)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invariant violation: no paths"
  (StorePath StoreName a
x : [StorePath StoreName a]
xs) -> StorePath StoreName a
x StorePath StoreName a
-> [StorePath StoreName a] -> NonEmpty (StorePath StoreName a)
forall a. a -> [a] -> NonEmpty a
:| [StorePath StoreName a]
xs

seGetRoots :: StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots :: forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots env :: StoreEnv a
env@StoreEnv {NonEmpty StoreName
seRoots :: forall payload. StoreEnv payload -> NonEmpty StoreName
seRoots :: NonEmpty StoreName
seRoots} =
  (StoreName -> StorePath StoreName a)
-> NonEmpty StoreName -> NonEmpty (StorePath StoreName a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StoreEnv a -> StoreName -> StorePath StoreName a
forall a. StoreEnv a -> StoreName -> StorePath StoreName a
seLookup StoreEnv a
env) NonEmpty StoreName
seRoots

seFetchRefs ::
  StoreEnv a ->
  (StoreName -> Bool) ->
  NonEmpty StoreName ->
  [StorePath StoreName a]
seFetchRefs :: forall a.
StoreEnv a
-> (StoreName -> Bool)
-> NonEmpty StoreName
-> [StorePath StoreName a]
seFetchRefs StoreEnv a
env StoreName -> Bool
predicate =
  ([StorePath StoreName a], HashSet StoreName)
-> [StorePath StoreName a]
forall a b. (a, b) -> a
fst
    (([StorePath StoreName a], HashSet StoreName)
 -> [StorePath StoreName a])
-> (NonEmpty StoreName
    -> ([StorePath StoreName a], HashSet StoreName))
-> NonEmpty StoreName
-> [StorePath StoreName a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([StorePath StoreName a], HashSet StoreName)
 -> StoreName -> ([StorePath StoreName a], HashSet StoreName))
-> ([StorePath StoreName a], HashSet StoreName)
-> NonEmpty StoreName
-> ([StorePath StoreName a], HashSet StoreName)
forall b a. (b -> a -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
      (\([StorePath StoreName a]
acc, HashSet StoreName
visited) StoreName
name -> [StorePath StoreName a]
-> HashSet StoreName
-> StoreName
-> ([StorePath StoreName a], HashSet StoreName)
go [StorePath StoreName a]
acc HashSet StoreName
visited StoreName
name)
      ([], HashSet StoreName
forall a. HashSet a
HS.empty)
  where
    go :: [StorePath StoreName a]
-> HashSet StoreName
-> StoreName
-> ([StorePath StoreName a], HashSet StoreName)
go [StorePath StoreName a]
acc HashSet StoreName
visited StoreName
name
      | StoreName -> HashSet StoreName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member StoreName
name HashSet StoreName
visited = ([StorePath StoreName a]
acc, HashSet StoreName
visited)
      | Bool -> Bool
not (StoreName -> Bool
predicate StoreName
name) = ([StorePath StoreName a]
acc, HashSet StoreName
visited)
      | Bool
otherwise =
          let sp :: StorePath StoreName a
sp@StorePath {[StoreName]
spRefs :: forall ref payload. StorePath ref payload -> [ref]
spRefs :: [StoreName]
spRefs} = StoreEnv a -> StoreName -> StorePath StoreName a
forall a. StoreEnv a -> StoreName -> StorePath StoreName a
seLookup StoreEnv a
env StoreName
name
           in (([StorePath StoreName a], HashSet StoreName)
 -> StoreName -> ([StorePath StoreName a], HashSet StoreName))
-> ([StorePath StoreName a], HashSet StoreName)
-> [StoreName]
-> ([StorePath StoreName a], HashSet StoreName)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                (\([StorePath StoreName a]
acc', HashSet StoreName
visited') StoreName
name' -> [StorePath StoreName a]
-> HashSet StoreName
-> StoreName
-> ([StorePath StoreName a], HashSet StoreName)
go [StorePath StoreName a]
acc' HashSet StoreName
visited' StoreName
name')
                (StorePath StoreName a
sp StorePath StoreName a
-> [StorePath StoreName a] -> [StorePath StoreName a]
forall a. a -> [a] -> [a]
: [StorePath StoreName a]
acc, StoreName -> HashSet StoreName -> HashSet StoreName
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert StoreName
name HashSet StoreName
visited)
                [StoreName]
spRefs

seBottomUp ::
  forall a b.
  (StorePath (StorePath StoreName b) a -> b) ->
  StoreEnv a ->
  StoreEnv b
seBottomUp :: forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp StorePath (StorePath StoreName b) a -> b
f StoreEnv {HashMap StoreName (StorePath StoreName a)
sePaths :: forall payload.
StoreEnv payload -> HashMap StoreName (StorePath StoreName payload)
sePaths :: HashMap StoreName (StorePath StoreName a)
sePaths, NonEmpty StoreName
seRoots :: forall payload. StoreEnv payload -> NonEmpty StoreName
seRoots :: NonEmpty StoreName
seRoots} =
  StoreEnv
    { sePaths :: HashMap StoreName (StorePath StoreName b)
sePaths = (HashMap StoreName (StorePath StoreName a),
 HashMap StoreName (StorePath StoreName b))
-> HashMap StoreName (StorePath StoreName b)
forall a b. (a, b) -> b
snd ((HashMap StoreName (StorePath StoreName a),
  HashMap StoreName (StorePath StoreName b))
 -> HashMap StoreName (StorePath StoreName b))
-> (HashMap StoreName (StorePath StoreName a),
    HashMap StoreName (StorePath StoreName b))
-> HashMap StoreName (StorePath StoreName b)
forall a b. (a -> b) -> a -> b
$ State
  (HashMap StoreName (StorePath StoreName a),
   HashMap StoreName (StorePath StoreName b))
  ()
-> (HashMap StoreName (StorePath StoreName a),
    HashMap StoreName (StorePath StoreName b))
-> (HashMap StoreName (StorePath StoreName a),
    HashMap StoreName (StorePath StoreName b))
forall s a. State s a -> s -> s
execState ((StoreName
 -> StateT
      (HashMap StoreName (StorePath StoreName a),
       HashMap StoreName (StorePath StoreName b))
      Identity
      (StorePath StoreName b))
-> NonEmpty StoreName
-> State
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ StoreName
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName b)
go NonEmpty StoreName
seRoots) (HashMap StoreName (StorePath StoreName a)
sePaths, HashMap StoreName (StorePath StoreName b)
forall k v. HashMap k v
HM.empty),
      NonEmpty StoreName
seRoots :: NonEmpty StoreName
seRoots :: NonEmpty StoreName
seRoots
    }
  where
    unsafeLookup :: k -> HashMap k a -> a
unsafeLookup k
k HashMap k a
m =
      a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe
        (Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"invariant violation: name doesn't exists: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> k -> Text
forall b a. (Show a, IsString b) => a -> b
show k
k)
        (k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k HashMap k a
m)
    go ::
      StoreName ->
      State
        ( HashMap StoreName (StorePath StoreName a),
          HashMap StoreName (StorePath StoreName b)
        )
        (StorePath StoreName b)
    go :: StoreName
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName b)
go StoreName
name = do
      HashMap StoreName (StorePath StoreName b)
processed <- ((HashMap StoreName (StorePath StoreName a),
  HashMap StoreName (StorePath StoreName b))
 -> HashMap StoreName (StorePath StoreName b))
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (HashMap StoreName (StorePath StoreName b))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HashMap StoreName (StorePath StoreName a),
 HashMap StoreName (StorePath StoreName b))
-> HashMap StoreName (StorePath StoreName b)
forall a b. (a, b) -> b
snd
      case StoreName
name StoreName
-> HashMap StoreName (StorePath StoreName b)
-> Maybe (StorePath StoreName b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap StoreName (StorePath StoreName b)
processed of
        Just StorePath StoreName b
sp -> StorePath StoreName b
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName b)
forall a.
a
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return StorePath StoreName b
sp
        Maybe (StorePath StoreName b)
Nothing -> do
          sp :: StorePath StoreName a
sp@StorePath {StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName
spName, [StoreName]
spRefs :: forall ref payload. StorePath ref payload -> [ref]
spRefs :: [StoreName]
spRefs} <- StoreName
-> HashMap StoreName (StorePath StoreName a)
-> StorePath StoreName a
forall {k} {a}. (Show k, Hashable k) => k -> HashMap k a -> a
unsafeLookup StoreName
name (HashMap StoreName (StorePath StoreName a)
 -> StorePath StoreName a)
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (HashMap StoreName (StorePath StoreName a))
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HashMap StoreName (StorePath StoreName a),
  HashMap StoreName (StorePath StoreName b))
 -> HashMap StoreName (StorePath StoreName a))
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (HashMap StoreName (StorePath StoreName a))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (HashMap StoreName (StorePath StoreName a),
 HashMap StoreName (StorePath StoreName b))
-> HashMap StoreName (StorePath StoreName a)
forall a b. (a, b) -> a
fst
          [StorePath StoreName b]
refs <- (StoreName
 -> StateT
      (HashMap StoreName (StorePath StoreName a),
       HashMap StoreName (StorePath StoreName b))
      Identity
      (StorePath StoreName b))
-> [StoreName]
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     [StorePath StoreName b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM StoreName
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName b)
go [StoreName]
spRefs
          let new :: StorePath StoreName b
new = StorePath StoreName a
sp {spPayload = f sp {spRefs = refs}}
          ((HashMap StoreName (StorePath StoreName a),
  HashMap StoreName (StorePath StoreName b))
 -> (HashMap StoreName (StorePath StoreName a),
     HashMap StoreName (StorePath StoreName b)))
-> State
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((HashMap StoreName (StorePath StoreName a),
   HashMap StoreName (StorePath StoreName b))
  -> (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b)))
 -> State
      (HashMap StoreName (StorePath StoreName a),
       HashMap StoreName (StorePath StoreName b))
      ())
-> ((HashMap StoreName (StorePath StoreName a),
     HashMap StoreName (StorePath StoreName b))
    -> (HashMap StoreName (StorePath StoreName a),
        HashMap StoreName (StorePath StoreName b)))
-> State
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     ()
forall a b. (a -> b) -> a -> b
$ (HashMap StoreName (StorePath StoreName a)
 -> HashMap StoreName (StorePath StoreName a))
-> (HashMap StoreName (StorePath StoreName b)
    -> HashMap StoreName (StorePath StoreName b))
-> (HashMap StoreName (StorePath StoreName a),
    HashMap StoreName (StorePath StoreName b))
-> (HashMap StoreName (StorePath StoreName a),
    HashMap StoreName (StorePath StoreName b))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (StoreName
-> HashMap StoreName (StorePath StoreName a)
-> HashMap StoreName (StorePath StoreName a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete StoreName
spName) (StoreName
-> StorePath StoreName b
-> HashMap StoreName (StorePath StoreName b)
-> HashMap StoreName (StorePath StoreName b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert StoreName
spName StorePath StoreName b
new)
          StorePath StoreName b
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     (StorePath StoreName b)
forall a.
a
-> StateT
     (HashMap StoreName (StorePath StoreName a),
      HashMap StoreName (StorePath StoreName b))
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return StorePath StoreName b
new

--------------------------------------------------------------------------------

storeEnvToDot :: StoreEnv a -> Text
storeEnvToDot :: forall a. StoreEnv a -> Text
storeEnvToDot StoreEnv a
env =
  (StorePath (StorePath StoreName (Set (StoreName, StoreName))) a
 -> Set (StoreName, StoreName))
-> StoreEnv a -> StoreEnv (Set (StoreName, StoreName))
forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp StorePath (StorePath StoreName (Set (StoreName, StoreName))) a
-> Set (StoreName, StoreName)
forall {ref} {payload}.
StorePath (StorePath ref (Set (StoreName, StoreName))) payload
-> Set (StoreName, StoreName)
go StoreEnv a
env
    StoreEnv (Set (StoreName, StoreName))
-> (StoreEnv (Set (StoreName, StoreName))
    -> NonEmpty (StorePath StoreName (Set (StoreName, StoreName))))
-> NonEmpty (StorePath StoreName (Set (StoreName, StoreName)))
forall a b. a -> (a -> b) -> b
& StoreEnv (Set (StoreName, StoreName))
-> NonEmpty (StorePath StoreName (Set (StoreName, StoreName)))
forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots
    NonEmpty (StorePath StoreName (Set (StoreName, StoreName)))
-> (NonEmpty (StorePath StoreName (Set (StoreName, StoreName)))
    -> [StorePath StoreName (Set (StoreName, StoreName))])
-> [StorePath StoreName (Set (StoreName, StoreName))]
forall a b. a -> (a -> b) -> b
& NonEmpty (StorePath StoreName (Set (StoreName, StoreName)))
-> [StorePath StoreName (Set (StoreName, StoreName))]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    [StorePath StoreName (Set (StoreName, StoreName))]
-> ([StorePath StoreName (Set (StoreName, StoreName))]
    -> [Set (StoreName, StoreName)])
-> [Set (StoreName, StoreName)]
forall a b. a -> (a -> b) -> b
& (StorePath StoreName (Set (StoreName, StoreName))
 -> Set (StoreName, StoreName))
-> [StorePath StoreName (Set (StoreName, StoreName))]
-> [Set (StoreName, StoreName)]
forall a b. (a -> b) -> [a] -> [b]
map StorePath StoreName (Set (StoreName, StoreName))
-> Set (StoreName, StoreName)
forall ref payload. StorePath ref payload -> payload
spPayload
    [Set (StoreName, StoreName)]
-> ([Set (StoreName, StoreName)] -> Set (StoreName, StoreName))
-> Set (StoreName, StoreName)
forall a b. a -> (a -> b) -> b
& [Set (StoreName, StoreName)] -> Set (StoreName, StoreName)
forall a. Monoid a => [a] -> a
mconcat
    Set (StoreName, StoreName)
-> (Set (StoreName, StoreName) -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Set (StoreName, StoreName) -> Text
render
  where
    go :: StorePath (StorePath ref (Set (StoreName, StoreName))) payload
-> Set (StoreName, StoreName)
go StorePath (StorePath ref (Set (StoreName, StoreName))) payload
sp =
      [Item [Set (StoreName, StoreName)]] -> [Set (StoreName, StoreName)]
forall l. IsList l => [Item l] -> l
fromList [(StoreName, StoreName) -> Set (StoreName, StoreName)
forall a. a -> Set a
Set.singleton (StorePath (StorePath ref (Set (StoreName, StoreName))) payload
-> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName StorePath (StorePath ref (Set (StoreName, StoreName))) payload
sp, StorePath ref (Set (StoreName, StoreName)) -> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName StorePath ref (Set (StoreName, StoreName))
ref) Set (StoreName, StoreName)
-> Set (StoreName, StoreName) -> Set (StoreName, StoreName)
forall a. Semigroup a => a -> a -> a
<> StorePath ref (Set (StoreName, StoreName))
-> Set (StoreName, StoreName)
forall ref payload. StorePath ref payload -> payload
spPayload StorePath ref (Set (StoreName, StoreName))
ref | StorePath ref (Set (StoreName, StoreName))
ref <- StorePath (StorePath ref (Set (StoreName, StoreName))) payload
-> [StorePath ref (Set (StoreName, StoreName))]
forall ref payload. StorePath ref payload -> [ref]
spRefs StorePath (StorePath ref (Set (StoreName, StoreName))) payload
sp]
        [Set (StoreName, StoreName)]
-> ([Set (StoreName, StoreName)] -> Set (StoreName, StoreName))
-> Set (StoreName, StoreName)
forall a b. a -> (a -> b) -> b
& [Set (StoreName, StoreName)] -> Set (StoreName, StoreName)
forall a. Monoid a => [a] -> a
mconcat

    render :: Set (StoreName, StoreName) -> Text
    render :: Set (StoreName, StoreName) -> Text
render Set (StoreName, StoreName)
edges =
      Strictness -> Directionality -> Maybe Id -> [Statement] -> DotGraph
Dot.DotGraph
        Strictness
Dot.Strict
        Directionality
Dot.Directed
        Maybe Id
forall a. Maybe a
Nothing
        [ EdgeStatement -> Statement
Dot.StatementEdge
            ( ListTwo EdgeElement -> [Attribute] -> EdgeStatement
Dot.EdgeStatement
                (EdgeElement -> EdgeElement -> [EdgeElement] -> ListTwo EdgeElement
forall a. a -> a -> [a] -> ListTwo a
Dot.ListTwo (NodeId -> EdgeElement
Dot.EdgeNode (StoreName -> NodeId
mkNodeId StoreName
from)) (NodeId -> EdgeElement
Dot.EdgeNode (StoreName -> NodeId
mkNodeId StoreName
to)) [])
                []
            )
          | (StoreName
from, StoreName
to) <- Set (StoreName, StoreName) -> [(StoreName, StoreName)]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (StoreName, StoreName)
edges
        ]
        DotGraph -> (DotGraph -> Text) -> Text
forall a b. a -> (a -> b) -> b
& DotGraph -> Text
Dot.encode

    mkNodeId :: StoreName -> Dot.NodeId
    mkNodeId :: StoreName -> NodeId
mkNodeId = FilePath -> NodeId
forall a. IsString a => FilePath -> a
fromString (FilePath -> NodeId)
-> (StoreName -> FilePath) -> StoreName -> NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> (StoreName -> Text) -> StoreName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreName -> Text
storeNameToShortText

--------------------------------------------------------------------------------

data NixPathInfo = NixPathInfo
  { NixPathInfo -> FilePath
npiPath :: FilePath,
    NixPathInfo -> Int
npiNarSize :: Int,
    NixPathInfo -> [FilePath]
npiReferences :: [FilePath],
    NixPathInfo -> [NixPathSignature]
npiSignatures :: [NixPathSignature]
  }

data NixPathSignature = NixPathSignature
  { NixPathSignature -> Text
npsKeyName :: Text,
    NixPathSignature -> Text
npsSignature :: Text
  }
  deriving (Int -> NixPathSignature -> ShowS
[NixPathSignature] -> ShowS
NixPathSignature -> FilePath
(Int -> NixPathSignature -> ShowS)
-> (NixPathSignature -> FilePath)
-> ([NixPathSignature] -> ShowS)
-> Show NixPathSignature
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixPathSignature -> ShowS
showsPrec :: Int -> NixPathSignature -> ShowS
$cshow :: NixPathSignature -> FilePath
show :: NixPathSignature -> FilePath
$cshowList :: [NixPathSignature] -> ShowS
showList :: [NixPathSignature] -> ShowS
Show, NixPathSignature -> NixPathSignature -> Bool
(NixPathSignature -> NixPathSignature -> Bool)
-> (NixPathSignature -> NixPathSignature -> Bool)
-> Eq NixPathSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixPathSignature -> NixPathSignature -> Bool
== :: NixPathSignature -> NixPathSignature -> Bool
$c/= :: NixPathSignature -> NixPathSignature -> Bool
/= :: NixPathSignature -> NixPathSignature -> Bool
Eq, Eq NixPathSignature
Eq NixPathSignature =>
(NixPathSignature -> NixPathSignature -> Ordering)
-> (NixPathSignature -> NixPathSignature -> Bool)
-> (NixPathSignature -> NixPathSignature -> Bool)
-> (NixPathSignature -> NixPathSignature -> Bool)
-> (NixPathSignature -> NixPathSignature -> Bool)
-> (NixPathSignature -> NixPathSignature -> NixPathSignature)
-> (NixPathSignature -> NixPathSignature -> NixPathSignature)
-> Ord NixPathSignature
NixPathSignature -> NixPathSignature -> Bool
NixPathSignature -> NixPathSignature -> Ordering
NixPathSignature -> NixPathSignature -> NixPathSignature
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NixPathSignature -> NixPathSignature -> Ordering
compare :: NixPathSignature -> NixPathSignature -> Ordering
$c< :: NixPathSignature -> NixPathSignature -> Bool
< :: NixPathSignature -> NixPathSignature -> Bool
$c<= :: NixPathSignature -> NixPathSignature -> Bool
<= :: NixPathSignature -> NixPathSignature -> Bool
$c> :: NixPathSignature -> NixPathSignature -> Bool
> :: NixPathSignature -> NixPathSignature -> Bool
$c>= :: NixPathSignature -> NixPathSignature -> Bool
>= :: NixPathSignature -> NixPathSignature -> Bool
$cmax :: NixPathSignature -> NixPathSignature -> NixPathSignature
max :: NixPathSignature -> NixPathSignature -> NixPathSignature
$cmin :: NixPathSignature -> NixPathSignature -> NixPathSignature
min :: NixPathSignature -> NixPathSignature -> NixPathSignature
Ord, NixPathSignature -> ()
(NixPathSignature -> ()) -> NFData NixPathSignature
forall a. (a -> ()) -> NFData a
$crnf :: NixPathSignature -> ()
rnf :: NixPathSignature -> ()
NFData, (forall x. NixPathSignature -> Rep NixPathSignature x)
-> (forall x. Rep NixPathSignature x -> NixPathSignature)
-> Generic NixPathSignature
forall x. Rep NixPathSignature x -> NixPathSignature
forall x. NixPathSignature -> Rep NixPathSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NixPathSignature -> Rep NixPathSignature x
from :: forall x. NixPathSignature -> Rep NixPathSignature x
$cto :: forall x. Rep NixPathSignature x -> NixPathSignature
to :: forall x. Rep NixPathSignature x -> NixPathSignature
Generic)

instance FromJSON NixPathSignature where
  parseJSON :: Value -> Parser NixPathSignature
parseJSON (String Text
t) =
    case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" Text
t of
      [Text
key, Text
sig]
        | Bool -> Bool
not (Text -> Bool
T.null Text
key) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
sig) ->
            NixPathSignature -> Parser NixPathSignature
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (NixPathSignature -> Parser NixPathSignature)
-> NixPathSignature -> Parser NixPathSignature
forall a b. (a -> b) -> a -> b
$ Text -> Text -> NixPathSignature
NixPathSignature Text
key Text
sig
      [Text]
_ -> FilePath -> Parser NixPathSignature
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expecting a string in the form of 'key:sig'."
  parseJSON Value
_ = FilePath -> Parser NixPathSignature
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expecting a string."

data NixPathInfoResult
  = NixPathInfoValid NixPathInfo
  | NixPathInfoInvalid FilePath

parse2_18 :: Value -> Parser NixPathInfoResult
parse2_18 :: Value -> Parser NixPathInfoResult
parse2_18 (Object Object
obj) =
  ( NixPathInfo -> NixPathInfoResult
NixPathInfoValid
      (NixPathInfo -> NixPathInfoResult)
-> Parser NixPathInfo -> Parser NixPathInfoResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( FilePath -> Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo
NixPathInfo
              (FilePath
 -> Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo)
-> Parser FilePath
-> Parser (Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
              Parser (Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo)
-> Parser Int
-> Parser ([FilePath] -> [NixPathSignature] -> NixPathInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"narSize"
              Parser ([FilePath] -> [NixPathSignature] -> NixPathInfo)
-> Parser [FilePath] -> Parser ([NixPathSignature] -> NixPathInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser [FilePath]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"references"
              Parser ([NixPathSignature] -> NixPathInfo)
-> Parser [NixPathSignature] -> Parser NixPathInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe [NixPathSignature])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signatures" Parser (Maybe [NixPathSignature])
-> [NixPathSignature] -> Parser [NixPathSignature]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
          )
  )
    Parser NixPathInfoResult
-> Parser NixPathInfoResult -> Parser NixPathInfoResult
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
            FilePath
path <- Object
obj Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
            Bool
valid <- Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"valid"
            Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
valid)
            NixPathInfoResult -> Parser NixPathInfoResult
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (NixPathInfoResult -> Parser NixPathInfoResult)
-> NixPathInfoResult -> Parser NixPathInfoResult
forall a b. (a -> b) -> a -> b
$ FilePath -> NixPathInfoResult
NixPathInfoInvalid FilePath
path
        )
parse2_18 Value
_ = FilePath -> Parser NixPathInfoResult
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expecting an object."

parse2_19 :: (FilePath, Value) -> Parser NixPathInfoResult
parse2_19 :: (FilePath, Value) -> Parser NixPathInfoResult
parse2_19 (FilePath
path, Object Object
obj) =
  NixPathInfo -> NixPathInfoResult
NixPathInfoValid
    (NixPathInfo -> NixPathInfoResult)
-> Parser NixPathInfo -> Parser NixPathInfoResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( FilePath -> Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo
NixPathInfo
            FilePath
path
            (Int -> [FilePath] -> [NixPathSignature] -> NixPathInfo)
-> Parser Int
-> Parser ([FilePath] -> [NixPathSignature] -> NixPathInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"narSize"
            Parser ([FilePath] -> [NixPathSignature] -> NixPathInfo)
-> Parser [FilePath] -> Parser ([NixPathSignature] -> NixPathInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser [FilePath]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"references"
            Parser ([NixPathSignature] -> NixPathInfo)
-> Parser [NixPathSignature] -> Parser NixPathInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe [NixPathSignature])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signatures" Parser (Maybe [NixPathSignature])
-> [NixPathSignature] -> Parser [NixPathSignature]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
        )
parse2_19 (FilePath
path, Value
Null) = NixPathInfoResult -> Parser NixPathInfoResult
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (NixPathInfoResult -> Parser NixPathInfoResult)
-> NixPathInfoResult -> Parser NixPathInfoResult
forall a b. (a -> b) -> a -> b
$ FilePath -> NixPathInfoResult
NixPathInfoInvalid FilePath
path
parse2_19 (FilePath
_, Value
_) = FilePath -> Parser NixPathInfoResult
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expecting an object or null"

newtype NixPathOutput = NixPathOutput
  { NixPathOutput -> [NixPathInfoResult]
npoResults :: [NixPathInfoResult]
  }

instance FromJSON NixPathOutput where
  parseJSON :: Value -> Parser NixPathOutput
parseJSON (Array Array
a) = [NixPathInfoResult] -> NixPathOutput
NixPathOutput ([NixPathInfoResult] -> NixPathOutput)
-> Parser [NixPathInfoResult] -> Parser NixPathOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser NixPathInfoResult)
-> [Value] -> Parser [NixPathInfoResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser NixPathInfoResult
parse2_18 (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
a)
  parseJSON (Object Object
o) = [NixPathInfoResult] -> NixPathOutput
NixPathOutput ([NixPathInfoResult] -> NixPathOutput)
-> Parser [NixPathInfoResult] -> Parser NixPathOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Key, Value) -> Parser NixPathInfoResult)
-> [(Key, Value)] -> Parser [NixPathInfoResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FilePath, Value) -> Parser NixPathInfoResult
parse2_19 ((FilePath, Value) -> Parser NixPathInfoResult)
-> ((Key, Value) -> (FilePath, Value))
-> (Key, Value)
-> Parser NixPathInfoResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> FilePath) -> (Key, Value) -> (FilePath, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> FilePath
K.toString) (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o)
  parseJSON Value
_ = FilePath -> Parser NixPathOutput
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Expecting an array (nix<=2.18) or an object with mapping from path to info (nix>=2.19)."