module Unison.Codebase.Branch.BranchDiff where

import Control.Lens
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Map.Merge.Lazy qualified as MapMerge
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch qualified as Patch
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,
    BranchDiff -> Map NameSegment PatchDiff
changedPatches :: Map NameSegment Patch.PatchDiff
  }
  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 :: (Monad m) => Branch0 m -> Branch0 m -> m BranchDiff
diff0 :: forall (m :: * -> *).
Monad m =>
Branch0 m -> Branch0 m -> m BranchDiff
diff0 Branch0 m
old Branch0 m
new = do
  Map NameSegment Patch
newEdits <- Map NameSegment (m Patch) -> m (Map NameSegment Patch)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map NameSegment (f a) -> f (Map NameSegment a)
sequenceA (Map NameSegment (m Patch) -> m (Map NameSegment Patch))
-> Map NameSegment (m Patch) -> m (Map NameSegment Patch)
forall a b. (a -> b) -> a -> b
$ (PatchHash, m Patch) -> m Patch
forall a b. (a, b) -> b
snd ((PatchHash, m Patch) -> m Patch)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (m Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch0 m
new Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Branch.edits
  Map NameSegment Patch
oldEdits <- Map NameSegment (m Patch) -> m (Map NameSegment Patch)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map NameSegment (f a) -> f (Map NameSegment a)
sequenceA (Map NameSegment (m Patch) -> m (Map NameSegment Patch))
-> Map NameSegment (m Patch) -> m (Map NameSegment Patch)
forall a b. (a -> b) -> a -> b
$ (PatchHash, m Patch) -> m Patch
forall a b. (a, b) -> b
snd ((PatchHash, m Patch) -> m Patch)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (m Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Branch0 m
old Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Branch.edits
  let diffEdits :: Map NameSegment PatchDiff
diffEdits =
        SimpleWhenMissing NameSegment Patch PatchDiff
-> SimpleWhenMissing NameSegment Patch PatchDiff
-> SimpleWhenMatched NameSegment Patch Patch PatchDiff
-> Map NameSegment Patch
-> Map NameSegment Patch
-> Map NameSegment PatchDiff
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
MapMerge.merge
          ((NameSegment -> Patch -> PatchDiff)
-> SimpleWhenMissing NameSegment Patch PatchDiff
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
MapMerge.mapMissing ((NameSegment -> Patch -> PatchDiff)
 -> SimpleWhenMissing NameSegment Patch PatchDiff)
-> (NameSegment -> Patch -> PatchDiff)
-> SimpleWhenMissing NameSegment Patch PatchDiff
forall a b. (a -> b) -> a -> b
$ \NameSegment
_ Patch
p -> Patch -> Patch -> PatchDiff
Patch.diff Patch
p Patch
forall a. Monoid a => a
mempty)
          ((NameSegment -> Patch -> PatchDiff)
-> SimpleWhenMissing NameSegment Patch PatchDiff
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
MapMerge.mapMissing ((NameSegment -> Patch -> PatchDiff)
 -> SimpleWhenMissing NameSegment Patch PatchDiff)
-> (NameSegment -> Patch -> PatchDiff)
-> SimpleWhenMissing NameSegment Patch PatchDiff
forall a b. (a -> b) -> a -> b
$ \NameSegment
_ Patch
p -> Patch -> Patch -> PatchDiff
Patch.diff Patch
forall a. Monoid a => a
mempty Patch
p)
          ((NameSegment -> Patch -> Patch -> PatchDiff)
-> SimpleWhenMatched NameSegment Patch Patch PatchDiff
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
MapMerge.zipWithMatched ((Patch -> Patch -> PatchDiff)
-> NameSegment -> Patch -> Patch -> PatchDiff
forall a b. a -> b -> a
const Patch -> Patch -> PatchDiff
Patch.diff))
          Map NameSegment Patch
newEdits
          Map NameSegment Patch
oldEdits
  BranchDiff -> m BranchDiff
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchDiff -> m BranchDiff) -> BranchDiff -> m BranchDiff
forall a b. (a -> b) -> a -> b
$
    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),
        $sel:changedPatches:BranchDiff :: Map NameSegment PatchDiff
changedPatches = Map NameSegment PatchDiff
diffEdits
      }

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,
        $sel:changedPatches:BranchDiff :: Map NameSegment PatchDiff
changedPatches =
          (PatchDiff -> PatchDiff -> PatchDiff)
-> Map NameSegment PatchDiff
-> Map NameSegment PatchDiff
-> Map NameSegment PatchDiff
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith PatchDiff -> PatchDiff -> PatchDiff
forall a. Semigroup a => a -> a -> a
(<>) (BranchDiff -> Map NameSegment PatchDiff
changedPatches BranchDiff
left) (BranchDiff -> Map NameSegment PatchDiff
changedPatches BranchDiff
right)
      }

instance Monoid BranchDiff where
  mempty :: BranchDiff
mempty = Star Referent NameSegment
-> Star Referent NameSegment
-> Star Reference NameSegment
-> Star Reference NameSegment
-> Map NameSegment PatchDiff
-> 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 Map NameSegment PatchDiff
forall a. Monoid a => a
mempty