-- | Combinators or utilities shared by sync server AND client
module Unison.Sync.Common
  ( expectEntity,

    -- * Type conversions
    causalHashToHash32,
    hash32ToCausalHash,
    entityToTempEntity,
    tempEntityToEntity,
  )
where

import Control.Lens qualified as Lens
import Data.Set qualified as Set
import Data.Vector qualified as Vector
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Sqlite.Branch.Format qualified as NamespaceFormat
import U.Codebase.Sqlite.Causal qualified as Causal
import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat
import U.Codebase.Sqlite.Entity qualified as Entity
import U.Codebase.Sqlite.LocalIds
import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.TempEntity (TempEntity)
import U.Codebase.Sqlite.TempEntity qualified as Sqlite
import U.Codebase.Sqlite.TempEntity qualified as TempEntity
import U.Codebase.Sqlite.Term.Format qualified as TermFormat
import Unison.Hash32 (Hash32)
import Unison.Hash32 qualified as Hash32
import Unison.Prelude
import Unison.Sqlite qualified as Sqlite
import Unison.Sync.Types qualified as Share

-- | Read an entity out of the database that we know is in main storage.
expectEntity :: Hash32 -> Sqlite.Transaction (Share.Entity Text Hash32 Hash32)
expectEntity :: Hash32 -> Transaction (Entity Text Hash32 Hash32)
expectEntity Hash32
hash = do
  SyncEntity
syncEntity <- Hash32 -> Transaction SyncEntity
Q.expectEntity Hash32
hash
  TempEntity
tempEntity <- SyncEntity -> Transaction TempEntity
Q.syncToTempEntity SyncEntity
syncEntity
  Entity Text Hash32 Hash32
-> Transaction (Entity Text Hash32 Hash32)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Entity Text Hash32 Hash32
tempEntityToEntity TempEntity
tempEntity)

-- FIXME this isn't the right module  for this conversion
causalHashToHash32 :: CausalHash -> Hash32
causalHashToHash32 :: CausalHash -> Hash32
causalHashToHash32 =
  Hash -> Hash32
Hash32.fromHash (Hash -> Hash32) -> (CausalHash -> Hash) -> CausalHash -> Hash32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash

-- FIXME this isn't the right module  for this conversion
hash32ToCausalHash :: Hash32 -> CausalHash
hash32ToCausalHash :: Hash32 -> CausalHash
hash32ToCausalHash =
  Hash -> CausalHash
CausalHash (Hash -> CausalHash) -> (Hash32 -> Hash) -> Hash32 -> CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Hash
Hash32.toHash

-- | Convert an entity that came over the wire from Unison Share into an equivalent type that we can store in the
-- `temp_entity` table.
entityToTempEntity :: forall hash. (hash -> Hash32) -> Share.Entity Text Hash32 hash -> TempEntity
entityToTempEntity :: forall hash.
(hash -> Hash32) -> Entity Text Hash32 hash -> TempEntity
entityToTempEntity hash -> Hash32
toHash32 = \case
  Share.TC (Share.TermComponent [(LocalIds Text hash, ByteString)]
terms) ->
    [(LocalIds Text hash, ByteString)]
terms
      [(LocalIds Text hash, ByteString)]
-> ([(LocalIds Text hash, ByteString)]
    -> Vector (LocalIds Text hash, ByteString))
-> Vector (LocalIds Text hash, ByteString)
forall a b. a -> (a -> b) -> b
& [(LocalIds Text hash, ByteString)]
-> Vector (LocalIds Text hash, ByteString)
forall a. [a] -> Vector a
Vector.fromList
      Vector (LocalIds Text hash, ByteString)
-> (Vector (LocalIds Text hash, ByteString)
    -> Vector (LocalIds' Text Hash32, ByteString))
-> Vector (LocalIds' Text Hash32, ByteString)
forall a b. a -> (a -> b) -> b
& ((LocalIds Text hash, ByteString)
 -> (LocalIds' Text Hash32, ByteString))
-> Vector (LocalIds Text hash, ByteString)
-> Vector (LocalIds' Text Hash32, ByteString)
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (ASetter
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
-> (LocalIds Text hash -> LocalIds' Text Hash32)
-> (LocalIds Text hash, ByteString)
-> (LocalIds' Text Hash32, ByteString)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
Lens._1 LocalIds Text hash -> LocalIds' Text Hash32
mungeLocalIds)
      Vector (LocalIds' Text Hash32, ByteString)
-> (Vector (LocalIds' Text Hash32, ByteString)
    -> SyncLocallyIndexedComponent' Text Hash32)
-> SyncLocallyIndexedComponent' Text Hash32
forall a b. a -> (a -> b) -> b
& Vector (LocalIds' Text Hash32, ByteString)
-> SyncLocallyIndexedComponent' Text Hash32
forall t d.
Vector (LocalIds' t d, ByteString)
-> SyncLocallyIndexedComponent' t d
TermFormat.SyncLocallyIndexedComponent
      SyncLocallyIndexedComponent' Text Hash32
-> (SyncLocallyIndexedComponent' Text Hash32
    -> SyncTermFormat' Text Hash32)
-> SyncTermFormat' Text Hash32
forall a b. a -> (a -> b) -> b
& SyncLocallyIndexedComponent' Text Hash32
-> SyncTermFormat' Text Hash32
forall t d. SyncLocallyIndexedComponent' t d -> SyncTermFormat' t d
TermFormat.SyncTerm
      SyncTermFormat' Text Hash32
-> (SyncTermFormat' Text Hash32 -> TempEntity) -> TempEntity
forall a b. a -> (a -> b) -> b
& SyncTermFormat' Text Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncTermFormat' text defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.TC
  Share.DC (Share.DeclComponent [(LocalIds Text hash, ByteString)]
decls) ->
    [(LocalIds Text hash, ByteString)]
decls
      [(LocalIds Text hash, ByteString)]
-> ([(LocalIds Text hash, ByteString)]
    -> Vector (LocalIds Text hash, ByteString))
-> Vector (LocalIds Text hash, ByteString)
forall a b. a -> (a -> b) -> b
& [(LocalIds Text hash, ByteString)]
-> Vector (LocalIds Text hash, ByteString)
forall a. [a] -> Vector a
Vector.fromList
      Vector (LocalIds Text hash, ByteString)
-> (Vector (LocalIds Text hash, ByteString)
    -> Vector (LocalIds' Text Hash32, ByteString))
-> Vector (LocalIds' Text Hash32, ByteString)
forall a b. a -> (a -> b) -> b
& ((LocalIds Text hash, ByteString)
 -> (LocalIds' Text Hash32, ByteString))
-> Vector (LocalIds Text hash, ByteString)
-> Vector (LocalIds' Text Hash32, ByteString)
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (ASetter
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
-> (LocalIds Text hash -> LocalIds' Text Hash32)
-> (LocalIds Text hash, ByteString)
-> (LocalIds' Text Hash32, ByteString)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (LocalIds Text hash, ByteString)
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text hash)
  (LocalIds' Text Hash32)
Lens._1 LocalIds Text hash -> LocalIds' Text Hash32
mungeLocalIds)
      Vector (LocalIds' Text Hash32, ByteString)
-> (Vector (LocalIds' Text Hash32, ByteString)
    -> SyncLocallyIndexedComponent' Text Hash32)
-> SyncLocallyIndexedComponent' Text Hash32
forall a b. a -> (a -> b) -> b
& Vector (LocalIds' Text Hash32, ByteString)
-> SyncLocallyIndexedComponent' Text Hash32
forall t d.
Vector (LocalIds' t d, ByteString)
-> SyncLocallyIndexedComponent' t d
DeclFormat.SyncLocallyIndexedComponent
      SyncLocallyIndexedComponent' Text Hash32
-> (SyncLocallyIndexedComponent' Text Hash32
    -> SyncDeclFormat' Text Hash32)
-> SyncDeclFormat' Text Hash32
forall a b. a -> (a -> b) -> b
& SyncLocallyIndexedComponent' Text Hash32
-> SyncDeclFormat' Text Hash32
forall t d. SyncLocallyIndexedComponent' t d -> SyncDeclFormat' t d
DeclFormat.SyncDecl
      SyncDeclFormat' Text Hash32
-> (SyncDeclFormat' Text Hash32 -> TempEntity) -> TempEntity
forall a b. a -> (a -> b) -> b
& SyncDeclFormat' Text Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncDeclFormat' text defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.DC
  Share.P Share.Patch {[Text]
textLookup :: [Text]
$sel:textLookup:Patch :: forall text oldHash newHash. Patch text oldHash newHash -> [text]
textLookup, [Hash32]
oldHashLookup :: [Hash32]
$sel:oldHashLookup:Patch :: forall text oldHash newHash.
Patch text oldHash newHash -> [oldHash]
oldHashLookup, [hash]
newHashLookup :: [hash]
$sel:newHashLookup:Patch :: forall text oldHash newHash.
Patch text oldHash newHash -> [newHash]
newHashLookup, ByteString
bytes :: ByteString
$sel:bytes:Patch :: forall text oldHash newHash.
Patch text oldHash newHash -> ByteString
bytes} ->
    SyncPatchFormat' Hash32 Text Hash32 Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncPatchFormat' patch text hash defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.P (PatchLocalIds' Text Hash32 Hash32
-> ByteString -> SyncPatchFormat' Hash32 Text Hash32 Hash32
forall parent text hash defn.
PatchLocalIds' text hash defn
-> ByteString -> SyncPatchFormat' parent text hash defn
PatchFormat.SyncFull ([Text] -> [Hash32] -> [hash] -> PatchLocalIds' Text Hash32 Hash32
mungePatchLocalIds [Text]
textLookup [Hash32]
oldHashLookup [hash]
newHashLookup) ByteString
bytes)
  Share.PD Share.PatchDiff {hash
parent :: hash
$sel:parent:PatchDiff :: forall text oldHash hash. PatchDiff text oldHash hash -> hash
parent, [Text]
textLookup :: [Text]
$sel:textLookup:PatchDiff :: forall text oldHash hash. PatchDiff text oldHash hash -> [text]
textLookup, [Hash32]
oldHashLookup :: [Hash32]
$sel:oldHashLookup:PatchDiff :: forall text oldHash hash. PatchDiff text oldHash hash -> [oldHash]
oldHashLookup, [hash]
newHashLookup :: [hash]
$sel:newHashLookup:PatchDiff :: forall text oldHash hash. PatchDiff text oldHash hash -> [hash]
newHashLookup, ByteString
bytes :: ByteString
$sel:bytes:PatchDiff :: forall text oldHash hash. PatchDiff text oldHash hash -> ByteString
bytes} ->
    SyncPatchFormat' Hash32 Text Hash32 Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncPatchFormat' patch text hash defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.P
      ( Hash32
-> PatchLocalIds' Text Hash32 Hash32
-> ByteString
-> SyncPatchFormat' Hash32 Text Hash32 Hash32
forall parent text hash defn.
parent
-> PatchLocalIds' text hash defn
-> ByteString
-> SyncPatchFormat' parent text hash defn
PatchFormat.SyncDiff
          (hash -> Hash32
toHash32 hash
parent)
          ([Text] -> [Hash32] -> [hash] -> PatchLocalIds' Text Hash32 Hash32
mungePatchLocalIds [Text]
textLookup [Hash32]
oldHashLookup [hash]
newHashLookup)
          ByteString
bytes
      )
  Share.N Share.Namespace {[Text]
textLookup :: [Text]
$sel:textLookup:Namespace :: forall text hash. Namespace text hash -> [text]
textLookup, [hash]
defnLookup :: [hash]
$sel:defnLookup:Namespace :: forall text hash. Namespace text hash -> [hash]
defnLookup, [hash]
patchLookup :: [hash]
$sel:patchLookup:Namespace :: forall text hash. Namespace text hash -> [hash]
patchLookup, [(hash, hash)]
childLookup :: [(hash, hash)]
$sel:childLookup:Namespace :: forall text hash. Namespace text hash -> [(hash, hash)]
childLookup, LocalBranchBytes
bytes :: LocalBranchBytes
$sel:bytes:Namespace :: forall text hash. Namespace text hash -> LocalBranchBytes
bytes} ->
    SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
-> TempEntity
forall text hash defn patch branchh branch causal.
SyncBranchFormat' branch text defn patch (branch, causal)
-> SyncEntity' text hash defn patch branchh branch causal
Entity.N (BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
-> LocalBranchBytes
-> SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
forall parent text defn patch child.
BranchLocalIds' text defn patch child
-> LocalBranchBytes
-> SyncBranchFormat' parent text defn patch child
NamespaceFormat.SyncFull ([Text]
-> [hash]
-> [hash]
-> [(hash, hash)]
-> BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
mungeNamespaceLocalIds [Text]
textLookup [hash]
defnLookup [hash]
patchLookup [(hash, hash)]
childLookup) LocalBranchBytes
bytes)
  Share.ND Share.NamespaceDiff {hash
parent :: hash
$sel:parent:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> hash
parent, [Text]
textLookup :: [Text]
$sel:textLookup:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> [text]
textLookup, [hash]
defnLookup :: [hash]
$sel:defnLookup:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> [hash]
defnLookup, [hash]
patchLookup :: [hash]
$sel:patchLookup:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> [hash]
patchLookup, [(hash, hash)]
childLookup :: [(hash, hash)]
$sel:childLookup:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> [(hash, hash)]
childLookup, LocalBranchBytes
bytes :: LocalBranchBytes
$sel:bytes:NamespaceDiff :: forall text hash. NamespaceDiff text hash -> LocalBranchBytes
bytes} ->
    SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
-> TempEntity
forall text hash defn patch branchh branch causal.
SyncBranchFormat' branch text defn patch (branch, causal)
-> SyncEntity' text hash defn patch branchh branch causal
Entity.N
      ( Hash32
-> BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
-> LocalBranchBytes
-> SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
forall parent text defn patch child.
parent
-> BranchLocalIds' text defn patch child
-> LocalBranchBytes
-> SyncBranchFormat' parent text defn patch child
NamespaceFormat.SyncDiff
          (hash -> Hash32
toHash32 hash
parent)
          ([Text]
-> [hash]
-> [hash]
-> [(hash, hash)]
-> BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
mungeNamespaceLocalIds [Text]
textLookup [hash]
defnLookup [hash]
patchLookup [(hash, hash)]
childLookup)
          LocalBranchBytes
bytes
      )
  Share.C Share.Causal {hash
namespaceHash :: hash
$sel:namespaceHash:Causal :: forall hash. Causal hash -> hash
namespaceHash, Set hash
parents :: Set hash
$sel:parents:Causal :: forall hash. Causal hash -> Set hash
parents} ->
    SyncCausalFormat' Hash32 Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncCausalFormat' causal branchh
-> SyncEntity' text hash defn patch branchh branch causal
Entity.C
      Causal.SyncCausalFormat
        { $sel:valueHash:SyncCausalFormat :: Hash32
valueHash = hash -> Hash32
toHash32 hash
namespaceHash,
          $sel:parents:SyncCausalFormat :: Vector Hash32
parents = [Hash32] -> Vector Hash32
forall a. [a] -> Vector a
Vector.fromList ((hash -> Hash32) -> [hash] -> [Hash32]
forall a b. (a -> b) -> [a] -> [b]
map hash -> Hash32
toHash32 (Set hash -> [hash]
forall a. Set a -> [a]
Set.toList Set hash
parents))
        }
  where
    mungeLocalIds :: Share.LocalIds Text hash -> TempEntity.TempLocalIds
    mungeLocalIds :: LocalIds Text hash -> LocalIds' Text Hash32
mungeLocalIds Share.LocalIds {[Text]
texts :: [Text]
$sel:texts:LocalIds :: forall text hash. LocalIds text hash -> [text]
texts, [hash]
hashes :: [hash]
$sel:hashes:LocalIds :: forall text hash. LocalIds text hash -> [hash]
hashes} =
      LocalIds
        { $sel:textLookup:LocalIds :: Vector Text
textLookup = [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList [Text]
texts,
          $sel:defnLookup:LocalIds :: Vector Hash32
defnLookup = (hash -> Hash32) -> Vector hash -> Vector Hash32
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map hash -> Hash32
toHash32 ([hash] -> Vector hash
forall a. [a] -> Vector a
Vector.fromList [hash]
hashes)
        }

    mungeNamespaceLocalIds ::
      [Text] ->
      [hash] ->
      [hash] ->
      [(hash, hash)] ->
      TempEntity.TempNamespaceLocalIds
    mungeNamespaceLocalIds :: [Text]
-> [hash]
-> [hash]
-> [(hash, hash)]
-> BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
mungeNamespaceLocalIds [Text]
textLookup [hash]
defnLookup [hash]
patchLookup [(hash, hash)]
childLookup =
      NamespaceFormat.LocalIds
        { $sel:branchTextLookup:LocalIds :: Vector Text
branchTextLookup = [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList [Text]
textLookup,
          $sel:branchDefnLookup:LocalIds :: Vector Hash32
branchDefnLookup = [Hash32] -> Vector Hash32
forall a. [a] -> Vector a
Vector.fromList ((hash -> Hash32) -> [hash] -> [Hash32]
forall a b. (a -> b) -> [a] -> [b]
map hash -> Hash32
toHash32 [hash]
defnLookup),
          $sel:branchPatchLookup:LocalIds :: Vector Hash32
branchPatchLookup = [Hash32] -> Vector Hash32
forall a. [a] -> Vector a
Vector.fromList ((hash -> Hash32) -> [hash] -> [Hash32]
forall a b. (a -> b) -> [a] -> [b]
map hash -> Hash32
toHash32 [hash]
patchLookup),
          $sel:branchChildLookup:LocalIds :: Vector (Hash32, Hash32)
branchChildLookup = [(Hash32, Hash32)] -> Vector (Hash32, Hash32)
forall a. [a] -> Vector a
Vector.fromList (((hash, hash) -> (Hash32, Hash32))
-> [(hash, hash)] -> [(Hash32, Hash32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(hash
x, hash
y) -> (hash -> Hash32
toHash32 hash
x, hash -> Hash32
toHash32 hash
y)) [(hash, hash)]
childLookup)
        }

    mungePatchLocalIds :: [Text] -> [Hash32] -> [hash] -> TempEntity.TempPatchLocalIds
    mungePatchLocalIds :: [Text] -> [Hash32] -> [hash] -> PatchLocalIds' Text Hash32 Hash32
mungePatchLocalIds [Text]
textLookup [Hash32]
oldHashLookup [hash]
newHashLookup =
      PatchFormat.LocalIds
        { $sel:patchTextLookup:LocalIds :: Vector Text
patchTextLookup = [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList [Text]
textLookup,
          $sel:patchHashLookup:LocalIds :: Vector Hash32
patchHashLookup = [Hash32] -> Vector Hash32
forall a. [a] -> Vector a
Vector.fromList [Hash32]
oldHashLookup,
          $sel:patchDefnLookup:LocalIds :: Vector Hash32
patchDefnLookup = [Hash32] -> Vector Hash32
forall a. [a] -> Vector a
Vector.fromList ((hash -> Hash32) -> [hash] -> [Hash32]
forall a b. (a -> b) -> [a] -> [b]
map hash -> Hash32
toHash32 [hash]
newHashLookup)
        }

tempEntityToEntity :: Sqlite.TempEntity -> Share.Entity Text Hash32 Hash32
tempEntityToEntity :: TempEntity -> Entity Text Hash32 Hash32
tempEntityToEntity = \case
  Entity.TC (TermFormat.SyncTerm (TermFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
terms)) ->
    Vector (LocalIds' Text Hash32, ByteString)
terms
      Vector (LocalIds' Text Hash32, ByteString)
-> (Vector (LocalIds' Text Hash32, ByteString)
    -> Vector (LocalIds Text Hash32, ByteString))
-> Vector (LocalIds Text Hash32, ByteString)
forall a b. a -> (a -> b) -> b
& ((LocalIds' Text Hash32, ByteString)
 -> (LocalIds Text Hash32, ByteString))
-> Vector (LocalIds' Text Hash32, ByteString)
-> Vector (LocalIds Text Hash32, ByteString)
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (ASetter
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
-> (LocalIds' Text Hash32 -> LocalIds Text Hash32)
-> (LocalIds' Text Hash32, ByteString)
-> (LocalIds Text Hash32, ByteString)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
Lens._1 LocalIds' Text Hash32 -> LocalIds Text Hash32
mungeLocalIds)
      Vector (LocalIds Text Hash32, ByteString)
-> (Vector (LocalIds Text Hash32, ByteString)
    -> [(LocalIds Text Hash32, ByteString)])
-> [(LocalIds Text Hash32, ByteString)]
forall a b. a -> (a -> b) -> b
& Vector (LocalIds Text Hash32, ByteString)
-> [(LocalIds Text Hash32, ByteString)]
forall a. Vector a -> [a]
Vector.toList
      [(LocalIds Text Hash32, ByteString)]
-> ([(LocalIds Text Hash32, ByteString)]
    -> TermComponent Text Hash32)
-> TermComponent Text Hash32
forall a b. a -> (a -> b) -> b
& [(LocalIds Text Hash32, ByteString)] -> TermComponent Text Hash32
forall text hash.
[(LocalIds text hash, ByteString)] -> TermComponent text hash
Share.TermComponent
      TermComponent Text Hash32
-> (TermComponent Text Hash32 -> Entity Text Hash32 Hash32)
-> Entity Text Hash32 Hash32
forall a b. a -> (a -> b) -> b
& TermComponent Text Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
TermComponent text hash -> Entity text noSyncHash hash
Share.TC
  Entity.DC (DeclFormat.SyncDecl (DeclFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
decls)) ->
    Vector (LocalIds' Text Hash32, ByteString)
decls
      Vector (LocalIds' Text Hash32, ByteString)
-> (Vector (LocalIds' Text Hash32, ByteString)
    -> Vector (LocalIds Text Hash32, ByteString))
-> Vector (LocalIds Text Hash32, ByteString)
forall a b. a -> (a -> b) -> b
& ((LocalIds' Text Hash32, ByteString)
 -> (LocalIds Text Hash32, ByteString))
-> Vector (LocalIds' Text Hash32, ByteString)
-> Vector (LocalIds Text Hash32, ByteString)
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (ASetter
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
-> (LocalIds' Text Hash32 -> LocalIds Text Hash32)
-> (LocalIds' Text Hash32, ByteString)
-> (LocalIds Text Hash32, ByteString)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (LocalIds' Text Hash32, ByteString)
  (LocalIds Text Hash32, ByteString)
  (LocalIds' Text Hash32)
  (LocalIds Text Hash32)
Lens._1 LocalIds' Text Hash32 -> LocalIds Text Hash32
mungeLocalIds)
      Vector (LocalIds Text Hash32, ByteString)
-> (Vector (LocalIds Text Hash32, ByteString)
    -> [(LocalIds Text Hash32, ByteString)])
-> [(LocalIds Text Hash32, ByteString)]
forall a b. a -> (a -> b) -> b
& Vector (LocalIds Text Hash32, ByteString)
-> [(LocalIds Text Hash32, ByteString)]
forall a. Vector a -> [a]
Vector.toList
      [(LocalIds Text Hash32, ByteString)]
-> ([(LocalIds Text Hash32, ByteString)]
    -> DeclComponent Text Hash32)
-> DeclComponent Text Hash32
forall a b. a -> (a -> b) -> b
& [(LocalIds Text Hash32, ByteString)] -> DeclComponent Text Hash32
forall text hash.
[(LocalIds text hash, ByteString)] -> DeclComponent text hash
Share.DeclComponent
      DeclComponent Text Hash32
-> (DeclComponent Text Hash32 -> Entity Text Hash32 Hash32)
-> Entity Text Hash32 Hash32
forall a b. a -> (a -> b) -> b
& DeclComponent Text Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
DeclComponent text hash -> Entity text noSyncHash hash
Share.DC
  Entity.P SyncPatchFormat' Hash32 Text Hash32 Hash32
format ->
    case SyncPatchFormat' Hash32 Text Hash32 Hash32
format of
      PatchFormat.SyncFull PatchFormat.LocalIds {Vector Text
$sel:patchTextLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector t
patchTextLookup :: Vector Text
patchTextLookup, Vector Hash32
$sel:patchHashLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector h
patchHashLookup :: Vector Hash32
patchHashLookup, Vector Hash32
$sel:patchDefnLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector d
patchDefnLookup :: Vector Hash32
patchDefnLookup} ByteString
bytes ->
        Patch Text Hash32 Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
Patch text noSyncHash hash -> Entity text noSyncHash hash
Share.P
          Share.Patch
            { $sel:textLookup:Patch :: [Text]
textLookup = Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList Vector Text
patchTextLookup,
              $sel:oldHashLookup:Patch :: [Hash32]
oldHashLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
patchHashLookup,
              $sel:newHashLookup:Patch :: [Hash32]
newHashLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
patchDefnLookup,
              ByteString
$sel:bytes:Patch :: ByteString
bytes :: ByteString
bytes
            }
      PatchFormat.SyncDiff Hash32
parent PatchFormat.LocalIds {Vector Text
$sel:patchTextLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector t
patchTextLookup :: Vector Text
patchTextLookup, Vector Hash32
$sel:patchHashLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector h
patchHashLookup :: Vector Hash32
patchHashLookup, Vector Hash32
$sel:patchDefnLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector d
patchDefnLookup :: Vector Hash32
patchDefnLookup} ByteString
bytes ->
        PatchDiff Text Hash32 Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
PatchDiff text noSyncHash hash -> Entity text noSyncHash hash
Share.PD
          Share.PatchDiff
            { Hash32
$sel:parent:PatchDiff :: Hash32
parent :: Hash32
parent,
              $sel:textLookup:PatchDiff :: [Text]
textLookup = Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList Vector Text
patchTextLookup,
              $sel:oldHashLookup:PatchDiff :: [Hash32]
oldHashLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
patchHashLookup,
              $sel:newHashLookup:PatchDiff :: [Hash32]
newHashLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
patchDefnLookup,
              ByteString
$sel:bytes:PatchDiff :: ByteString
bytes :: ByteString
bytes
            }
  Entity.N SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
format ->
    case SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
format of
      NamespaceFormat.SyncFull
        NamespaceFormat.LocalIds
          { Vector Text
$sel:branchTextLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector t
branchTextLookup :: Vector Text
branchTextLookup,
            Vector Hash32
$sel:branchDefnLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector d
branchDefnLookup :: Vector Hash32
branchDefnLookup,
            Vector Hash32
$sel:branchPatchLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector p
branchPatchLookup :: Vector Hash32
branchPatchLookup,
            Vector (Hash32, Hash32)
$sel:branchChildLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector c
branchChildLookup :: Vector (Hash32, Hash32)
branchChildLookup
          }
        LocalBranchBytes
bytes ->
          Namespace Text Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
Namespace text hash -> Entity text noSyncHash hash
Share.N
            Share.Namespace
              { $sel:textLookup:Namespace :: [Text]
textLookup = Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList Vector Text
branchTextLookup,
                $sel:defnLookup:Namespace :: [Hash32]
defnLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
branchDefnLookup,
                $sel:patchLookup:Namespace :: [Hash32]
patchLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
branchPatchLookup,
                $sel:childLookup:Namespace :: [(Hash32, Hash32)]
childLookup = Vector (Hash32, Hash32) -> [(Hash32, Hash32)]
forall a. Vector a -> [a]
Vector.toList Vector (Hash32, Hash32)
branchChildLookup,
                LocalBranchBytes
$sel:bytes:Namespace :: LocalBranchBytes
bytes :: LocalBranchBytes
bytes
              }
      NamespaceFormat.SyncDiff
        Hash32
parent
        NamespaceFormat.LocalIds
          { Vector Text
$sel:branchTextLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector t
branchTextLookup :: Vector Text
branchTextLookup,
            Vector Hash32
$sel:branchDefnLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector d
branchDefnLookup :: Vector Hash32
branchDefnLookup,
            Vector Hash32
$sel:branchPatchLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector p
branchPatchLookup :: Vector Hash32
branchPatchLookup,
            Vector (Hash32, Hash32)
$sel:branchChildLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector c
branchChildLookup :: Vector (Hash32, Hash32)
branchChildLookup
          }
        LocalBranchBytes
bytes ->
          NamespaceDiff Text Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
NamespaceDiff text hash -> Entity text noSyncHash hash
Share.ND
            Share.NamespaceDiff
              { Hash32
$sel:parent:NamespaceDiff :: Hash32
parent :: Hash32
parent,
                $sel:textLookup:NamespaceDiff :: [Text]
textLookup = Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList Vector Text
branchTextLookup,
                $sel:defnLookup:NamespaceDiff :: [Hash32]
defnLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
branchDefnLookup,
                $sel:patchLookup:NamespaceDiff :: [Hash32]
patchLookup = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
branchPatchLookup,
                $sel:childLookup:NamespaceDiff :: [(Hash32, Hash32)]
childLookup = Vector (Hash32, Hash32) -> [(Hash32, Hash32)]
forall a. Vector a -> [a]
Vector.toList Vector (Hash32, Hash32)
branchChildLookup,
                LocalBranchBytes
$sel:bytes:NamespaceDiff :: LocalBranchBytes
bytes :: LocalBranchBytes
bytes
              }
  Entity.C Causal.SyncCausalFormat {Hash32
$sel:valueHash:SyncCausalFormat :: forall causalHash valueHash.
SyncCausalFormat' causalHash valueHash -> valueHash
valueHash :: Hash32
valueHash, Vector Hash32
$sel:parents:SyncCausalFormat :: forall causalHash valueHash.
SyncCausalFormat' causalHash valueHash -> Vector causalHash
parents :: Vector Hash32
parents} ->
    Causal Hash32 -> Entity Text Hash32 Hash32
forall text noSyncHash hash.
Causal hash -> Entity text noSyncHash hash
Share.C
      Share.Causal
        { $sel:namespaceHash:Causal :: Hash32
namespaceHash = Hash32
valueHash,
          $sel:parents:Causal :: Set Hash32
parents = [Hash32] -> Set Hash32
forall a. Ord a => [a] -> Set a
Set.fromList (Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
parents)
        }
  where
    mungeLocalIds :: LocalIds' Text Hash32 -> Share.LocalIds Text Hash32
    mungeLocalIds :: LocalIds' Text Hash32 -> LocalIds Text Hash32
mungeLocalIds LocalIds {Vector Text
$sel:textLookup:LocalIds :: forall t h. LocalIds' t h -> Vector t
textLookup :: Vector Text
textLookup, Vector Hash32
$sel:defnLookup:LocalIds :: forall t h. LocalIds' t h -> Vector h
defnLookup :: Vector Hash32
defnLookup} =
      Share.LocalIds
        { $sel:texts:LocalIds :: [Text]
texts = Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList Vector Text
textLookup,
          $sel:hashes:LocalIds :: [Hash32]
hashes = Vector Hash32 -> [Hash32]
forall a. Vector a -> [a]
Vector.toList Vector Hash32
defnLookup
        }