module NixTree.PathStats
  ( PathStats (..),
    calculatePathStats,
    whyDepends,
    shortestPathTo,
    module NixTree.StorePath,
  )
where

import Data.List (minimumBy)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import NixTree.StorePath

data IntermediatePathStats = IntermediatePathStats
  { IntermediatePathStats -> Map StoreName (StorePath StoreName ())
ipsAllRefs :: M.Map StoreName (StorePath StoreName ())
  }

data PathStats = PathStats
  { PathStats -> Int
psTotalSize :: !Int,
    PathStats -> Int
psAddedSize :: !Int,
    PathStats -> [StoreName]
psImmediateParents :: [StoreName],
    PathStats -> Int
psDisambiguationChars :: !Int
  }
  deriving (Int -> PathStats -> ShowS
[PathStats] -> ShowS
PathStats -> String
(Int -> PathStats -> ShowS)
-> (PathStats -> String)
-> ([PathStats] -> ShowS)
-> Show PathStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathStats -> ShowS
showsPrec :: Int -> PathStats -> ShowS
$cshow :: PathStats -> String
show :: PathStats -> String
$cshowList :: [PathStats] -> ShowS
showList :: [PathStats] -> ShowS
Show, (forall x. PathStats -> Rep PathStats x)
-> (forall x. Rep PathStats x -> PathStats) -> Generic PathStats
forall x. Rep PathStats x -> PathStats
forall x. PathStats -> Rep PathStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathStats -> Rep PathStats x
from :: forall x. PathStats -> Rep PathStats x
$cto :: forall x. Rep PathStats x -> PathStats
to :: forall x. Rep PathStats x -> PathStats
Generic, PathStats -> ()
(PathStats -> ()) -> NFData PathStats
forall a. (a -> ()) -> NFData a
$crnf :: PathStats -> ()
rnf :: PathStats -> ()
NFData)

mkIntermediateEnv ::
  (StoreName -> Bool) ->
  StoreEnv () ->
  StoreEnv IntermediatePathStats
mkIntermediateEnv :: (StoreName -> Bool)
-> StoreEnv () -> StoreEnv IntermediatePathStats
mkIntermediateEnv StoreName -> Bool
env =
  (StorePath (StorePath StoreName IntermediatePathStats) ()
 -> IntermediatePathStats)
-> StoreEnv () -> StoreEnv IntermediatePathStats
forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp ((StorePath (StorePath StoreName IntermediatePathStats) ()
  -> IntermediatePathStats)
 -> StoreEnv () -> StoreEnv IntermediatePathStats)
-> (StorePath (StorePath StoreName IntermediatePathStats) ()
    -> IntermediatePathStats)
-> StoreEnv ()
-> StoreEnv IntermediatePathStats
forall a b. (a -> b) -> a -> b
$ \StorePath (StorePath StoreName IntermediatePathStats) ()
curr ->
    IntermediatePathStats
      { ipsAllRefs :: Map StoreName (StorePath StoreName ())
ipsAllRefs =
          [Map StoreName (StorePath StoreName ())]
-> Map StoreName (StorePath StoreName ())
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
            ( [(StoreName, StorePath StoreName ())]
-> Map StoreName (StorePath StoreName ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                [ (StoreName
spName, StorePath StoreName IntermediatePathStats -> StorePath StoreName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StorePath StoreName IntermediatePathStats
sp)
                  | sp :: StorePath StoreName IntermediatePathStats
sp@StorePath {StoreName
spName :: StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName} <- StorePath (StorePath StoreName IntermediatePathStats) ()
-> [StorePath StoreName IntermediatePathStats]
forall ref payload. StorePath ref payload -> [ref]
spRefs StorePath (StorePath StoreName IntermediatePathStats) ()
curr,
                    StoreName -> Bool
env StoreName
spName
                ]
                Map StoreName (StorePath StoreName ())
-> [Map StoreName (StorePath StoreName ())]
-> [Map StoreName (StorePath StoreName ())]
forall a. a -> [a] -> [a]
: (StorePath StoreName IntermediatePathStats
 -> Map StoreName (StorePath StoreName ()))
-> [StorePath StoreName IntermediatePathStats]
-> [Map StoreName (StorePath StoreName ())]
forall a b. (a -> b) -> [a] -> [b]
map (IntermediatePathStats -> Map StoreName (StorePath StoreName ())
ipsAllRefs (IntermediatePathStats -> Map StoreName (StorePath StoreName ()))
-> (StorePath StoreName IntermediatePathStats
    -> IntermediatePathStats)
-> StorePath StoreName IntermediatePathStats
-> Map StoreName (StorePath StoreName ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath StoreName IntermediatePathStats -> IntermediatePathStats
forall ref payload. StorePath ref payload -> payload
spPayload) (StorePath (StorePath StoreName IntermediatePathStats) ()
-> [StorePath StoreName IntermediatePathStats]
forall ref payload. StorePath ref payload -> [ref]
spRefs StorePath (StorePath StoreName IntermediatePathStats) ()
curr)
            )
      }

mkFinalEnv :: StoreEnv IntermediatePathStats -> StoreEnv PathStats
mkFinalEnv :: StoreEnv IntermediatePathStats -> StoreEnv PathStats
mkFinalEnv StoreEnv IntermediatePathStats
env =
  let totalSize :: Int
totalSize = StoreEnv IntermediatePathStats -> Int
calculateEnvSize StoreEnv IntermediatePathStats
env
      immediateParents :: Map StoreName (Set StoreName)
immediateParents = HashMap StoreName (StorePath StoreName IntermediatePathStats)
-> Map StoreName (Set StoreName)
forall (f :: * -> *) b.
Foldable f =>
f (StorePath StoreName b) -> Map StoreName (Set StoreName)
calculateImmediateParents (StoreEnv IntermediatePathStats
-> HashMap StoreName (StorePath StoreName IntermediatePathStats)
forall payload.
StoreEnv payload -> HashMap StoreName (StorePath StoreName payload)
sePaths StoreEnv IntermediatePathStats
env)
      disambiguationChars :: Map StoreName Int
disambiguationChars = StoreEnv IntermediatePathStats -> Map StoreName Int
forall a. StoreEnv a -> Map StoreName Int
seDisambiguationChars StoreEnv IntermediatePathStats
env
   in ((StorePath (StorePath StoreName PathStats) IntermediatePathStats
  -> PathStats)
 -> StoreEnv IntermediatePathStats -> StoreEnv PathStats)
-> StoreEnv IntermediatePathStats
-> (StorePath (StorePath StoreName PathStats) IntermediatePathStats
    -> PathStats)
-> StoreEnv PathStats
forall a b c. (a -> b -> c) -> b -> a -> c
flip (StorePath (StorePath StoreName PathStats) IntermediatePathStats
 -> PathStats)
-> StoreEnv IntermediatePathStats -> StoreEnv PathStats
forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp StoreEnv IntermediatePathStats
env ((StorePath (StorePath StoreName PathStats) IntermediatePathStats
  -> PathStats)
 -> StoreEnv PathStats)
-> (StorePath (StorePath StoreName PathStats) IntermediatePathStats
    -> PathStats)
-> StoreEnv PathStats
forall a b. (a -> b) -> a -> b
$ \StorePath {StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName
spName, Int
spSize :: Int
spSize :: forall ref payload. StorePath ref payload -> Int
spSize, IntermediatePathStats
spPayload :: forall ref payload. StorePath ref payload -> payload
spPayload :: IntermediatePathStats
spPayload} ->
        let filteredSize :: Int
filteredSize =
              StoreEnv IntermediatePathStats
-> (StoreName -> Bool)
-> NonEmpty StoreName
-> [StorePath StoreName IntermediatePathStats]
forall a.
StoreEnv a
-> (StoreName -> Bool)
-> NonEmpty StoreName
-> [StorePath StoreName a]
seFetchRefs StoreEnv IntermediatePathStats
env (StoreName -> StoreName -> Bool
forall a. Eq a => a -> a -> Bool
/= StoreName
spName) (StoreEnv IntermediatePathStats -> NonEmpty StoreName
forall payload. StoreEnv payload -> NonEmpty StoreName
seRoots StoreEnv IntermediatePathStats
env)
                [StorePath StoreName IntermediatePathStats]
-> ([StorePath StoreName IntermediatePathStats] -> Int) -> Int
forall a b. a -> (a -> b) -> b
& [StorePath StoreName IntermediatePathStats] -> Int
forall (f :: * -> *) a b.
(Functor f, Foldable f) =>
f (StorePath a b) -> Int
calculateRefsSize
            addedSize :: Int
addedSize = Int
totalSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
filteredSize
         in PathStats
              { psTotalSize :: Int
psTotalSize =
                  Int
spSize
                    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Map StoreName (StorePath StoreName ()) -> Int
forall (f :: * -> *) a b.
(Functor f, Foldable f) =>
f (StorePath a b) -> Int
calculateRefsSize (IntermediatePathStats -> Map StoreName (StorePath StoreName ())
ipsAllRefs IntermediatePathStats
spPayload),
                psAddedSize :: Int
psAddedSize = Int
addedSize,
                psImmediateParents :: [StoreName]
psImmediateParents =
                  [StoreName]
-> (Set StoreName -> [StoreName])
-> Maybe (Set StoreName)
-> [StoreName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set StoreName -> [StoreName]
forall a. Set a -> [a]
S.toList (Maybe (Set StoreName) -> [StoreName])
-> Maybe (Set StoreName) -> [StoreName]
forall a b. (a -> b) -> a -> b
$ StoreName -> Map StoreName (Set StoreName) -> Maybe (Set StoreName)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup StoreName
spName Map StoreName (Set StoreName)
immediateParents,
                psDisambiguationChars :: Int
psDisambiguationChars =
                  StoreName -> Map StoreName Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup StoreName
spName Map StoreName Int
disambiguationChars
                    Maybe Int -> (Maybe Int -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
id
              }
  where
    calculateEnvSize :: StoreEnv IntermediatePathStats -> Int
    calculateEnvSize :: StoreEnv IntermediatePathStats -> Int
calculateEnvSize StoreEnv IntermediatePathStats
e =
      StoreEnv IntermediatePathStats
-> NonEmpty (StorePath StoreName IntermediatePathStats)
forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots StoreEnv IntermediatePathStats
e
        NonEmpty (StorePath StoreName IntermediatePathStats)
-> (NonEmpty (StorePath StoreName IntermediatePathStats)
    -> [StorePath StoreName IntermediatePathStats])
-> [StorePath StoreName IntermediatePathStats]
forall a b. a -> (a -> b) -> b
& NonEmpty (StorePath StoreName IntermediatePathStats)
-> [StorePath StoreName IntermediatePathStats]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
        [StorePath StoreName IntermediatePathStats]
-> ([StorePath StoreName IntermediatePathStats]
    -> [Map StoreName (StorePath StoreName ())])
-> [Map StoreName (StorePath StoreName ())]
forall a b. a -> (a -> b) -> b
& (StorePath StoreName IntermediatePathStats
 -> Map StoreName (StorePath StoreName ()))
-> [StorePath StoreName IntermediatePathStats]
-> [Map StoreName (StorePath StoreName ())]
forall a b. (a -> b) -> [a] -> [b]
map
          ( \sp :: StorePath StoreName IntermediatePathStats
sp@StorePath {StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName
spName, IntermediatePathStats
spPayload :: forall ref payload. StorePath ref payload -> payload
spPayload :: IntermediatePathStats
spPayload} ->
              StoreName
-> StorePath StoreName ()
-> Map StoreName (StorePath StoreName ())
-> Map StoreName (StorePath StoreName ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
                StoreName
spName
                (StorePath StoreName IntermediatePathStats -> StorePath StoreName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StorePath StoreName IntermediatePathStats
sp)
                (IntermediatePathStats -> Map StoreName (StorePath StoreName ())
ipsAllRefs IntermediatePathStats
spPayload)
          )
        [Map StoreName (StorePath StoreName ())]
-> ([Map StoreName (StorePath StoreName ())]
    -> Map StoreName (StorePath StoreName ()))
-> Map StoreName (StorePath StoreName ())
forall a b. a -> (a -> b) -> b
& [Map StoreName (StorePath StoreName ())]
-> Map StoreName (StorePath StoreName ())
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
        Map StoreName (StorePath StoreName ())
-> (Map StoreName (StorePath StoreName ()) -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Map StoreName (StorePath StoreName ()) -> Int
forall (f :: * -> *) a b.
(Functor f, Foldable f) =>
f (StorePath a b) -> Int
calculateRefsSize
    calculateRefsSize :: (Functor f, Foldable f) => f (StorePath a b) -> Int
    calculateRefsSize :: forall (f :: * -> *) a b.
(Functor f, Foldable f) =>
f (StorePath a b) -> Int
calculateRefsSize = f Int -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum (f Int -> Int)
-> (f (StorePath a b) -> f Int) -> f (StorePath a b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StorePath a b -> Int) -> f (StorePath a b) -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorePath a b -> Int
forall ref payload. StorePath ref payload -> Int
spSize
    calculateImmediateParents ::
      (Foldable f) =>
      f (StorePath StoreName b) ->
      M.Map StoreName (S.Set StoreName)
    calculateImmediateParents :: forall (f :: * -> *) b.
Foldable f =>
f (StorePath StoreName b) -> Map StoreName (Set StoreName)
calculateImmediateParents =
      (Map StoreName (Set StoreName)
 -> StorePath StoreName b -> Map StoreName (Set StoreName))
-> Map StoreName (Set StoreName)
-> f (StorePath StoreName b)
-> Map StoreName (Set StoreName)
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        ( \Map StoreName (Set StoreName)
m 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} ->
            (Set StoreName -> Set StoreName -> Set StoreName)
-> Map StoreName (Set StoreName)
-> Map StoreName (Set StoreName)
-> Map StoreName (Set StoreName)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith
              Set StoreName -> Set StoreName -> Set StoreName
forall a. Semigroup a => a -> a -> a
(<>)
              Map StoreName (Set StoreName)
m
              ([(StoreName, Set StoreName)] -> Map StoreName (Set StoreName)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((StoreName -> (StoreName, Set StoreName))
-> [StoreName] -> [(StoreName, Set StoreName)]
forall a b. (a -> b) -> [a] -> [b]
map (,StoreName -> Set StoreName
forall a. a -> Set a
S.singleton StoreName
spName) [StoreName]
spRefs))
        )
        Map StoreName (Set StoreName)
forall k a. Map k a
M.empty

    seShortNames :: StoreEnv a -> M.Map Text [StoreName]
    seShortNames :: forall a. StoreEnv a -> Map Text [StoreName]
seShortNames StoreEnv a
env =
      let paths :: [StorePath StoreName a]
paths = StoreEnv a -> NonEmpty (StorePath StoreName a)
forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seAll StoreEnv a
env NonEmpty (StorePath StoreName a)
-> (NonEmpty (StorePath StoreName a) -> [StorePath StoreName a])
-> [StorePath StoreName a]
forall a b. a -> (a -> b) -> b
& NonEmpty (StorePath StoreName a) -> [StorePath StoreName a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
       in (Map Text [StoreName]
 -> StorePath StoreName a -> Map Text [StoreName])
-> Map Text [StoreName]
-> [StorePath StoreName a]
-> Map Text [StoreName]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            ( \Map Text [StoreName]
m StorePath {StoreName
spName :: forall ref payload. StorePath ref payload -> StoreName
spName :: StoreName
spName} ->
                let (Text
_, Text
shortName) = StoreName -> (Text, Text)
storeNameToSplitShortText StoreName
spName
                 in (Maybe [StoreName] -> Maybe [StoreName])
-> Text -> Map Text [StoreName] -> Map Text [StoreName]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter
                      ( \case
                          Maybe [StoreName]
Nothing -> [StoreName] -> Maybe [StoreName]
forall a. a -> Maybe a
Just [StoreName
spName]
                          Just [StoreName]
xs -> [StoreName] -> Maybe [StoreName]
forall a. a -> Maybe a
Just (StoreName
spName StoreName -> [StoreName] -> [StoreName]
forall a. a -> [a] -> [a]
: [StoreName]
xs)
                      )
                      Text
shortName
                      Map Text [StoreName]
m
            )
            Map Text [StoreName]
forall k a. Map k a
M.empty
            [StorePath StoreName a]
paths

    seDisambiguationChars :: StoreEnv a -> M.Map StoreName Int
    seDisambiguationChars :: forall a. StoreEnv a -> Map StoreName Int
seDisambiguationChars StoreEnv a
env =
      Map Text [StoreName] -> [(Text, [StoreName])]
forall k a. Map k a -> [(k, a)]
M.toList (StoreEnv a -> Map Text [StoreName]
forall a. StoreEnv a -> Map Text [StoreName]
seShortNames StoreEnv a
env)
        [(Text, [StoreName])]
-> ([(Text, [StoreName])] -> [[StoreName]]) -> [[StoreName]]
forall a b. a -> (a -> b) -> b
& ((Text, [StoreName]) -> [StoreName])
-> [(Text, [StoreName])] -> [[StoreName]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [StoreName]) -> [StoreName]
forall a b. (a, b) -> b
snd
        [[StoreName]]
-> ([[StoreName]] -> [(StoreName, Int)]) -> [(StoreName, Int)]
forall a b. a -> (a -> b) -> b
& ([StoreName] -> [(StoreName, Int)])
-> [[StoreName]] -> [(StoreName, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          ( \[StoreName]
xs ->
              let chrs :: Int
chrs = [StoreName] -> Int
disambiguate [StoreName]
xs
               in (StoreName -> (StoreName, Int))
-> [StoreName] -> [(StoreName, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\StoreName
x -> (StoreName
x, Int
chrs)) [StoreName]
xs
          )
        [(StoreName, Int)]
-> ([(StoreName, Int)] -> Map StoreName Int) -> Map StoreName Int
forall a b. a -> (a -> b) -> b
& [(StoreName, Int)] -> Map StoreName Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

    disambiguate :: [StoreName] -> Int
    disambiguate :: [StoreName] -> Int
disambiguate [StoreName]
xs = Int -> Int
go Int
0
      where
        go :: Int -> Int
go Int
n =
          if Int -> Bool
isGood Int
n
            then Int
n
            else Int -> Int
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

        isGood :: Int -> Bool
isGood Int
n =
          [StoreName]
xs
            [StoreName] -> ([StoreName] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (StoreName -> Text) -> [StoreName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> StoreName -> Text
storeNameToShortTextWithDisambiguation Int
n)
            [Text] -> ([Text] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& [Text] -> Bool
forall {a}. Ord a => [a] -> Bool
allUnique

        allUnique :: [a] -> Bool
allUnique [a]
xx =
          let unique :: Set a
unique = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
xx
           in Set a -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set a
unique Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xx

calculatePathStats :: StoreEnv () -> StoreEnv PathStats
calculatePathStats :: StoreEnv () -> StoreEnv PathStats
calculatePathStats = StoreEnv IntermediatePathStats -> StoreEnv PathStats
mkFinalEnv (StoreEnv IntermediatePathStats -> StoreEnv PathStats)
-> (StoreEnv () -> StoreEnv IntermediatePathStats)
-> StoreEnv ()
-> StoreEnv PathStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreName -> Bool)
-> StoreEnv () -> StoreEnv IntermediatePathStats
mkIntermediateEnv (Bool -> StoreName -> Bool
forall a b. a -> b -> a
const Bool
True)

-- TODO: This can be precomputed.
shortestPathTo :: StoreEnv a -> StoreName -> NonEmpty (StorePath StoreName a)
shortestPathTo :: forall a.
StoreEnv a -> StoreName -> NonEmpty (StorePath StoreName a)
shortestPathTo StoreEnv a
env StoreName
name =
  (StorePath
   (StorePath
      StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
   a
 -> Maybe (Int, NonEmpty (StorePath StoreName a)))
-> StoreEnv a
-> StoreEnv (Maybe (Int, NonEmpty (StorePath StoreName a)))
forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp
    ( \StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
curr ->
        let currOut :: StorePath StoreName a
currOut = StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
curr {spRefs = spName <$> spRefs curr}
         in if StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
-> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
curr StoreName -> StoreName -> Bool
forall a. Eq a => a -> a -> Bool
== StoreName
name
              then (Int, NonEmpty (StorePath StoreName a))
-> Maybe (Int, NonEmpty (StorePath StoreName a))
forall a. a -> Maybe a
Just (Int
1 :: Int, StorePath StoreName a
currOut StorePath StoreName a
-> [StorePath StoreName a] -> NonEmpty (StorePath StoreName a)
forall a. a -> [a] -> NonEmpty a
:| [])
              else
                (StorePath
   StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))
 -> Maybe (Int, NonEmpty (StorePath StoreName a)))
-> [StorePath
      StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))]
-> [(Int, NonEmpty (StorePath StoreName a))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StorePath StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> Maybe (Int, NonEmpty (StorePath StoreName a))
forall ref payload. StorePath ref payload -> payload
spPayload (StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
-> [StorePath
      StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))]
forall ref payload. StorePath ref payload -> [ref]
spRefs StorePath
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
  a
curr)
                  [(Int, NonEmpty (StorePath StoreName a))]
-> ([(Int, NonEmpty (StorePath StoreName a))]
    -> Maybe (Int, NonEmpty (StorePath StoreName a)))
-> Maybe (Int, NonEmpty (StorePath StoreName a))
forall a b. a -> (a -> b) -> b
& \case
                    [] -> Maybe (Int, NonEmpty (StorePath StoreName a))
forall a. Maybe a
Nothing
                    [(Int, NonEmpty (StorePath StoreName a))]
xs -> case ((Int, NonEmpty (StorePath StoreName a))
 -> (Int, NonEmpty (StorePath StoreName a)) -> Ordering)
-> [(Int, NonEmpty (StorePath StoreName a))]
-> (Int, NonEmpty (StorePath StoreName a))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, NonEmpty (StorePath StoreName a)) -> Int)
-> (Int, NonEmpty (StorePath StoreName a))
-> (Int, NonEmpty (StorePath StoreName a))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, NonEmpty (StorePath StoreName a)) -> Int
forall a b. (a, b) -> a
fst) [(Int, NonEmpty (StorePath StoreName a))]
xs of
                      (Int
c, NonEmpty (StorePath StoreName a)
p) -> (Int, NonEmpty (StorePath StoreName a))
-> Maybe (Int, NonEmpty (StorePath StoreName a))
forall a. a -> Maybe a
Just (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, StorePath StoreName a
currOut StorePath StoreName a
-> NonEmpty (StorePath StoreName a)
-> NonEmpty (StorePath StoreName a)
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty (StorePath StoreName a)
p)
    )
    StoreEnv a
env
    StoreEnv (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> (StoreEnv (Maybe (Int, NonEmpty (StorePath StoreName a)))
    -> NonEmpty
         (StorePath
            StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))))
-> NonEmpty
     (StorePath
        StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
forall a b. a -> (a -> b) -> b
& StoreEnv (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> NonEmpty
     (StorePath
        StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots
    NonEmpty
  (StorePath
     StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
-> (NonEmpty
      (StorePath
         StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
    -> NonEmpty (Maybe (Int, NonEmpty (StorePath StoreName a))))
-> NonEmpty (Maybe (Int, NonEmpty (StorePath StoreName a)))
forall a b. a -> (a -> b) -> b
& (StorePath
   StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))
 -> Maybe (Int, NonEmpty (StorePath StoreName a)))
-> NonEmpty
     (StorePath
        StoreName (Maybe (Int, NonEmpty (StorePath StoreName a))))
-> NonEmpty (Maybe (Int, 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 StorePath StoreName (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> Maybe (Int, NonEmpty (StorePath StoreName a))
forall ref payload. StorePath ref payload -> payload
spPayload
    NonEmpty (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> (NonEmpty (Maybe (Int, NonEmpty (StorePath StoreName a)))
    -> [Maybe (Int, NonEmpty (StorePath StoreName a))])
-> [Maybe (Int, NonEmpty (StorePath StoreName a))]
forall a b. a -> (a -> b) -> b
& NonEmpty (Maybe (Int, NonEmpty (StorePath StoreName a)))
-> [Maybe (Int, NonEmpty (StorePath StoreName a))]
forall a. NonEmpty a -> [a]
NE.toList
    [Maybe (Int, NonEmpty (StorePath StoreName a))]
-> ([Maybe (Int, NonEmpty (StorePath StoreName a))]
    -> [(Int, NonEmpty (StorePath StoreName a))])
-> [(Int, NonEmpty (StorePath StoreName a))]
forall a b. a -> (a -> b) -> b
& [Maybe (Int, NonEmpty (StorePath StoreName a))]
-> [(Int, NonEmpty (StorePath StoreName a))]
forall a. [Maybe a] -> [a]
catMaybes
    [(Int, NonEmpty (StorePath StoreName a))]
-> ([(Int, NonEmpty (StorePath StoreName a))]
    -> (Int, NonEmpty (StorePath StoreName a)))
-> (Int, NonEmpty (StorePath StoreName a))
forall a b. a -> (a -> b) -> b
& ((Int, NonEmpty (StorePath StoreName a))
 -> (Int, NonEmpty (StorePath StoreName a)) -> Ordering)
-> [(Int, NonEmpty (StorePath StoreName a))]
-> (Int, NonEmpty (StorePath StoreName a))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, NonEmpty (StorePath StoreName a)) -> Int)
-> (Int, NonEmpty (StorePath StoreName a))
-> (Int, NonEmpty (StorePath StoreName a))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, NonEmpty (StorePath StoreName a)) -> Int
forall a b. (a, b) -> a
fst)
    (Int, NonEmpty (StorePath StoreName a))
-> ((Int, NonEmpty (StorePath StoreName a))
    -> NonEmpty (StorePath StoreName a))
-> NonEmpty (StorePath StoreName a)
forall a b. a -> (a -> b) -> b
& (Int, NonEmpty (StorePath StoreName a))
-> NonEmpty (StorePath StoreName a)
forall a b. (a, b) -> b
snd
    NonEmpty (StorePath StoreName a)
-> (NonEmpty (StorePath StoreName a)
    -> NonEmpty (StorePath StoreName a))
-> NonEmpty (StorePath StoreName a)
forall a b. a -> (a -> b) -> b
& NonEmpty (StorePath StoreName a)
-> NonEmpty (StorePath StoreName a)
forall a. NonEmpty a -> NonEmpty a
NE.reverse

-- Why depends implementation

-- We iterate the dependency graph bottom up. Every node contains a set of paths which represent
-- the why-depends output from that node down. The set of paths is represented as a "Treeish" object,
-- which is a trie-like structure.
whyDepends :: forall a. StoreEnv a -> StoreName -> [NonEmpty (StorePath StoreName a)]
whyDepends :: forall a.
StoreEnv a -> StoreName -> [NonEmpty (StorePath StoreName a)]
whyDepends StoreEnv a
env StoreName
name =
  forall a b.
(StorePath (StorePath StoreName b) a -> b)
-> StoreEnv a -> StoreEnv b
seBottomUp @_ @(Maybe (Treeish (StorePath StoreName a)))
    ( \StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
curr ->
        if StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
-> StoreName
forall ref payload. StorePath ref payload -> StoreName
spName StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
curr StoreName -> StoreName -> Bool
forall a. Eq a => a -> a -> Bool
== StoreName
name
          then Treeish (StorePath StoreName a)
-> Maybe (Treeish (StorePath StoreName a))
forall a. a -> Maybe a
Just (Treeish (StorePath StoreName a)
 -> Maybe (Treeish (StorePath StoreName a)))
-> Treeish (StorePath StoreName a)
-> Maybe (Treeish (StorePath StoreName a))
forall a b. (a -> b) -> a -> b
$ StorePath StoreName a
-> [Treeish (StorePath StoreName a)]
-> Treeish (StorePath StoreName a)
forall a. a -> [Treeish a] -> Treeish a
mkTreeish (StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
curr {spRefs = map spName (spRefs curr)}) []
          else
            (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))
 -> Maybe (Treeish (StorePath StoreName a)))
-> [StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))]
-> [Treeish (StorePath StoreName a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))
-> Maybe (Treeish (StorePath StoreName a))
forall ref payload. StorePath ref payload -> payload
spPayload (StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
-> [StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))]
forall ref payload. StorePath ref payload -> [ref]
spRefs StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
curr)
              [Treeish (StorePath StoreName a)]
-> ([Treeish (StorePath StoreName a)]
    -> Maybe (NonEmpty (Treeish (StorePath StoreName a))))
-> Maybe (NonEmpty (Treeish (StorePath StoreName a)))
forall a b. a -> (a -> b) -> b
& [Treeish (StorePath StoreName a)]
-> Maybe (NonEmpty (Treeish (StorePath StoreName a)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
              Maybe (NonEmpty (Treeish (StorePath StoreName a)))
-> (NonEmpty (Treeish (StorePath StoreName a))
    -> [Treeish (StorePath StoreName a)])
-> Maybe [Treeish (StorePath StoreName a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NonEmpty (Treeish (StorePath StoreName a))
-> [Treeish (StorePath StoreName a)]
forall a. NonEmpty a -> [a]
NE.toList
              Maybe [Treeish (StorePath StoreName a)]
-> ([Treeish (StorePath StoreName a)]
    -> Treeish (StorePath StoreName a))
-> Maybe (Treeish (StorePath StoreName a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> StorePath StoreName a
-> [Treeish (StorePath StoreName a)]
-> Treeish (StorePath StoreName a)
forall a. a -> [Treeish a] -> Treeish a
mkTreeish (StorePath
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))) a
curr {spRefs = map spName (spRefs curr)})
              Maybe (Treeish (StorePath StoreName a))
-> (Treeish (StorePath StoreName a)
    -> Treeish (StorePath StoreName a))
-> Maybe (Treeish (StorePath StoreName a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int
-> Treeish (StorePath StoreName a)
-> Treeish (StorePath StoreName a)
forall a. Int -> Treeish a -> Treeish a
capTreeish Int
1_000_000
    )
    StoreEnv a
env
    StoreEnv (Maybe (Treeish (StorePath StoreName a)))
-> (StoreEnv (Maybe (Treeish (StorePath StoreName a)))
    -> NonEmpty
         (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))))
-> NonEmpty
     (StorePath StoreName (Maybe (Treeish (StorePath StoreName a))))
forall a b. a -> (a -> b) -> b
& StoreEnv (Maybe (Treeish (StorePath StoreName a)))
-> NonEmpty
     (StorePath StoreName (Maybe (Treeish (StorePath StoreName a))))
forall a. StoreEnv a -> NonEmpty (StorePath StoreName a)
seGetRoots
    NonEmpty
  (StorePath StoreName (Maybe (Treeish (StorePath StoreName a))))
-> (NonEmpty
      (StorePath StoreName (Maybe (Treeish (StorePath StoreName a))))
    -> NonEmpty (Maybe (Treeish (StorePath StoreName a))))
-> NonEmpty (Maybe (Treeish (StorePath StoreName a)))
forall a b. a -> (a -> b) -> b
& (StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))
 -> Maybe (Treeish (StorePath StoreName a)))
-> NonEmpty
     (StorePath StoreName (Maybe (Treeish (StorePath StoreName a))))
-> NonEmpty (Maybe (Treeish (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 StorePath StoreName (Maybe (Treeish (StorePath StoreName a)))
-> Maybe (Treeish (StorePath StoreName a))
forall ref payload. StorePath ref payload -> payload
spPayload
    NonEmpty (Maybe (Treeish (StorePath StoreName a)))
-> (NonEmpty (Maybe (Treeish (StorePath StoreName a)))
    -> [Maybe (Treeish (StorePath StoreName a))])
-> [Maybe (Treeish (StorePath StoreName a))]
forall a b. a -> (a -> b) -> b
& NonEmpty (Maybe (Treeish (StorePath StoreName a)))
-> [Maybe (Treeish (StorePath StoreName a))]
forall a. NonEmpty a -> [a]
NE.toList
    [Maybe (Treeish (StorePath StoreName a))]
-> ([Maybe (Treeish (StorePath StoreName a))]
    -> [Treeish (StorePath StoreName a)])
-> [Treeish (StorePath StoreName a)]
forall a b. a -> (a -> b) -> b
& [Maybe (Treeish (StorePath StoreName a))]
-> [Treeish (StorePath StoreName a)]
forall a. [Maybe a] -> [a]
catMaybes
    [Treeish (StorePath StoreName a)]
-> ([Treeish (StorePath StoreName a)]
    -> [Treeish (StorePath StoreName a)])
-> [Treeish (StorePath StoreName a)]
forall a b. a -> (a -> b) -> b
& Int
-> [Treeish (StorePath StoreName a)]
-> [Treeish (StorePath StoreName a)]
forall a. Int -> [a] -> [a]
take Int
10000
    [Treeish (StorePath StoreName a)]
-> ([Treeish (StorePath StoreName a)]
    -> [NonEmpty (StorePath StoreName a)])
-> [NonEmpty (StorePath StoreName a)]
forall a b. a -> (a -> b) -> b
& (Treeish (StorePath StoreName a)
 -> [NonEmpty (StorePath StoreName a)])
-> [Treeish (StorePath StoreName a)]
-> [NonEmpty (StorePath StoreName a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Treeish (StorePath StoreName a)
-> [NonEmpty (StorePath StoreName a)]
forall a. Treeish a -> [NonEmpty a]
treeishToList

-- A trie-like structure which also caches the size.
data Treeish a = Treeish Int a [Treeish a]

mkTreeish :: a -> [Treeish a] -> Treeish a
mkTreeish :: forall a. a -> [Treeish a] -> Treeish a
mkTreeish a
a [Treeish a]
ts = Int -> a -> [Treeish a] -> Treeish a
forall a. Int -> a -> [Treeish a] -> Treeish a
Treeish (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ((Treeish a -> Int) -> [Treeish a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Treeish Int
i a
_ [Treeish a]
_) -> Int
i) [Treeish a]
ts)) a
a [Treeish a]
ts

treeishSize :: Treeish a -> Int
treeishSize :: forall a. Treeish a -> Int
treeishSize (Treeish Int
i a
_ [Treeish a]
_) = Int
i

capTreeish :: Int -> Treeish a -> Treeish a
capTreeish :: forall a. Int -> Treeish a -> Treeish a
capTreeish Int
cap (Treeish Int
i a
a [Treeish a]
ts)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cap = Int -> a -> [Treeish a] -> Treeish a
forall a. Int -> a -> [Treeish a] -> Treeish a
Treeish Int
i a
a [Treeish a]
ts
  | Bool
otherwise = Int -> a -> [Treeish a] -> Treeish a
forall a. Int -> a -> [Treeish a] -> Treeish a
Treeish Int
cap a
a (Int -> [Treeish a] -> [Treeish a]
forall {a}. Int -> [Treeish a] -> [Treeish a]
go Int
cap [Treeish a]
ts)
  where
    go :: Int -> [Treeish a] -> [Treeish a]
go Int
_ [] = []
    go Int
remaining (Treeish a
x : [Treeish a]
xs) =
      let x' :: Treeish a
x' = Int -> Treeish a -> Treeish a
forall a. Int -> Treeish a -> Treeish a
capTreeish Int
remaining Treeish a
x
          remaining' :: Int
remaining' = Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Treeish a -> Int
forall a. Treeish a -> Int
treeishSize Treeish a
x'
       in if Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then Treeish a
x' Treeish a -> [Treeish a] -> [Treeish a]
forall a. a -> [a] -> [a]
: Int -> [Treeish a] -> [Treeish a]
go Int
remaining' [Treeish a]
xs
            else [Treeish a
x']

treeishToList :: Treeish a -> [NonEmpty a]
treeishToList :: forall a. Treeish a -> [NonEmpty a]
treeishToList (Treeish Int
_ a
a []) = [a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []]
treeishToList (Treeish Int
_ a
a [Treeish a]
xs) = (NonEmpty a -> NonEmpty a) -> [NonEmpty a] -> [NonEmpty a]
forall a b. (a -> b) -> [a] -> [b]
map (a
a a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NE.<|) ((Treeish a -> [NonEmpty a]) -> [Treeish a] -> [NonEmpty a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Treeish a -> [NonEmpty a]
forall a. Treeish a -> [NonEmpty a]
treeishToList [Treeish a]
xs)