module Unison.Codebase.BranchUtil
  ( -- * Branch creation
    fromNames,

    -- * Branch queries
    getBranch,
    getTerm,
    getType,

    -- * Branch modifications
    makeSetBranch,
    makeAddTypeName,
    makeDeleteTypeName,
    makeAnnihilateTypeName,
    makeAddTermName,
    makeDeleteTermName,
    makeAnnihilateTermName,
  )
where

import Control.Lens
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Codebase.Branch (Branch, Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Prelude
import Unison.Reference (TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.ShortHash qualified as SH
import Unison.Util.Relation qualified as R
import Unison.Util.Star2 qualified as Star2

-- | Creates a branch containing all of the given names, with a single history node.
fromNames :: (Monad m) => Names -> Branch m
fromNames :: forall (m :: * -> *). Monad m => Names -> Branch m
fromNames Names
names0 = [(Path, Branch0 m -> Branch0 m)] -> Branch m -> Branch m
forall (m :: * -> *) (f :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch m -> Branch m
Branch.stepManyAt ([(Path, Branch0 m -> Branch0 m)]
typeActions [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Branch0 m -> Branch0 m)]
termActions) Branch m
forall (m :: * -> *). Branch m
Branch.empty
  where
    typeActions :: [(Path, Branch0 m -> Branch0 m)]
typeActions = ((Name, TypeReference) -> (Path, Branch0 m -> Branch0 m))
-> [(Name, TypeReference)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TypeReference) -> (Path, Branch0 m -> Branch0 m)
forall {m :: * -> *}.
(Name, TypeReference) -> (Path, Branch0 m -> Branch0 m)
doType ([(Name, TypeReference)] -> [(Path, Branch0 m -> Branch0 m)])
-> (Relation Name TypeReference -> [(Name, TypeReference)])
-> Relation Name TypeReference
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name TypeReference -> [(Name, TypeReference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name TypeReference -> [(Path, Branch0 m -> Branch0 m)])
-> Relation Name TypeReference -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name TypeReference
Names.types Names
names0
    termActions :: [(Path, Branch0 m -> Branch0 m)]
termActions = ((Name, Referent) -> (Path, Branch0 m -> Branch0 m))
-> [(Name, Referent)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Referent) -> (Path, Branch0 m -> Branch0 m)
forall {m :: * -> *}.
(Name, Referent) -> (Path, Branch0 m -> Branch0 m)
doTerm ([(Name, Referent)] -> [(Path, Branch0 m -> Branch0 m)])
-> (Relation Name Referent -> [(Name, Referent)])
-> Relation Name Referent
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Referent -> [(Path, Branch0 m -> Branch0 m)])
-> Relation Name Referent -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name Referent
Names.terms Names
names0
    doTerm :: (Name, Referent) -> (Path, Branch0 m -> Branch0 m)
doTerm (Name
n, Referent
r) = Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
makeAddTermName (Name -> Split Path
Path.splitFromName Name
n) Referent
r
    doType :: (Name, TypeReference) -> (Path, Branch0 m -> Branch0 m)
doType (Name
n, TypeReference
r) = Split Path -> TypeReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName (Name -> Split Path
Path.splitFromName Name
n) TypeReference
r

getTerm :: HQ'.HashQualified (Path.Split Path) -> Branch0 m -> Set Referent
getTerm :: forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Referent
getTerm HashQualified (Split Path)
hq Branch0 m
b = case HashQualified (Split Path)
hq of
  HQ'.NameOnly (Path
p, NameSegment
n) -> NameSegment -> Star Referent NameSegment -> Set Referent
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star Referent NameSegment -> Set Referent)
-> Star Referent NameSegment -> Set Referent
forall a b. (a -> b) -> a -> b
$ Path -> Star Referent NameSegment
terms Path
p
  HQ'.HashQualified (Path
p, NameSegment
n) ShortHash
sh -> ShortHash -> Set Referent -> Set Referent
filter ShortHash
sh (Set Referent -> Set Referent)
-> (Star Referent NameSegment -> Set Referent)
-> Star Referent NameSegment
-> Set Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Star Referent NameSegment -> Set Referent
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star Referent NameSegment -> Set Referent)
-> Star Referent NameSegment -> Set Referent
forall a b. (a -> b) -> a -> b
$ Path -> Star Referent NameSegment
terms Path
p
  where
    filter :: ShortHash -> Set Referent -> Set Referent
filter ShortHash
sh = (Referent -> Bool) -> Set Referent -> Set Referent
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (ShortHash -> Bool) -> (Referent -> ShortHash) -> Referent -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> ShortHash
Referent.toShortHash)
    terms :: Path -> Star Referent NameSegment
terms Path
p = (Path -> Branch0 m -> Branch0 m
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 Path
p Branch0 m
b) Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms_

getType :: HQ'.HashQualified (Path.Split Path) -> Branch0 m -> Set Reference.TypeReference
getType :: forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set TypeReference
getType HashQualified (Split Path)
hq Branch0 m
b = case HashQualified (Split Path)
hq of
  HQ'.NameOnly (Path
p, NameSegment
n) -> NameSegment -> Star TypeReference NameSegment -> Set TypeReference
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star TypeReference NameSegment -> Set TypeReference)
-> Star TypeReference NameSegment -> Set TypeReference
forall a b. (a -> b) -> a -> b
$ Path -> Star TypeReference NameSegment
types Path
p
  HQ'.HashQualified (Path
p, NameSegment
n) ShortHash
sh -> ShortHash -> Set TypeReference -> Set TypeReference
filter ShortHash
sh (Set TypeReference -> Set TypeReference)
-> (Star TypeReference NameSegment -> Set TypeReference)
-> Star TypeReference NameSegment
-> Set TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Star TypeReference NameSegment -> Set TypeReference
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star TypeReference NameSegment -> Set TypeReference)
-> Star TypeReference NameSegment -> Set TypeReference
forall a b. (a -> b) -> a -> b
$ Path -> Star TypeReference NameSegment
types Path
p
  where
    filter :: ShortHash -> Set TypeReference -> Set TypeReference
filter ShortHash
sh = (TypeReference -> Bool) -> Set TypeReference -> Set TypeReference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (ShortHash -> Bool)
-> (TypeReference -> ShortHash) -> TypeReference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> ShortHash
Reference.toShortHash)
    types :: Path -> Star TypeReference NameSegment
types Path
p = (Path -> Branch0 m -> Branch0 m
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 Path
p Branch0 m
b) Branch0 m
-> Getting
     (Star TypeReference NameSegment)
     (Branch0 m)
     (Star TypeReference NameSegment)
-> Star TypeReference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star TypeReference NameSegment)
  (Branch0 m)
  (Star TypeReference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star TypeReference NameSegment
 -> f (Star TypeReference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types_

getBranch :: Path.Split Path -> Branch0 m -> Maybe (Branch m)
getBranch :: forall (m :: * -> *). Split Path -> Branch0 m -> Maybe (Branch m)
getBranch (Path
p, NameSegment
seg) Branch0 m
b = case Path -> [NameSegment]
Path.toList Path
p of
  [] -> NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
seg (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children_)
  NameSegment
h : [NameSegment]
p ->
    (Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch m -> Branch0 m) -> Maybe (Branch m) -> Maybe (Branch0 m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameSegment -> Map NameSegment (Branch m) -> Maybe (Branch m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
h (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children_))
      Maybe (Branch0 m)
-> (Branch0 m -> Maybe (Branch m)) -> Maybe (Branch m)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Split Path -> Branch0 m -> Maybe (Branch m)
forall (m :: * -> *). Split Path -> Branch0 m -> Maybe (Branch m)
getBranch ([NameSegment] -> Path
Path.fromList [NameSegment]
p, NameSegment
seg)

makeAddTermName :: Path.Split p -> Referent -> (p, Branch0 m -> Branch0 m)
makeAddTermName :: forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
makeAddTermName (p
p, NameSegment
name) Referent
r = (p
p, Referent -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Referent -> NameSegment -> Branch0 m -> Branch0 m
Branch.addTermName Referent
r NameSegment
name)

makeDeleteTermName :: Path.Split p -> Referent -> (p, Branch0 m -> Branch0 m)
makeDeleteTermName :: forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
makeDeleteTermName (p
p, NameSegment
name) Referent
r = (p
p, Referent -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Referent -> NameSegment -> Branch0 m -> Branch0 m
Branch.deleteTermName Referent
r NameSegment
name)

makeAnnihilateTermName :: Path.Split path -> (path, Branch0 m -> Branch0 m)
makeAnnihilateTermName :: forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
makeAnnihilateTermName (path
p, NameSegment
name) = (path
p, NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
Branch.annihilateTermName NameSegment
name)

makeAnnihilateTypeName :: Path.Split path -> (path, Branch0 m -> Branch0 m)
makeAnnihilateTypeName :: forall path (m :: * -> *).
Split path -> (path, Branch0 m -> Branch0 m)
makeAnnihilateTypeName (path
p, NameSegment
name) = (path
p, NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *). NameSegment -> Branch0 m -> Branch0 m
Branch.annihilateTypeName NameSegment
name)

makeAddTypeName :: Path.Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName :: forall p (m :: * -> *).
Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName (p
p, NameSegment
name) TypeReference
r = (p
p, TypeReference -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
TypeReference -> NameSegment -> Branch0 m -> Branch0 m
Branch.addTypeName TypeReference
r NameSegment
name)

makeDeleteTypeName :: Path.Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
makeDeleteTypeName :: forall p (m :: * -> *).
Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
makeDeleteTypeName (p
p, NameSegment
name) TypeReference
r = (p
p, TypeReference -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
TypeReference -> NameSegment -> Branch0 m -> Branch0 m
Branch.deleteTypeName TypeReference
r NameSegment
name)

makeSetBranch :: Path.Split path -> Branch m -> (path, Branch0 m -> Branch0 m)
makeSetBranch :: forall path (m :: * -> *).
Split path -> Branch m -> (path, Branch0 m -> Branch0 m)
makeSetBranch (path
p, NameSegment
name) Branch m
b = (path
p, NameSegment -> Branch m -> Branch0 m -> Branch0 m
forall (m :: * -> *).
NameSegment -> Branch m -> Branch0 m -> Branch0 m
Branch.setChildBranch NameSegment
name Branch m
b)