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 (HashQualified (HashQualified, NameOnly))
import Unison.NameSegment (NameSegment)
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) = (Path, NameSegment) -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
makeAddTermName (Name -> (Path, NameSegment)
Path.splitFromName Name
n) Referent
r
    doType :: (Name, Reference) -> (Path, Branch0 m -> Branch0 m)
doType (Name
n, Reference
r) = (Path, NameSegment) -> Reference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName (Name -> (Path, NameSegment)
Path.splitFromName Name
n) Reference
r

getTerm :: Path.HQSplit -> Branch0 m -> Set Referent
getTerm :: forall (m :: * -> *). HQSplit -> Branch0 m -> Set Referent
getTerm (Path
p, HQSegment
hq) Branch0 m
b = case HQSegment
hq of
  NameOnly 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
terms
  HashQualified NameSegment
n ShortHash
sh -> ShortHash -> Set Referent -> Set Referent
filter ShortHash
sh (Set Referent -> Set Referent) -> Set Referent -> Set Referent
forall a b. (a -> b) -> a -> b
$ 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
terms
  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 :: Star Referent NameSegment
terms = (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 :: Path.HQSplit -> Branch0 m -> Set Reference.TypeReference
getType :: forall (m :: * -> *). HQSplit -> Branch0 m -> Set Reference
getType (Path
p, HQSegment
hq) Branch0 m
b = case HQSegment
hq of
  NameOnly 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
types
  HashQualified NameSegment
n ShortHash
sh -> ShortHash -> Set Reference -> Set Reference
filter ShortHash
sh (Set Reference -> Set Reference) -> Set Reference -> Set Reference
forall a b. (a -> b) -> a -> b
$ 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
types
  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 :: Star Reference NameSegment
types = (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 -> Branch0 m -> Maybe (Branch m)
getBranch :: forall (m :: * -> *).
(Path, NameSegment) -> 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
>>= (Path, NameSegment) -> Branch0 m -> Maybe (Branch m)
forall (m :: * -> *).
(Path, NameSegment) -> Branch0 m -> Maybe (Branch m)
getBranch ([NameSegment] -> Path
Path.fromList [NameSegment]
p, NameSegment
seg)

makeAddTermName :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
makeAddTermName :: forall p (m :: * -> *).
(p, NameSegment) -> 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 :: (p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
makeDeleteTermName :: forall p (m :: * -> *).
(p, NameSegment) -> 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, Branch0 m -> Branch0 m)
makeAnnihilateTermName :: forall (m :: * -> *).
(Path, NameSegment) -> (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, Branch0 m -> Branch0 m)
makeAnnihilateTypeName :: forall (m :: * -> *).
(Path, NameSegment) -> (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 :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
makeAddTypeName :: forall p (m :: * -> *).
(p, NameSegment) -> 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 :: (p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
makeDeleteTypeName :: forall p (m :: * -> *).
(p, NameSegment) -> 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 -> Branch m -> (Path, Branch0 m -> Branch0 m)
makeSetBranch :: forall (m :: * -> *).
(Path, NameSegment) -> 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)