{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module U.Codebase.Sqlite.Branch.Diff where

import Data.Bifunctor (Bifunctor (bimap))
import Data.List qualified as List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import U.Codebase.Reference (Reference')
import U.Codebase.Referent (Referent')
import U.Codebase.Sqlite.DbId (BranchObjectId, CausalHashId, ObjectId, PatchObjectId, TextId)
import U.Codebase.Sqlite.LocalIds (LocalBranchChildId, LocalDefnId, LocalPatchObjectId, LocalTextId)
import Unison.Util.Map qualified as Map

type LocalDiff = Diff' LocalTextId LocalDefnId LocalPatchObjectId LocalBranchChildId

type Diff = Diff' TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)

data DefinitionOp' r = RemoveDef | AddDefWithMetadata (Set r) | AlterDefMetadata (AddRemove r) deriving (Int -> DefinitionOp' r -> ShowS
[DefinitionOp' r] -> ShowS
DefinitionOp' r -> String
(Int -> DefinitionOp' r -> ShowS)
-> (DefinitionOp' r -> String)
-> ([DefinitionOp' r] -> ShowS)
-> Show (DefinitionOp' r)
forall r. Show r => Int -> DefinitionOp' r -> ShowS
forall r. Show r => [DefinitionOp' r] -> ShowS
forall r. Show r => DefinitionOp' r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall r. Show r => Int -> DefinitionOp' r -> ShowS
showsPrec :: Int -> DefinitionOp' r -> ShowS
$cshow :: forall r. Show r => DefinitionOp' r -> String
show :: DefinitionOp' r -> String
$cshowList :: forall r. Show r => [DefinitionOp' r] -> ShowS
showList :: [DefinitionOp' r] -> ShowS
Show)

data PatchOp' p = PatchRemove | PatchAddReplace p deriving ((forall a b. (a -> b) -> PatchOp' a -> PatchOp' b)
-> (forall a b. a -> PatchOp' b -> PatchOp' a) -> Functor PatchOp'
forall a b. a -> PatchOp' b -> PatchOp' a
forall a b. (a -> b) -> PatchOp' a -> PatchOp' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PatchOp' a -> PatchOp' b
fmap :: forall a b. (a -> b) -> PatchOp' a -> PatchOp' b
$c<$ :: forall a b. a -> PatchOp' b -> PatchOp' a
<$ :: forall a b. a -> PatchOp' b -> PatchOp' a
Functor, Int -> PatchOp' p -> ShowS
[PatchOp' p] -> ShowS
PatchOp' p -> String
(Int -> PatchOp' p -> ShowS)
-> (PatchOp' p -> String)
-> ([PatchOp' p] -> ShowS)
-> Show (PatchOp' p)
forall p. Show p => Int -> PatchOp' p -> ShowS
forall p. Show p => [PatchOp' p] -> ShowS
forall p. Show p => PatchOp' p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Show p => Int -> PatchOp' p -> ShowS
showsPrec :: Int -> PatchOp' p -> ShowS
$cshow :: forall p. Show p => PatchOp' p -> String
show :: PatchOp' p -> String
$cshowList :: forall p. Show p => [PatchOp' p] -> ShowS
showList :: [PatchOp' p] -> ShowS
Show)

data ChildOp' c = ChildRemove | ChildAddReplace c deriving ((forall a b. (a -> b) -> ChildOp' a -> ChildOp' b)
-> (forall a b. a -> ChildOp' b -> ChildOp' a) -> Functor ChildOp'
forall a b. a -> ChildOp' b -> ChildOp' a
forall a b. (a -> b) -> ChildOp' a -> ChildOp' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ChildOp' a -> ChildOp' b
fmap :: forall a b. (a -> b) -> ChildOp' a -> ChildOp' b
$c<$ :: forall a b. a -> ChildOp' b -> ChildOp' a
<$ :: forall a b. a -> ChildOp' b -> ChildOp' a
Functor, Int -> ChildOp' c -> ShowS
[ChildOp' c] -> ShowS
ChildOp' c -> String
(Int -> ChildOp' c -> ShowS)
-> (ChildOp' c -> String)
-> ([ChildOp' c] -> ShowS)
-> Show (ChildOp' c)
forall c. Show c => Int -> ChildOp' c -> ShowS
forall c. Show c => [ChildOp' c] -> ShowS
forall c. Show c => ChildOp' c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> ChildOp' c -> ShowS
showsPrec :: Int -> ChildOp' c -> ShowS
$cshow :: forall c. Show c => ChildOp' c -> String
show :: ChildOp' c -> String
$cshowList :: forall c. Show c => [ChildOp' c] -> ShowS
showList :: [ChildOp' c] -> ShowS
Show)

type AddRemove a = Map a Bool

type LocalDefinitionOp = DefinitionOp' (Metadata LocalTextId LocalDefnId)

type LocalPatchOp = PatchOp' LocalPatchObjectId

type LocalChildOp = ChildOp' LocalBranchChildId

type DefinitionOp = DefinitionOp' (Metadata TextId ObjectId)

type PatchOp = PatchOp' PatchObjectId

type ChildOp = ChildOp' (BranchObjectId, CausalHashId)

addsRemoves :: AddRemove a -> ([a], [a])
addsRemoves :: forall a. AddRemove a -> ([a], [a])
addsRemoves AddRemove a
map = ([a]
adds, [a]
removes)
  where
    (((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Bool) -> a
forall a b. (a, b) -> a
fst -> [a]
adds, ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Bool) -> a
forall a b. (a, b) -> a
fst -> [a]
removes) = ((a, Bool) -> Bool) -> [(a, Bool)] -> ([(a, Bool)], [(a, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (a, Bool) -> Bool
forall a b. (a, b) -> b
snd (AddRemove a -> [(a, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList AddRemove a
map)

type Referent'' t h = Referent' (Reference' t h) (Reference' t h)

data Diff' t h p c = Diff
  { forall t h p c.
Diff' t h p c
-> Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h)))
terms :: Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h))),
    forall t h p c.
Diff' t h p c
-> Map t (Map (Metadata t h) (DefinitionOp' (Metadata t h)))
types :: Map t (Map (Reference' t h) (DefinitionOp' (Metadata t h))),
    forall t h p c. Diff' t h p c -> Map t (PatchOp' p)
patches :: Map t (PatchOp' p),
    forall t h p c. Diff' t h p c -> Map t (ChildOp' c)
children :: Map t (ChildOp' c)
  }
  deriving (Int -> Diff' t h p c -> ShowS
[Diff' t h p c] -> ShowS
Diff' t h p c -> String
(Int -> Diff' t h p c -> ShowS)
-> (Diff' t h p c -> String)
-> ([Diff' t h p c] -> ShowS)
-> Show (Diff' t h p c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t h p c.
(Show t, Show h, Show p, Show c) =>
Int -> Diff' t h p c -> ShowS
forall t h p c.
(Show t, Show h, Show p, Show c) =>
[Diff' t h p c] -> ShowS
forall t h p c.
(Show t, Show h, Show p, Show c) =>
Diff' t h p c -> String
$cshowsPrec :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
Int -> Diff' t h p c -> ShowS
showsPrec :: Int -> Diff' t h p c -> ShowS
$cshow :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
Diff' t h p c -> String
show :: Diff' t h p c -> String
$cshowList :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
[Diff' t h p c] -> ShowS
showList :: [Diff' t h p c] -> ShowS
Show)

type Metadata t h = Reference' t h

quadmap :: (Ord t', Ord h') => (t -> t') -> (h -> h') -> (p -> p') -> (c -> c') -> Diff' t h p c -> Diff' t' h' p' c'
quadmap :: forall t' h' t h p p' c c'.
(Ord t', Ord h') =>
(t -> t')
-> (h -> h')
-> (p -> p')
-> (c -> c')
-> Diff' t h p c
-> Diff' t' h' p' c'
quadmap t -> t'
ft h -> h'
fh p -> p'
fp c -> c'
fc (Diff Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h)))
terms Map t (Map (Metadata t h) (DefinitionOp' (Metadata t h)))
types Map t (PatchOp' p)
patches Map t (ChildOp' c)
children) =
  Map t' (Map (Referent'' t' h') (DefinitionOp' (Reference' t' h')))
-> Map
     t' (Map (Reference' t' h') (DefinitionOp' (Reference' t' h')))
-> Map t' (PatchOp' p')
-> Map t' (ChildOp' c')
-> Diff' t' h' p' c'
forall t h p c.
Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h)))
-> Map t (Map (Metadata t h) (DefinitionOp' (Metadata t h)))
-> Map t (PatchOp' p)
-> Map t (ChildOp' c)
-> Diff' t h p c
Diff
    ((t -> t')
-> (Map (Referent'' t h) (DefinitionOp' (Metadata t h))
    -> Map (Referent'' t' h') (DefinitionOp' (Reference' t' h')))
-> Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h)))
-> Map
     t' (Map (Referent'' t' h') (DefinitionOp' (Reference' t' h')))
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap t -> t'
ft ((Referent'' t h -> Referent'' t' h')
-> (DefinitionOp' (Metadata t h)
    -> DefinitionOp' (Reference' t' h'))
-> Map (Referent'' t h) (DefinitionOp' (Metadata t h))
-> Map (Referent'' t' h') (DefinitionOp' (Reference' t' h'))
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap Referent'' t h -> Referent'' t' h'
doReferent DefinitionOp' (Metadata t h) -> DefinitionOp' (Reference' t' h')
doDefnOp) Map t (Map (Referent'' t h) (DefinitionOp' (Metadata t h)))
terms)
    ((t -> t')
-> (Map (Metadata t h) (DefinitionOp' (Metadata t h))
    -> Map (Reference' t' h') (DefinitionOp' (Reference' t' h')))
-> Map t (Map (Metadata t h) (DefinitionOp' (Metadata t h)))
-> Map
     t' (Map (Reference' t' h') (DefinitionOp' (Reference' t' h')))
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap t -> t'
ft ((Metadata t h -> Reference' t' h')
-> (DefinitionOp' (Metadata t h)
    -> DefinitionOp' (Reference' t' h'))
-> Map (Metadata t h) (DefinitionOp' (Metadata t h))
-> Map (Reference' t' h') (DefinitionOp' (Reference' t' h'))
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap Metadata t h -> Reference' t' h'
doReference DefinitionOp' (Metadata t h) -> DefinitionOp' (Reference' t' h')
doDefnOp) Map t (Map (Metadata t h) (DefinitionOp' (Metadata t h)))
types)
    ((t -> t')
-> (PatchOp' p -> PatchOp' p')
-> Map t (PatchOp' p)
-> Map t' (PatchOp' p')
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap t -> t'
ft PatchOp' p -> PatchOp' p'
doPatchOp Map t (PatchOp' p)
patches)
    ((t -> t')
-> (ChildOp' c -> ChildOp' c')
-> Map t (ChildOp' c)
-> Map t' (ChildOp' c')
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap t -> t'
ft ChildOp' c -> ChildOp' c'
doChildOp Map t (ChildOp' c)
children)
  where
    doReferent :: Referent'' t h -> Referent'' t' h'
doReferent = (Metadata t h -> Reference' t' h')
-> (Metadata t h -> Reference' t' h')
-> Referent'' t h
-> Referent'' t' h'
forall a b c d.
(a -> b) -> (c -> d) -> Referent' a c -> Referent' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Metadata t h -> Reference' t' h'
doReference Metadata t h -> Reference' t' h'
doReference
    doReference :: Metadata t h -> Reference' t' h'
doReference = (t -> t') -> (h -> h') -> Metadata t h -> Reference' t' h'
forall a b c d.
(a -> b) -> (c -> d) -> Reference' a c -> Reference' b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap t -> t'
ft h -> h'
fh
    doDefnOp :: DefinitionOp' (Metadata t h) -> DefinitionOp' (Reference' t' h')
doDefnOp = \case
      DefinitionOp' (Metadata t h)
RemoveDef -> DefinitionOp' (Reference' t' h')
forall r. DefinitionOp' r
RemoveDef
      AddDefWithMetadata Set (Metadata t h)
rs -> Set (Reference' t' h') -> DefinitionOp' (Reference' t' h')
forall r. Set r -> DefinitionOp' r
AddDefWithMetadata ((Metadata t h -> Reference' t' h')
-> Set (Metadata t h) -> Set (Reference' t' h')
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Metadata t h -> Reference' t' h'
doReference Set (Metadata t h)
rs)
      AlterDefMetadata AddRemove (Metadata t h)
ar -> AddRemove (Reference' t' h') -> DefinitionOp' (Reference' t' h')
forall r. AddRemove r -> DefinitionOp' r
AlterDefMetadata ((Metadata t h -> Reference' t' h')
-> AddRemove (Metadata t h) -> AddRemove (Reference' t' h')
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Metadata t h -> Reference' t' h'
doReference AddRemove (Metadata t h)
ar)
    doPatchOp :: PatchOp' p -> PatchOp' p'
doPatchOp = (p -> p') -> PatchOp' p -> PatchOp' p'
forall a b. (a -> b) -> PatchOp' a -> PatchOp' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p -> p'
fp
    doChildOp :: ChildOp' c -> ChildOp' c'
doChildOp = (c -> c') -> ChildOp' c -> ChildOp' c'
forall a b. (a -> b) -> ChildOp' a -> ChildOp' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> c'
fc