module U.Codebase.Sqlite.Patch.Format
  ( PatchFormat (..),
    PatchLocalIds,
    PatchLocalIds' (..),
    HashPatchLocalIds,
    SyncPatchFormat,
    SyncPatchFormat' (..),
    applyPatchDiffs,
    localPatchToPatch,
    localPatchToPatch',
    localPatchDiffToPatchDiff,
    localPatchToHashPatch,
  )
where

import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import U.Codebase.HashTags
import U.Codebase.Sqlite.DbId (HashId, ObjectId, PatchObjectId, TextId)
import U.Codebase.Sqlite.LocalIds (LocalDefnId (LocalDefnId), LocalHashId (LocalHashId), LocalTextId (LocalTextId))
import U.Codebase.Sqlite.Patch.Diff (LocalPatchDiff, PatchDiff, PatchDiff' (..))
import U.Codebase.Sqlite.Patch.Diff qualified as Patch.Diff
import U.Codebase.Sqlite.Patch.Full (HashPatch, LocalPatch, Patch, Patch' (..))
import U.Codebase.Sqlite.Patch.Full qualified as Patch.Full
import Unison.Prelude

data PatchFormat
  = Full PatchLocalIds LocalPatch
  | Diff PatchObjectId PatchLocalIds LocalPatchDiff

type PatchLocalIds = PatchLocalIds' TextId HashId ObjectId

-- | LocalIds type which can be used in hashing the Patch.
type HashPatchLocalIds = PatchLocalIds' Text ComponentHash ComponentHash

data PatchLocalIds' t h d = LocalIds
  { forall t h d. PatchLocalIds' t h d -> Vector t
patchTextLookup :: Vector t,
    forall t h d. PatchLocalIds' t h d -> Vector h
patchHashLookup :: Vector h,
    forall t h d. PatchLocalIds' t h d -> Vector d
patchDefnLookup :: Vector d
  }

type SyncPatchFormat = SyncPatchFormat' PatchObjectId TextId HashId ObjectId

data SyncPatchFormat' parent text hash defn
  = SyncFull (PatchLocalIds' text hash defn) ByteString
  | -- | p is the identity of the thing that the diff is relative to
    SyncDiff parent (PatchLocalIds' text hash defn) ByteString

-- | Apply a list of patch diffs to a patch, left to right.
applyPatchDiffs :: Patch -> [PatchDiff] -> Patch
applyPatchDiffs :: Patch -> [PatchDiff] -> Patch
applyPatchDiffs =
  (Patch -> PatchDiff -> Patch) -> Patch -> [PatchDiff] -> Patch
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Patch -> PatchDiff -> Patch
apply
  where
    apply :: Patch -> PatchDiff -> Patch
    apply :: Patch -> PatchDiff -> Patch
apply (Patch Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits) (PatchDiff Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
addedTermEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
addedTypeEdits Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
removedTermEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
removedTypeEdits) =
      let !termEdits' :: Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits' = Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
-> Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
-> Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
-> Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
forall a b.
(Ord a, Ord b) =>
Map a (Set b) -> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
addRemove Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
addedTermEdits Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
removedTermEdits Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits
          !typeEdits' :: Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits' = Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
-> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
-> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
-> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
forall a b.
(Ord a, Ord b) =>
Map a (Set b) -> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
addRemove Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
addedTypeEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
removedTypeEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits
       in Patch
            { $sel:termEdits:Patch :: Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits = Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits',
              $sel:typeEdits:Patch :: Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits = Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits'
            }

    addRemove :: (Ord a, Ord b) => Map a (Set b) -> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
    addRemove :: forall a b.
(Ord a, Ord b) =>
Map a (Set b) -> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
addRemove Map a (Set b)
add Map a (Set b)
del Map a (Set b)
src =
      (Set b -> Set b -> Set b)
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set b -> Set b -> Set b
forall a. Semigroup a => a -> a -> a
(<>) Map a (Set b)
add ((Set b -> Set b -> Maybe (Set b))
-> Map a (Set b) -> Map a (Set b) -> Map a (Set b)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith Set b -> Set b -> Maybe (Set b)
forall b. Ord b => Set b -> Set b -> Maybe (Set b)
remove Map a (Set b)
src Map a (Set b)
del)

    remove :: (Ord b) => Set b -> Set b -> Maybe (Set b)
    remove :: forall b. Ord b => Set b -> Set b -> Maybe (Set b)
remove Set b
src Set b
del =
      let diff :: Set b
diff = Set b -> Set b -> Set b
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set b
src Set b
del
       in if Set b -> Bool
forall a. Set a -> Bool
Set.null Set b
diff then Maybe (Set b)
forall a. Maybe a
Nothing else Set b -> Maybe (Set b)
forall a. a -> Maybe a
Just Set b
diff

localToPatch' :: (Ord t, Ord h, Ord d) => PatchLocalIds' t h d -> (Patch' LocalTextId LocalHashId LocalDefnId) -> Patch' t h d
localToPatch' :: forall t h d.
(Ord t, Ord h, Ord d) =>
PatchLocalIds' t h d
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch' t h d
localToPatch' PatchLocalIds' t h d
li =
  (LocalTextId -> t)
-> (LocalHashId -> h)
-> (LocalDefnId -> d)
-> Patch' LocalTextId LocalHashId LocalDefnId
-> Patch' t h d
forall t' h' o' t h o.
(Ord t', Ord h', Ord o') =>
(t -> t')
-> (h -> h') -> (o -> o') -> Patch' t h o -> Patch' t' h' o'
Patch.Full.trimap (PatchLocalIds' t h d -> LocalTextId -> t
forall t h d. PatchLocalIds' t h d -> LocalTextId -> t
lookupPatchLocalText PatchLocalIds' t h d
li) (PatchLocalIds' t h d -> LocalHashId -> h
forall t h d. PatchLocalIds' t h d -> LocalHashId -> h
lookupPatchLocalHash PatchLocalIds' t h d
li) (PatchLocalIds' t h d -> LocalDefnId -> d
forall t h d. PatchLocalIds' t h d -> LocalDefnId -> d
lookupPatchLocalDefn PatchLocalIds' t h d
li)

-- | Generic version of `localPatchToPatch` that works with any `PatchLocalIds'`.
localPatchToPatch' ::
  (Ord t, Ord h, Ord d) =>
  PatchLocalIds' t h d ->
  Patch' LocalTextId LocalHashId LocalDefnId ->
  Patch' t h d
localPatchToPatch' :: forall t h d.
(Ord t, Ord h, Ord d) =>
PatchLocalIds' t h d
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch' t h d
localPatchToPatch' PatchLocalIds' t h d
li =
  (LocalTextId -> t)
-> (LocalHashId -> h)
-> (LocalDefnId -> d)
-> Patch' LocalTextId LocalHashId LocalDefnId
-> Patch' t h d
forall t' h' o' t h o.
(Ord t', Ord h', Ord o') =>
(t -> t')
-> (h -> h') -> (o -> o') -> Patch' t h o -> Patch' t' h' o'
Patch.Full.trimap (PatchLocalIds' t h d -> LocalTextId -> t
forall t h d. PatchLocalIds' t h d -> LocalTextId -> t
lookupPatchLocalText PatchLocalIds' t h d
li) (PatchLocalIds' t h d -> LocalHashId -> h
forall t h d. PatchLocalIds' t h d -> LocalHashId -> h
lookupPatchLocalHash PatchLocalIds' t h d
li) (PatchLocalIds' t h d -> LocalDefnId -> d
forall t h d. PatchLocalIds' t h d -> LocalDefnId -> d
lookupPatchLocalDefn PatchLocalIds' t h d
li)

-- | Type specialized version of `localToPatch'`.
localPatchToPatch :: PatchLocalIds -> LocalPatch -> Patch
localPatchToPatch :: PatchLocalIds
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch
localPatchToPatch = PatchLocalIds
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch
forall t h d.
(Ord t, Ord h, Ord d) =>
PatchLocalIds' t h d
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch' t h d
localToPatch'

localPatchToHashPatch :: HashPatchLocalIds -> LocalPatch -> HashPatch
localPatchToHashPatch :: HashPatchLocalIds
-> Patch' LocalTextId LocalHashId LocalDefnId -> HashPatch
localPatchToHashPatch = HashPatchLocalIds
-> Patch' LocalTextId LocalHashId LocalDefnId -> HashPatch
forall t h d.
(Ord t, Ord h, Ord d) =>
PatchLocalIds' t h d
-> Patch' LocalTextId LocalHashId LocalDefnId -> Patch' t h d
localToPatch'

localPatchDiffToPatchDiff :: PatchLocalIds -> LocalPatchDiff -> PatchDiff
localPatchDiffToPatchDiff :: PatchLocalIds -> LocalPatchDiff -> PatchDiff
localPatchDiffToPatchDiff PatchLocalIds
li =
  (LocalTextId -> TextId)
-> (LocalHashId -> HashId)
-> (LocalDefnId -> ObjectId)
-> LocalPatchDiff
-> PatchDiff
forall t' h' d' t h d.
(Ord t', Ord h', Ord d') =>
(t -> t')
-> (h -> h')
-> (d -> d')
-> PatchDiff' t h d
-> PatchDiff' t' h' d'
Patch.Diff.trimap
    (PatchLocalIds -> LocalTextId -> TextId
forall t h d. PatchLocalIds' t h d -> LocalTextId -> t
lookupPatchLocalText PatchLocalIds
li)
    (PatchLocalIds -> LocalHashId -> HashId
forall t h d. PatchLocalIds' t h d -> LocalHashId -> h
lookupPatchLocalHash PatchLocalIds
li)
    (PatchLocalIds -> LocalDefnId -> ObjectId
forall t h d. PatchLocalIds' t h d -> LocalDefnId -> d
lookupPatchLocalDefn PatchLocalIds
li)

lookupPatchLocalText :: PatchLocalIds' t h d -> LocalTextId -> t
lookupPatchLocalText :: forall t h d. PatchLocalIds' t h d -> LocalTextId -> t
lookupPatchLocalText PatchLocalIds' t h d
li (LocalTextId Word64
w) = PatchLocalIds' t h d -> Vector t
forall t h d. PatchLocalIds' t h d -> Vector t
patchTextLookup PatchLocalIds' t h d
li Vector t -> Int -> t
forall a. Vector a -> Int -> a
Vector.! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w

lookupPatchLocalHash :: PatchLocalIds' t h d -> LocalHashId -> h
lookupPatchLocalHash :: forall t h d. PatchLocalIds' t h d -> LocalHashId -> h
lookupPatchLocalHash PatchLocalIds' t h d
li (LocalHashId Word64
w) = PatchLocalIds' t h d -> Vector h
forall t h d. PatchLocalIds' t h d -> Vector h
patchHashLookup PatchLocalIds' t h d
li Vector h -> Int -> h
forall a. Vector a -> Int -> a
Vector.! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w

lookupPatchLocalDefn :: PatchLocalIds' t h d -> LocalDefnId -> d
lookupPatchLocalDefn :: forall t h d. PatchLocalIds' t h d -> LocalDefnId -> d
lookupPatchLocalDefn PatchLocalIds' t h d
li (LocalDefnId Word64
w) = PatchLocalIds' t h d -> Vector d
forall t h d. PatchLocalIds' t h d -> Vector d
patchDefnLookup PatchLocalIds' t h d
li Vector d -> Int -> d
forall a. Vector a -> Int -> a
Vector.! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w