module Unison.Codebase.Branch.BranchDiff
  ( BranchDiff (..),
    diff0,
  )
where

import Control.Lens
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Metadata qualified as Metadata
import Unison.NameSegment (NameSegment)
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Util.Star2 qualified as Star2

type Star r n = Metadata.Star r n

-- Represents a shallow diff of a Branch0.
-- Each of these `Star`s contain metadata as well, so an entry in
-- `added` or `removed` could be an update to the metadata.
data BranchDiff = BranchDiff
  { BranchDiff -> Star Referent NameSegment
addedTerms :: Star Referent NameSegment,
    BranchDiff -> Star Referent NameSegment
removedTerms :: Star Referent NameSegment,
    BranchDiff -> Star Reference NameSegment
addedTypes :: Star Reference NameSegment,
    BranchDiff -> Star Reference NameSegment
removedTypes :: Star Reference NameSegment
  }
  deriving (BranchDiff -> BranchDiff -> Bool
(BranchDiff -> BranchDiff -> Bool)
-> (BranchDiff -> BranchDiff -> Bool) -> Eq BranchDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchDiff -> BranchDiff -> Bool
== :: BranchDiff -> BranchDiff -> Bool
$c/= :: BranchDiff -> BranchDiff -> Bool
/= :: BranchDiff -> BranchDiff -> Bool
Eq, Eq BranchDiff
Eq BranchDiff =>
(BranchDiff -> BranchDiff -> Ordering)
-> (BranchDiff -> BranchDiff -> Bool)
-> (BranchDiff -> BranchDiff -> Bool)
-> (BranchDiff -> BranchDiff -> Bool)
-> (BranchDiff -> BranchDiff -> Bool)
-> (BranchDiff -> BranchDiff -> BranchDiff)
-> (BranchDiff -> BranchDiff -> BranchDiff)
-> Ord BranchDiff
BranchDiff -> BranchDiff -> Bool
BranchDiff -> BranchDiff -> Ordering
BranchDiff -> BranchDiff -> BranchDiff
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 :: BranchDiff -> BranchDiff -> Ordering
compare :: BranchDiff -> BranchDiff -> Ordering
$c< :: BranchDiff -> BranchDiff -> Bool
< :: BranchDiff -> BranchDiff -> Bool
$c<= :: BranchDiff -> BranchDiff -> Bool
<= :: BranchDiff -> BranchDiff -> Bool
$c> :: BranchDiff -> BranchDiff -> Bool
> :: BranchDiff -> BranchDiff -> Bool
$c>= :: BranchDiff -> BranchDiff -> Bool
>= :: BranchDiff -> BranchDiff -> Bool
$cmax :: BranchDiff -> BranchDiff -> BranchDiff
max :: BranchDiff -> BranchDiff -> BranchDiff
$cmin :: BranchDiff -> BranchDiff -> BranchDiff
min :: BranchDiff -> BranchDiff -> BranchDiff
Ord, Int -> BranchDiff -> ShowS
[BranchDiff] -> ShowS
BranchDiff -> String
(Int -> BranchDiff -> ShowS)
-> (BranchDiff -> String)
-> ([BranchDiff] -> ShowS)
-> Show BranchDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchDiff -> ShowS
showsPrec :: Int -> BranchDiff -> ShowS
$cshow :: BranchDiff -> String
show :: BranchDiff -> String
$cshowList :: [BranchDiff] -> ShowS
showList :: [BranchDiff] -> ShowS
Show)

diff0 :: Branch0 m -> Branch0 m -> BranchDiff
diff0 :: forall (m :: * -> *). Branch0 m -> Branch0 m -> BranchDiff
diff0 Branch0 m
old Branch0 m
new = do
  BranchDiff
    { $sel:addedTerms:BranchDiff :: Star Referent NameSegment
addedTerms = Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
new 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_) (Branch0 m
old 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_),
      $sel:removedTerms:BranchDiff :: Star Referent NameSegment
removedTerms = Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
old 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_) (Branch0 m
new 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_),
      $sel:addedTypes:BranchDiff :: Star Reference NameSegment
addedTypes = Star Reference NameSegment
-> Star Reference NameSegment -> Star Reference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
new 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_) (Branch0 m
old 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_),
      $sel:removedTypes:BranchDiff :: Star Reference NameSegment
removedTypes = Star Reference NameSegment
-> Star Reference NameSegment -> Star Reference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Star2 fact d1 d2 -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.difference (Branch0 m
old 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_) (Branch0 m
new 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_)
    }

instance Semigroup BranchDiff where
  BranchDiff
left <> :: BranchDiff -> BranchDiff -> BranchDiff
<> BranchDiff
right =
    BranchDiff
      { $sel:addedTerms:BranchDiff :: Star Referent NameSegment
addedTerms = BranchDiff -> Star Referent NameSegment
addedTerms BranchDiff
left Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall a. Semigroup a => a -> a -> a
<> BranchDiff -> Star Referent NameSegment
addedTerms BranchDiff
right,
        $sel:removedTerms:BranchDiff :: Star Referent NameSegment
removedTerms = BranchDiff -> Star Referent NameSegment
removedTerms BranchDiff
left Star Referent NameSegment
-> Star Referent NameSegment -> Star Referent NameSegment
forall a. Semigroup a => a -> a -> a
<> BranchDiff -> Star Referent NameSegment
removedTerms BranchDiff
right,
        $sel:addedTypes:BranchDiff :: Star Reference NameSegment
addedTypes = BranchDiff -> Star Reference NameSegment
addedTypes BranchDiff
left Star Reference NameSegment
-> Star Reference NameSegment -> Star Reference NameSegment
forall a. Semigroup a => a -> a -> a
<> BranchDiff -> Star Reference NameSegment
addedTypes BranchDiff
right,
        $sel:removedTypes:BranchDiff :: Star Reference NameSegment
removedTypes = BranchDiff -> Star Reference NameSegment
removedTypes BranchDiff
left Star Reference NameSegment
-> Star Reference NameSegment -> Star Reference NameSegment
forall a. Semigroup a => a -> a -> a
<> BranchDiff -> Star Reference NameSegment
removedTypes BranchDiff
right
      }

instance Monoid BranchDiff where
  mempty :: BranchDiff
mempty = Star Referent NameSegment
-> Star Referent NameSegment
-> Star Reference NameSegment
-> Star Reference NameSegment
-> BranchDiff
BranchDiff Star Referent NameSegment
forall a. Monoid a => a
mempty Star Referent NameSegment
forall a. Monoid a => a
mempty Star Reference NameSegment
forall a. Monoid a => a
mempty Star Reference NameSegment
forall a. Monoid a => a
mempty