module U.Codebase.Branch.Type
  ( Branch (..),
    CausalBranch,
    Patch (..),
    MetadataType,
    MetadataValue,
    MdValues (..),
    NamespaceStats (..),
    hasDefinitions,
    childAt,
    hoist,
    hoistCausalBranch,
    U.Codebase.Branch.Type.empty,
  )
where

import Data.Map.Strict qualified as Map
import U.Codebase.Causal (Causal)
import U.Codebase.Causal qualified as Causal
import U.Codebase.HashTags (BranchHash, CausalHash, PatchHash)
import U.Codebase.Reference (Reference)
import U.Codebase.Referent (Referent)
import U.Codebase.TermEdit (TermEdit)
import U.Codebase.TypeEdit (TypeEdit)
import Unison.NameSegment (NameSegment)
import Unison.Prelude

type MetadataType = Reference

type MetadataValue = Reference

newtype MdValues = MdValues {MdValues -> Set MetadataValue
unMdValues :: Set MetadataValue} deriving (MdValues -> MdValues -> Bool
(MdValues -> MdValues -> Bool)
-> (MdValues -> MdValues -> Bool) -> Eq MdValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MdValues -> MdValues -> Bool
== :: MdValues -> MdValues -> Bool
$c/= :: MdValues -> MdValues -> Bool
/= :: MdValues -> MdValues -> Bool
Eq, Eq MdValues
Eq MdValues =>
(MdValues -> MdValues -> Ordering)
-> (MdValues -> MdValues -> Bool)
-> (MdValues -> MdValues -> Bool)
-> (MdValues -> MdValues -> Bool)
-> (MdValues -> MdValues -> Bool)
-> (MdValues -> MdValues -> MdValues)
-> (MdValues -> MdValues -> MdValues)
-> Ord MdValues
MdValues -> MdValues -> Bool
MdValues -> MdValues -> Ordering
MdValues -> MdValues -> MdValues
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 :: MdValues -> MdValues -> Ordering
compare :: MdValues -> MdValues -> Ordering
$c< :: MdValues -> MdValues -> Bool
< :: MdValues -> MdValues -> Bool
$c<= :: MdValues -> MdValues -> Bool
<= :: MdValues -> MdValues -> Bool
$c> :: MdValues -> MdValues -> Bool
> :: MdValues -> MdValues -> Bool
$c>= :: MdValues -> MdValues -> Bool
>= :: MdValues -> MdValues -> Bool
$cmax :: MdValues -> MdValues -> MdValues
max :: MdValues -> MdValues -> MdValues
$cmin :: MdValues -> MdValues -> MdValues
min :: MdValues -> MdValues -> MdValues
Ord, Int -> MdValues -> ShowS
[MdValues] -> ShowS
MdValues -> String
(Int -> MdValues -> ShowS)
-> (MdValues -> String) -> ([MdValues] -> ShowS) -> Show MdValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MdValues -> ShowS
showsPrec :: Int -> MdValues -> ShowS
$cshow :: MdValues -> String
show :: MdValues -> String
$cshowList :: [MdValues] -> ShowS
showList :: [MdValues] -> ShowS
Show)

type CausalBranch m = Causal m CausalHash BranchHash (Branch m) (Branch m)

-- | A re-imagining of Unison.Codebase.Branch which is less eager in what it loads,
-- which can often speed up load times and keep fewer things in memory.
data Branch m = Branch
  { forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
terms :: !(Map NameSegment (Map Referent (m MdValues))),
    forall (m :: * -> *).
Branch m -> Map NameSegment (Map MetadataValue (m MdValues))
types :: !(Map NameSegment (Map Reference (m MdValues))),
    forall (m :: * -> *).
Branch m -> Map NameSegment (PatchHash, m Patch)
patches :: !(Map NameSegment (PatchHash, m Patch)),
    forall (m :: * -> *). Branch m -> Map NameSegment (CausalBranch m)
children :: !(Map NameSegment (CausalBranch m))
  }
  deriving stock ((forall x. Branch m -> Rep (Branch m) x)
-> (forall x. Rep (Branch m) x -> Branch m) -> Generic (Branch m)
forall x. Rep (Branch m) x -> Branch m
forall x. Branch m -> Rep (Branch m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (Branch m) x -> Branch m
forall (m :: * -> *) x. Branch m -> Rep (Branch m) x
$cfrom :: forall (m :: * -> *) x. Branch m -> Rep (Branch m) x
from :: forall x. Branch m -> Rep (Branch m) x
$cto :: forall (m :: * -> *) x. Rep (Branch m) x -> Branch m
to :: forall x. Rep (Branch m) x -> Branch m
Generic)

empty :: Branch m
empty :: forall (m :: * -> *). Branch m
empty = Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment (Map MetadataValue (m MdValues))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (CausalBranch m)
-> Branch m
forall (m :: * -> *).
Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment (Map MetadataValue (m MdValues))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (CausalBranch m)
-> Branch m
Branch Map NameSegment (Map Referent (m MdValues))
forall a. Monoid a => a
mempty Map NameSegment (Map MetadataValue (m MdValues))
forall a. Monoid a => a
mempty Map NameSegment (PatchHash, m Patch)
forall a. Monoid a => a
mempty Map NameSegment (CausalBranch m)
forall a. Monoid a => a
mempty

data Patch = Patch
  { Patch -> Map Referent (Set TermEdit)
termEdits :: !(Map Referent (Set TermEdit)),
    Patch -> Map MetadataValue (Set TypeEdit)
typeEdits :: !(Map Reference (Set TypeEdit))
  }

instance Show (Branch m) where
  show :: Branch m -> String
show Branch m
b =
    String
"Branch { terms = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map NameSegment [Referent] -> String
forall a. Show a => a -> String
show ((Map Referent (m MdValues) -> [Referent])
-> Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment [Referent]
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Referent (m MdValues) -> [Referent]
forall k a. Map k a -> [k]
Map.keys (Branch m -> Map NameSegment (Map Referent (m MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
terms Branch m
b))
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", types = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map NameSegment [MetadataValue] -> String
forall a. Show a => a -> String
show ((Map MetadataValue (m MdValues) -> [MetadataValue])
-> Map NameSegment (Map MetadataValue (m MdValues))
-> Map NameSegment [MetadataValue]
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map MetadataValue (m MdValues) -> [MetadataValue]
forall k a. Map k a -> [k]
Map.keys (Branch m -> Map NameSegment (Map MetadataValue (m MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map MetadataValue (m MdValues))
types Branch m
b))
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", patches = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map NameSegment PatchHash -> String
forall a. Show a => a -> String
show (((PatchHash, m Patch) -> PatchHash)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment PatchHash
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst (Branch m -> Map NameSegment (PatchHash, m Patch)
forall (m :: * -> *).
Branch m -> Map NameSegment (PatchHash, m Patch)
patches Branch m
b))
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", children = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [NameSegment] -> String
forall a. Show a => a -> String
show (Map NameSegment (CausalBranch m) -> [NameSegment]
forall k a. Map k a -> [k]
Map.keys (Branch m -> Map NameSegment (CausalBranch m)
forall (m :: * -> *). Branch m -> Map NameSegment (CausalBranch m)
children Branch m
b))

-- | Useful statistics about a namespace.
-- All contained statistics should be 'static', i.e. they can be computed when a branch is
-- first saved, and won't change unless the branch hash also changes.
data NamespaceStats = NamespaceStats
  { NamespaceStats -> Int
numContainedTerms :: !Int,
    NamespaceStats -> Int
numContainedTypes :: !Int,
    NamespaceStats -> Int
numContainedPatches :: !Int
  }
  deriving (Int -> NamespaceStats -> ShowS
[NamespaceStats] -> ShowS
NamespaceStats -> String
(Int -> NamespaceStats -> ShowS)
-> (NamespaceStats -> String)
-> ([NamespaceStats] -> ShowS)
-> Show NamespaceStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamespaceStats -> ShowS
showsPrec :: Int -> NamespaceStats -> ShowS
$cshow :: NamespaceStats -> String
show :: NamespaceStats -> String
$cshowList :: [NamespaceStats] -> ShowS
showList :: [NamespaceStats] -> ShowS
Show, NamespaceStats -> NamespaceStats -> Bool
(NamespaceStats -> NamespaceStats -> Bool)
-> (NamespaceStats -> NamespaceStats -> Bool) -> Eq NamespaceStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamespaceStats -> NamespaceStats -> Bool
== :: NamespaceStats -> NamespaceStats -> Bool
$c/= :: NamespaceStats -> NamespaceStats -> Bool
/= :: NamespaceStats -> NamespaceStats -> Bool
Eq, Eq NamespaceStats
Eq NamespaceStats =>
(NamespaceStats -> NamespaceStats -> Ordering)
-> (NamespaceStats -> NamespaceStats -> Bool)
-> (NamespaceStats -> NamespaceStats -> Bool)
-> (NamespaceStats -> NamespaceStats -> Bool)
-> (NamespaceStats -> NamespaceStats -> Bool)
-> (NamespaceStats -> NamespaceStats -> NamespaceStats)
-> (NamespaceStats -> NamespaceStats -> NamespaceStats)
-> Ord NamespaceStats
NamespaceStats -> NamespaceStats -> Bool
NamespaceStats -> NamespaceStats -> Ordering
NamespaceStats -> NamespaceStats -> NamespaceStats
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 :: NamespaceStats -> NamespaceStats -> Ordering
compare :: NamespaceStats -> NamespaceStats -> Ordering
$c< :: NamespaceStats -> NamespaceStats -> Bool
< :: NamespaceStats -> NamespaceStats -> Bool
$c<= :: NamespaceStats -> NamespaceStats -> Bool
<= :: NamespaceStats -> NamespaceStats -> Bool
$c> :: NamespaceStats -> NamespaceStats -> Bool
> :: NamespaceStats -> NamespaceStats -> Bool
$c>= :: NamespaceStats -> NamespaceStats -> Bool
>= :: NamespaceStats -> NamespaceStats -> Bool
$cmax :: NamespaceStats -> NamespaceStats -> NamespaceStats
max :: NamespaceStats -> NamespaceStats -> NamespaceStats
$cmin :: NamespaceStats -> NamespaceStats -> NamespaceStats
min :: NamespaceStats -> NamespaceStats -> NamespaceStats
Ord)

instance Semigroup NamespaceStats where
  NamespaceStats Int
a1 Int
b1 Int
c1 <> :: NamespaceStats -> NamespaceStats -> NamespaceStats
<> NamespaceStats Int
a2 Int
b2 Int
c2 =
    Int -> Int -> Int -> NamespaceStats
NamespaceStats (Int
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a2) (Int
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b2) (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2)

instance Monoid NamespaceStats where
  mempty :: NamespaceStats
mempty = Int -> Int -> Int -> NamespaceStats
NamespaceStats Int
0 Int
0 Int
0

-- | Whether the provided stats indicate the presence of any definitions in the namespace.
hasDefinitions :: NamespaceStats -> Bool
hasDefinitions :: NamespaceStats -> Bool
hasDefinitions (NamespaceStats Int
numTerms Int
numTypes Int
_numPatches) =
  Int
numTerms Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numTypes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

childAt :: NameSegment -> Branch m -> Maybe (CausalBranch m)
childAt :: forall (m :: * -> *).
NameSegment -> Branch m -> Maybe (CausalBranch m)
childAt NameSegment
ns (Branch {Map NameSegment (CausalBranch m)
$sel:children:Branch :: forall (m :: * -> *). Branch m -> Map NameSegment (CausalBranch m)
children :: Map NameSegment (CausalBranch m)
children}) = NameSegment
-> Map NameSegment (CausalBranch m) -> Maybe (CausalBranch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
ns Map NameSegment (CausalBranch m)
children

hoist :: (Functor n) => (forall x. m x -> n x) -> Branch m -> Branch n
hoist :: forall (n :: * -> *) (m :: * -> *).
Functor n =>
(forall x. m x -> n x) -> Branch m -> Branch n
hoist forall x. m x -> n x
f Branch {Map NameSegment (CausalBranch m)
$sel:children:Branch :: forall (m :: * -> *). Branch m -> Map NameSegment (CausalBranch m)
children :: Map NameSegment (CausalBranch m)
children, Map NameSegment (PatchHash, m Patch)
$sel:patches:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (PatchHash, m Patch)
patches :: Map NameSegment (PatchHash, m Patch)
patches, Map NameSegment (Map Referent (m MdValues))
$sel:terms:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
terms :: Map NameSegment (Map Referent (m MdValues))
terms, Map NameSegment (Map MetadataValue (m MdValues))
$sel:types:Branch :: forall (m :: * -> *).
Branch m -> Map NameSegment (Map MetadataValue (m MdValues))
types :: Map NameSegment (Map MetadataValue (m MdValues))
types} =
  Branch
    { $sel:terms:Branch :: Map NameSegment (Map Referent (n MdValues))
terms = ((Map Referent (m MdValues) -> Map Referent (n MdValues))
-> Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment (Map Referent (n MdValues))
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map Referent (m MdValues) -> Map Referent (n MdValues))
 -> Map NameSegment (Map Referent (m MdValues))
 -> Map NameSegment (Map Referent (n MdValues)))
-> ((m MdValues -> n MdValues)
    -> Map Referent (m MdValues) -> Map Referent (n MdValues))
-> (m MdValues -> n MdValues)
-> Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment (Map Referent (n MdValues))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m MdValues -> n MdValues)
-> Map Referent (m MdValues) -> Map Referent (n MdValues)
forall a b. (a -> b) -> Map Referent a -> Map Referent b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) m MdValues -> n MdValues
forall x. m x -> n x
f Map NameSegment (Map Referent (m MdValues))
terms,
      $sel:types:Branch :: Map NameSegment (Map MetadataValue (n MdValues))
types = ((Map MetadataValue (m MdValues) -> Map MetadataValue (n MdValues))
-> Map NameSegment (Map MetadataValue (m MdValues))
-> Map NameSegment (Map MetadataValue (n MdValues))
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map MetadataValue (m MdValues) -> Map MetadataValue (n MdValues))
 -> Map NameSegment (Map MetadataValue (m MdValues))
 -> Map NameSegment (Map MetadataValue (n MdValues)))
-> ((m MdValues -> n MdValues)
    -> Map MetadataValue (m MdValues)
    -> Map MetadataValue (n MdValues))
-> (m MdValues -> n MdValues)
-> Map NameSegment (Map MetadataValue (m MdValues))
-> Map NameSegment (Map MetadataValue (n MdValues))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m MdValues -> n MdValues)
-> Map MetadataValue (m MdValues) -> Map MetadataValue (n MdValues)
forall a b. (a -> b) -> Map MetadataValue a -> Map MetadataValue b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) m MdValues -> n MdValues
forall x. m x -> n x
f Map NameSegment (Map MetadataValue (m MdValues))
types,
      $sel:patches:Branch :: Map NameSegment (PatchHash, n Patch)
patches = (((PatchHash, m Patch) -> (PatchHash, n Patch))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, n Patch)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PatchHash, m Patch) -> (PatchHash, n Patch))
 -> Map NameSegment (PatchHash, m Patch)
 -> Map NameSegment (PatchHash, n Patch))
-> ((m Patch -> n Patch)
    -> (PatchHash, m Patch) -> (PatchHash, n Patch))
-> (m Patch -> n Patch)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (PatchHash, n Patch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m Patch -> n Patch)
-> (PatchHash, m Patch) -> (PatchHash, n Patch)
forall a b. (a -> b) -> (PatchHash, a) -> (PatchHash, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) m Patch -> n Patch
forall x. m x -> n x
f Map NameSegment (PatchHash, m Patch)
patches,
      $sel:children:Branch :: Map NameSegment (CausalBranch n)
children = (CausalBranch m -> CausalBranch n)
-> Map NameSegment (CausalBranch m)
-> Map NameSegment (CausalBranch n)
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. m x -> n x) -> CausalBranch m -> CausalBranch n
forall (n :: * -> *) (m :: * -> *).
Functor n =>
(forall x. m x -> n x) -> CausalBranch m -> CausalBranch n
hoistCausalBranch m x -> n x
forall x. m x -> n x
f) Map NameSegment (CausalBranch m)
children
    }

hoistCausalBranch :: (Functor n) => (forall x. m x -> n x) -> CausalBranch m -> CausalBranch n
hoistCausalBranch :: forall (n :: * -> *) (m :: * -> *).
Functor n =>
(forall x. m x -> n x) -> CausalBranch m -> CausalBranch n
hoistCausalBranch forall x. m x -> n x
f CausalBranch m
cb =
  CausalBranch m
cb
    CausalBranch m
-> (CausalBranch m
    -> Causal n CausalHash BranchHash (Branch m) (Branch m))
-> Causal n CausalHash BranchHash (Branch m) (Branch m)
forall a b. a -> (a -> b) -> b
& (forall x. m x -> n x)
-> CausalBranch m
-> Causal n CausalHash BranchHash (Branch m) (Branch m)
forall (n :: * -> *) (m :: * -> *) hc he pe e.
Functor n =>
(forall x. m x -> n x)
-> Causal m hc he pe e -> Causal n hc he pe e
Causal.hoist m x -> n x
forall x. m x -> n x
f
    Causal n CausalHash BranchHash (Branch m) (Branch m)
-> (Causal n CausalHash BranchHash (Branch m) (Branch m)
    -> CausalBranch n)
-> CausalBranch n
forall a b. a -> (a -> b) -> b
& (Branch m -> Branch n)
-> (Branch m -> Branch n)
-> Causal n CausalHash BranchHash (Branch m) (Branch m)
-> CausalBranch n
forall (m :: * -> *) e e' pe pe' hc he.
Functor m =>
(e -> e')
-> (pe -> pe') -> Causal m hc he pe e -> Causal m hc he pe' e'
Causal.emap ((forall x. m x -> n x) -> Branch m -> Branch n
forall (n :: * -> *) (m :: * -> *).
Functor n =>
(forall x. m x -> n x) -> Branch m -> Branch n
hoist m x -> n x
forall x. m x -> n x
f) ((forall x. m x -> n x) -> Branch m -> Branch n
forall (n :: * -> *) (m :: * -> *).
Functor n =>
(forall x. m x -> n x) -> Branch m -> Branch n
hoist m x -> n x
forall x. m x -> n x
f)