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 (Reference)
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, Reference) -> (Path, Branch0 m -> Branch0 m))
-> [(Name, Reference)] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Reference) -> (Path, Branch0 m -> Branch0 m)
forall {m :: * -> *}.
(Name, Reference) -> (Path, Branch0 m -> Branch0 m)
doType ([(Name, Reference)] -> [(Path, Branch0 m -> Branch0 m)])
-> (Relation Name Reference -> [(Name, Reference)])
-> Relation Name Reference
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Name Reference -> [(Name, Reference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Reference -> [(Path, Branch0 m -> Branch0 m)])
-> Relation Name Reference -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ Names -> Relation Name Reference
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, Reference) -> (Path, Branch0 m -> Branch0 m)
doType (Name
n, Reference
r) = Split Path -> Reference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Reference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName (Name -> Split Path
Path.splitFromName Name
n) Reference
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 Reference
getType HashQualified (Split Path)
hq Branch0 m
b = case HashQualified (Split Path)
hq of
  HQ'.NameOnly (Path
p, NameSegment
n) -> NameSegment -> Star Reference NameSegment -> Set Reference
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star Reference NameSegment -> Set Reference)
-> Star Reference NameSegment -> Set Reference
forall a b. (a -> b) -> a -> b
$ Path -> Star Reference NameSegment
types Path
p
  HQ'.HashQualified (Path
p, NameSegment
n) ShortHash
sh -> ShortHash -> Set Reference -> Set Reference
filter ShortHash
sh (Set Reference -> Set Reference)
-> (Star Reference NameSegment -> Set Reference)
-> Star Reference NameSegment
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Star Reference NameSegment -> Set Reference
forall fact d1 d2.
(Ord fact, Ord d1) =>
d1 -> Star2 fact d1 d2 -> Set fact
Star2.lookupD1 NameSegment
n (Star Reference NameSegment -> Set Reference)
-> Star Reference NameSegment -> Set Reference
forall a b. (a -> b) -> a -> b
$ Path -> Star Reference NameSegment
types Path
p
  where
    filter :: ShortHash -> Set Reference -> Set Reference
filter ShortHash
sh = (Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (ShortHash -> ShortHash -> Bool
SH.isPrefixOf ShortHash
sh (ShortHash -> Bool)
-> (Reference -> ShortHash) -> Reference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ShortHash
Reference.toShortHash)
    types :: Path -> Star Reference 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 Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference 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 -> Reference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName :: forall p (m :: * -> *).
Split p -> Reference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName (p
p, NameSegment
name) Reference
r = (p
p, Reference -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Reference -> NameSegment -> Branch0 m -> Branch0 m
Branch.addTypeName Reference
r NameSegment
name)

makeDeleteTypeName :: Path.Split p -> Reference -> (p, Branch0 m -> Branch0 m)
makeDeleteTypeName :: forall p (m :: * -> *).
Split p -> Reference -> (p, Branch0 m -> Branch0 m)
makeDeleteTypeName (p
p, NameSegment
name) Reference
r = (p
p, Reference -> NameSegment -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Reference -> NameSegment -> Branch0 m -> Branch0 m
Branch.deleteTypeName Reference
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)