module U.Codebase.Branch
  ( module X,
    nonEmptyChildren,
    childStats,
    isEmpty,
  )
where

import U.Codebase.Branch.Type as X
import U.Codebase.Causal qualified as Causal
import U.Codebase.Sqlite.Operations qualified as Ops
import Unison.NameSegment (NameSegment)
import Unison.Prelude
import Unison.Sqlite (Transaction)

isEmpty :: Branch m -> Transaction Bool
isEmpty :: forall (m :: * -> *). Branch m -> Transaction Bool
isEmpty b :: Branch m
b@(Branch {Map NameSegment (Map Reference (m MdValues))
types :: Map NameSegment (Map Reference (m MdValues))
$sel:types:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
types, Map NameSegment (Map Referent (m MdValues))
terms :: Map NameSegment (Map Referent (m MdValues))
$sel:terms:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
terms, Map NameSegment (PatchHash, m Patch)
patches :: Map NameSegment (PatchHash, m Patch)
$sel:patches:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (PatchHash, m Patch)
patches}) = do
  Bool
noChildren <- Map NameSegment (CausalBranch m) -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map NameSegment (CausalBranch m) -> Bool)
-> Transaction (Map NameSegment (CausalBranch m))
-> Transaction Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch m -> Transaction (Map NameSegment (CausalBranch m))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
nonEmptyChildren Branch m
b
  pure $ Map NameSegment (Map Reference (m MdValues)) -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment (Map Reference (m MdValues))
types Bool -> Bool -> Bool
&& Map NameSegment (Map Referent (m MdValues)) -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment (Map Referent (m MdValues))
terms Bool -> Bool -> Bool
&& Map NameSegment (PatchHash, m Patch) -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment (PatchHash, m Patch)
patches Bool -> Bool -> Bool
&& Bool
noChildren

nonEmptyChildren :: Branch m -> Transaction (Map NameSegment (CausalBranch m))
nonEmptyChildren :: forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
nonEmptyChildren Branch m
branch = do
  Map NameSegment (CausalBranch m, NamespaceStats)
childrenWithStats <- Branch m
-> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
forall (m :: * -> *).
Branch m
-> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
childStats Branch m
branch
  pure $
    Map NameSegment (CausalBranch m, NamespaceStats)
childrenWithStats
      Map NameSegment (CausalBranch m, NamespaceStats)
-> (Map NameSegment (CausalBranch m, NamespaceStats)
    -> Map NameSegment (CausalBranch m))
-> Map NameSegment (CausalBranch m)
forall a b. a -> (a -> b) -> b
& ((CausalBranch m, NamespaceStats) -> Maybe (CausalBranch m))
-> Map NameSegment (CausalBranch m, NamespaceStats)
-> Map NameSegment (CausalBranch m)
forall a b.
(a -> Maybe b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe
        ( \(CausalBranch m
cb, NamespaceStats
stats) ->
            if NamespaceStats -> Bool
nonZeroStats NamespaceStats
stats
              then CausalBranch m -> Maybe (CausalBranch m)
forall a. a -> Maybe a
Just CausalBranch m
cb
              else Maybe (CausalBranch m)
forall a. Maybe a
Nothing
        )
  where
    nonZeroStats :: NamespaceStats -> Bool
nonZeroStats (NamespaceStats Int
numContainedTerms Int
numContainedTypes Int
numContainedPatches) =
      Int
numContainedTerms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numContainedTypes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numContainedPatches Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

childStats :: Branch m -> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
childStats :: forall (m :: * -> *).
Branch m
-> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
childStats Branch {Map NameSegment (CausalBranch m)
children :: Map NameSegment (CausalBranch m)
$sel:children:Branch :: forall (m :: * -> *). Branch m -> Map NameSegment (CausalBranch m)
children} =
  Map NameSegment (CausalBranch m)
-> (CausalBranch m -> Transaction (CausalBranch m, NamespaceStats))
-> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map NameSegment (CausalBranch m)
children \CausalBranch m
cb -> do
    NamespaceStats
stats <- BranchHash -> Transaction NamespaceStats
Ops.expectNamespaceStatsByHash (CausalBranch m -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
Causal.valueHash CausalBranch m
cb)
    pure (CausalBranch m
cb, NamespaceStats
stats)