module U.Codebase.Sqlite.Operations
  ( -- * branches
    loadCausalHashAtPath,
    expectCausalHashAtPath,
    loadCausalBranchAtPath,
    loadBranchAtPath,
    saveBranch,
    saveBranchV3,
    loadCausalBranchByCausalHash,
    expectCausalBranchByCausalHash,
    expectBranchByCausalHashId,
    expectBranchByBranchHash,
    expectBranchByBranchHashId,
    expectNamespaceStatsByHash,
    expectNamespaceStatsByHashId,
    tryGetSquashResult,
    saveSquashResult,

    -- * terms
    Q.saveTermComponent,
    loadTermComponent,
    loadTermByReference,
    loadTypeOfTermByTermReference,

    -- * decls
    Q.saveDeclComponent,
    loadDeclComponent,
    loadDeclByReference,
    expectDeclByReference,
    expectDeclNumConstructors,
    expectDeclTypeById,

    -- * terms/decls
    getCycleLen,

    -- * patches
    savePatch,
    expectPatch,

    -- * test for stuff in codebase
    objectExistsForHash,

    -- * watch expression cache
    saveWatch,
    loadWatch,
    listWatches,
    Q.clearWatches,

    -- * indexes

    -- ** nearest common ancestor
    before,
    lca,

    -- ** prefix index
    componentReferencesByPrefix,
    termReferentsByPrefix,
    declReferentsByPrefix,
    causalHashesByPrefix,

    -- ** dependents index
    directDependenciesOfScope,
    dependents,
    dependentsOfComponent,
    directDependentsWithinScope,
    transitiveDependentsWithinScope,

    -- ** type index
    Q.addTypeToIndexForTerm,
    termsHavingType,
    filterTermsByReferenceHavingType,
    filterTermsByReferentHavingType,

    -- ** type mentions index
    Q.addTypeMentionsToIndexForTerm,
    termsMentioningType,

    -- ** name lookup index
    allNamesInPerspective,
    NamesInPerspective (..),
    NamesPerspective (..),
    termNamesForRefWithinNamespace,
    typeNamesForRefWithinNamespace,
    termNamesBySuffix,
    typeNamesBySuffix,
    termRefsForExactName,
    typeRefsForExactName,
    recursiveTermNameSearch,
    recursiveTypeNameSearch,
    checkBranchHashNameLookupExists,
    buildNameLookupForBranchHash,
    associateNameLookupMounts,
    longestMatchingTermNameForSuffixification,
    longestMatchingTypeNameForSuffixification,
    deleteNameLookupsExceptFor,
    fuzzySearchDefinitions,
    namesPerspectiveForRootAndPath,

    -- * Projects
    expectProjectAndBranchNames,
    expectProjectBranchHead,

    -- * reflog
    getDeprecatedRootReflog,
    getProjectReflog,
    getProjectBranchReflog,
    getGlobalReflog,
    appendProjectReflog,

    -- * low-level stuff
    expectDbBranch,
    saveDbBranch,
    saveDbBranchUnderHashId,
    expectDbPatch,
    saveDbPatch,
    expectDbBranchByCausalHashId,
    namespaceStatsForDbBranch,

    -- * somewhat unexpectedly unused definitions
    c2sReferenceId,
    c2sReferentId,
    diffPatch,
    decodeTermElementWithType,
    loadTermWithTypeByReference,
    Q.s2cTermWithType,
    Q.s2cDecl,
    declReferencesByPrefix,
    namespaceHashesByPrefix,
    derivedDependencies,

    -- * internal stuff that probably need not be exported, but the 1->2 migration needs it
    BranchV (..),
    DbBranchV (..),
  )
where

import Control.Lens hiding (children)
import Control.Monad.Extra qualified as Monad
import Data.Bitraversable (Bitraversable (bitraverse))
import Data.Foldable qualified as Foldable
import Data.List.Extra qualified as List
import Data.List.NonEmpty.Extra qualified as NonEmpty
import Data.Map qualified as Map
import Data.Map.Merge.Lazy qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Tuple.Extra (uncurry3, (***))
import U.Codebase.Branch.Type (NamespaceStats (..))
import U.Codebase.Branch.Type qualified as C.Branch
import U.Codebase.BranchV3 qualified as C.BranchV3
import U.Codebase.Causal qualified as C
import U.Codebase.Causal qualified as C.Causal
import U.Codebase.Decl (ConstructorId)
import U.Codebase.Decl qualified as C
import U.Codebase.Decl qualified as C.Decl
import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..))
import U.Codebase.Reference qualified as C
import U.Codebase.Reference qualified as C.Reference
import U.Codebase.Referent qualified as C
import U.Codebase.Referent qualified as C.Referent
import U.Codebase.Reflog qualified as Reflog
import U.Codebase.Sqlite.Branch.Diff qualified as S.Branch
import U.Codebase.Sqlite.Branch.Diff qualified as S.Branch.Diff
import U.Codebase.Sqlite.Branch.Diff qualified as S.BranchDiff
import U.Codebase.Sqlite.Branch.Format qualified as S
import U.Codebase.Sqlite.Branch.Format qualified as S.BranchFormat
import U.Codebase.Sqlite.Branch.Full qualified as S
import U.Codebase.Sqlite.Branch.Full qualified as S.Branch.Full
import U.Codebase.Sqlite.Branch.Full qualified as S.MetadataSet (DbMetadataSet, MetadataSetFormat' (..))
import U.Codebase.Sqlite.DbId qualified as Db
import U.Codebase.Sqlite.Decl.Format qualified as S.Decl
import U.Codebase.Sqlite.Decode
import U.Codebase.Sqlite.HashHandle (HashHandle (..))
import U.Codebase.Sqlite.LocalIds (LocalIds, WatchLocalIds)
import U.Codebase.Sqlite.LocalizeObject qualified as LocalizeObject
import U.Codebase.Sqlite.NameLookups (PathSegments (..))
import U.Codebase.Sqlite.NameLookups qualified as NameLookups
import U.Codebase.Sqlite.NameLookups qualified as S
import U.Codebase.Sqlite.NamedRef qualified as S
import U.Codebase.Sqlite.ObjectType qualified as ObjectType
import U.Codebase.Sqlite.Patch.Diff qualified as S
import U.Codebase.Sqlite.Patch.Format qualified as S
import U.Codebase.Sqlite.Patch.Format qualified as S.Patch.Format
import U.Codebase.Sqlite.Patch.Full qualified as S (LocalPatch, Patch, Patch' (..))
import U.Codebase.Sqlite.Patch.TermEdit qualified as S
import U.Codebase.Sqlite.Patch.TermEdit qualified as S.TermEdit
import U.Codebase.Sqlite.Patch.TypeEdit qualified as S
import U.Codebase.Sqlite.Patch.TypeEdit qualified as S.TypeEdit
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.Reference qualified as S
import U.Codebase.Sqlite.Reference qualified as S.Reference
import U.Codebase.Sqlite.Referent qualified as S
import U.Codebase.Sqlite.Referent qualified as S.Referent
import U.Codebase.Sqlite.Serialization qualified as S
import U.Codebase.Sqlite.Symbol (Symbol)
import U.Codebase.Sqlite.Term.Format qualified as S.Term
import U.Codebase.Term qualified as C
import U.Codebase.Term qualified as C.Term
import U.Codebase.TermEdit qualified as C
import U.Codebase.TermEdit qualified as C.TermEdit
import U.Codebase.TypeEdit qualified as C
import U.Codebase.TypeEdit qualified as C.TypeEdit
import U.Codebase.WatchKind (WatchKind)
import U.Util.Base32Hex qualified as Base32Hex
import U.Util.Serialization qualified as S
import Unison.Core.Project (ProjectBranchName, ProjectName)
import Unison.Hash qualified as H
import Unison.Hash32 qualified as Hash32
import Unison.NameSegment (NameSegment)
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Prelude
import Unison.ShortHash (ShortCausalHash (..), ShortNamespaceHash (..))
import Unison.Sqlite
import Unison.Util.Defns (DefnsF)
import Unison.Util.List qualified as List
import Unison.Util.Map qualified as Map
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Set qualified as Set

-- * Error handling

debug :: Bool
debug :: Bool
debug = Bool
False

-- * Database lookups

objectExistsForHash :: H.Hash -> Transaction Bool
objectExistsForHash :: Hash -> Transaction Bool
objectExistsForHash Hash
h =
  Maybe ObjectId -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ObjectId -> Bool)
-> Transaction (Maybe ObjectId) -> Transaction Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT Transaction ObjectId -> Transaction (Maybe ObjectId)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    HashId
id <- Transaction (Maybe HashId) -> MaybeT Transaction HashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe HashId) -> MaybeT Transaction HashId)
-> (Hash -> Transaction (Maybe HashId))
-> Hash
-> MaybeT Transaction HashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Transaction (Maybe HashId)
Q.loadHashId (Hash32 -> Transaction (Maybe HashId))
-> (Hash -> Hash32) -> Hash -> Transaction (Maybe HashId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Hash32
Hash32.fromHash (Hash -> MaybeT Transaction HashId)
-> Hash -> MaybeT Transaction HashId
forall a b. (a -> b) -> a -> b
$ Hash
h
    Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId)
-> Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall a b. (a -> b) -> a -> b
$ HashId -> Transaction (Maybe ObjectId)
Q.loadObjectIdForAnyHashId HashId
id

expectValueHashByCausalHashId :: Db.CausalHashId -> Transaction BranchHash
expectValueHashByCausalHashId :: CausalHashId -> Transaction BranchHash
expectValueHashByCausalHashId = BranchHashId -> Transaction BranchHash
loadValueHashById (BranchHashId -> Transaction BranchHash)
-> (CausalHashId -> Transaction BranchHashId)
-> CausalHashId
-> Transaction BranchHash
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CausalHashId -> Transaction BranchHashId
Q.expectCausalValueHashId
  where
    loadValueHashById :: Db.BranchHashId -> Transaction BranchHash
    loadValueHashById :: BranchHashId -> Transaction BranchHash
loadValueHashById = (Hash -> BranchHash) -> Transaction Hash -> Transaction BranchHash
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash -> BranchHash
BranchHash (Transaction Hash -> Transaction BranchHash)
-> (BranchHashId -> Transaction Hash)
-> BranchHashId
-> Transaction BranchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashId -> Transaction Hash
Q.expectHash (HashId -> Transaction Hash)
-> (BranchHashId -> HashId) -> BranchHashId -> Transaction Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchHashId -> HashId
Db.unBranchHashId

-- | Load the causal hash at the given path from the provided root, if Nothing, use the
-- codebase root.
loadCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash)
loadCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash)
loadCausalHashAtPath CausalHash
rootCausalHash =
  let go :: Db.CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash
      go :: CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash
go CausalHashId
hashId = \case
        [] -> Transaction CausalHash -> MaybeT Transaction CausalHash
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
hashId)
        NameSegment
t : [NameSegment]
ts -> do
          TextId
tid <- Transaction (Maybe TextId) -> MaybeT Transaction TextId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Text -> Transaction (Maybe TextId)
Q.loadTextId (Text -> Transaction (Maybe TextId))
-> Text -> Transaction (Maybe TextId)
forall a b. (a -> b) -> a -> b
$ NameSegment -> Text
NameSegment.toUnescapedText NameSegment
t)
          S.Branch {Map TextId (BranchObjectId, CausalHashId)
children :: Map TextId (BranchObjectId, CausalHashId)
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
children} <- Transaction
  (Maybe
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
-> MaybeT
     Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (CausalHashId
-> Transaction
     (Maybe
        (Branch'
           TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
loadDbBranchByCausalHashId CausalHashId
hashId)
          (BranchObjectId
_, CausalHashId
hashId') <- Transaction (Maybe (BranchObjectId, CausalHashId))
-> MaybeT Transaction (BranchObjectId, CausalHashId)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe (BranchObjectId, CausalHashId)
-> Transaction (Maybe (BranchObjectId, CausalHashId))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextId
-> Map TextId (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TextId
tid Map TextId (BranchObjectId, CausalHashId)
children))
          CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash
go CausalHashId
hashId' [NameSegment]
ts
   in \[NameSegment]
path -> do
        CausalHashId
hashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
rootCausalHash
        MaybeT Transaction CausalHash -> Transaction (Maybe CausalHash)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash
go CausalHashId
hashId [NameSegment]
path)

-- | Expect the causal hash at the given path from the provided root, if Nothing, use the
-- codebase root.
expectCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction CausalHash
expectCausalHashAtPath :: CausalHash -> [NameSegment] -> Transaction CausalHash
expectCausalHashAtPath CausalHash
rootCausalHash =
  let go :: Db.CausalHashId -> [NameSegment] -> Transaction CausalHash
      go :: CausalHashId -> [NameSegment] -> Transaction CausalHash
go CausalHashId
hashId = \case
        [] -> CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
hashId
        NameSegment
t : [NameSegment]
ts -> do
          TextId
tid <- Text -> Transaction TextId
Q.expectTextId (Text -> Transaction TextId) -> Text -> Transaction TextId
forall a b. (a -> b) -> a -> b
$ NameSegment -> Text
NameSegment.toUnescapedText NameSegment
t
          S.Branch {Map TextId (BranchObjectId, CausalHashId)
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
children :: Map TextId (BranchObjectId, CausalHashId)
children} <- CausalHashId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranchByCausalHashId CausalHashId
hashId
          let (BranchObjectId
_, CausalHashId
hashId') = Map TextId (BranchObjectId, CausalHashId)
children Map TextId (BranchObjectId, CausalHashId)
-> TextId -> (BranchObjectId, CausalHashId)
forall k a. Ord k => Map k a -> k -> a
Map.! TextId
tid
          CausalHashId -> [NameSegment] -> Transaction CausalHash
go CausalHashId
hashId' [NameSegment]
ts
   in \[NameSegment]
path -> do
        CausalHashId
hashId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
rootCausalHash
        CausalHashId -> [NameSegment] -> Transaction CausalHash
go CausalHashId
hashId [NameSegment]
path

loadCausalBranchAtPath ::
  CausalHash ->
  [NameSegment] ->
  Transaction (Maybe (C.Branch.CausalBranch Transaction))
loadCausalBranchAtPath :: CausalHash
-> [NameSegment] -> Transaction (Maybe (CausalBranch Transaction))
loadCausalBranchAtPath CausalHash
rootCausalHash [NameSegment]
path =
  CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash)
loadCausalHashAtPath CausalHash
rootCausalHash [NameSegment]
path Transaction (Maybe CausalHash)
-> (Maybe CausalHash
    -> Transaction (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CausalHash
Nothing -> Maybe (CausalBranch Transaction)
-> Transaction (Maybe (CausalBranch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CausalBranch Transaction)
forall a. Maybe a
Nothing
    Just CausalHash
causalHash -> CausalBranch Transaction -> Maybe (CausalBranch Transaction)
forall a. a -> Maybe a
Just (CausalBranch Transaction -> Maybe (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> Transaction (Maybe (CausalBranch Transaction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHash -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHash CausalHash
causalHash

loadBranchAtPath :: CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction))
loadBranchAtPath :: CausalHash
-> [NameSegment] -> Transaction (Maybe (Branch Transaction))
loadBranchAtPath CausalHash
rootCausalHash [NameSegment]
path =
  CausalHash
-> [NameSegment] -> Transaction (Maybe (CausalBranch Transaction))
loadCausalBranchAtPath CausalHash
rootCausalHash [NameSegment]
path Transaction (Maybe (CausalBranch Transaction))
-> (Maybe (CausalBranch Transaction)
    -> Transaction (Maybe (Branch Transaction)))
-> Transaction (Maybe (Branch Transaction))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (CausalBranch Transaction)
Nothing -> Maybe (Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Branch Transaction)
forall a. Maybe a
Nothing
    Just CausalBranch Transaction
causal -> Branch Transaction -> Maybe (Branch Transaction)
forall a. a -> Maybe a
Just (Branch Transaction -> Maybe (Branch Transaction))
-> Transaction (Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
C.Causal.value CausalBranch Transaction
causal

-- * Reference transformations

-- ** read existing references

-- | Assumes that a derived reference would already exist in the database
--  (by virtue of dependencies being stored before dependents), but does
--  not assume a builtin reference would.
c2sReference :: C.Reference -> Transaction S.Reference
c2sReference :: Reference -> Transaction Reference
c2sReference = (Text -> Transaction TextId)
-> (Hash -> Transaction ObjectId)
-> Reference
-> Transaction Reference
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Text -> Transaction TextId
Q.saveText Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash

c2sTextReference :: C.Reference -> S.TextReference
c2sTextReference :: Reference -> TextReference
c2sTextReference = (Text -> Text) -> (Hash -> Base32Hex) -> Reference -> TextReference
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 Text -> Text
forall a. a -> a
id Hash -> Base32Hex
H.toBase32Hex

s2cReference :: S.Reference -> Transaction C.Reference
s2cReference :: Reference -> Transaction Reference
s2cReference = (TextId -> Transaction Text)
-> (ObjectId -> Transaction Hash)
-> Reference
-> Transaction Reference
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse TextId -> Transaction Text
Q.expectText ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId

s2cTextReference :: S.TextReference -> C.Reference
s2cTextReference :: TextReference -> Reference
s2cTextReference = (Text -> Text) -> (Base32Hex -> Hash) -> TextReference -> Reference
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 Text -> Text
forall a. a -> a
id Base32Hex -> Hash
H.fromBase32Hex

c2sReferenceId :: C.Reference.Id -> Transaction S.Reference.Id
c2sReferenceId :: Id -> Transaction Id
c2sReferenceId = (Hash -> Transaction ObjectId) -> Id -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash

s2cReferenceId :: S.Reference.Id -> Transaction C.Reference.Id
s2cReferenceId :: Id -> Transaction Id
s2cReferenceId = (ObjectId -> Transaction Hash) -> Id -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId

h2cReferenceId :: S.Reference.IdH -> Transaction C.Reference.Id
h2cReferenceId :: IdH -> Transaction Id
h2cReferenceId = (HashId -> Transaction Hash) -> IdH -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH HashId -> Transaction Hash
Q.expectHash

h2cReference :: S.ReferenceH -> Transaction C.Reference
h2cReference :: Reference' TextId HashId -> Transaction Reference
h2cReference = (TextId -> Transaction Text)
-> (HashId -> Transaction Hash)
-> Reference' TextId HashId
-> Transaction Reference
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse TextId -> Transaction Text
Q.expectText HashId -> Transaction Hash
Q.expectHash

c2hReference :: C.Reference -> MaybeT Transaction S.ReferenceH
c2hReference :: Reference -> MaybeT Transaction (Reference' TextId HashId)
c2hReference = (Text -> MaybeT Transaction TextId)
-> (Hash -> MaybeT Transaction HashId)
-> Reference
-> MaybeT Transaction (Reference' TextId HashId)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Transaction (Maybe TextId) -> MaybeT Transaction TextId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe TextId) -> MaybeT Transaction TextId)
-> (Text -> Transaction (Maybe TextId))
-> Text
-> MaybeT Transaction TextId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Transaction (Maybe TextId)
Q.loadTextId) (Transaction (Maybe HashId) -> MaybeT Transaction HashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe HashId) -> MaybeT Transaction HashId)
-> (Hash -> Transaction (Maybe HashId))
-> Hash
-> MaybeT Transaction HashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction (Maybe HashId)
Q.loadHashIdByHash)

s2cReferent :: S.Referent -> Transaction C.Referent
s2cReferent :: Referent'' TextId ObjectId -> Transaction Referent
s2cReferent = (Reference -> Transaction Reference)
-> (Reference -> Transaction Reference)
-> Referent'' TextId ObjectId
-> Transaction Referent
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Reference -> Transaction Reference
s2cReference Reference -> Transaction Reference
s2cReference

s2cTextReferent :: S.TextReferent -> C.Referent
s2cTextReferent :: TextReferent -> Referent
s2cTextReferent = (TextReference -> Reference)
-> (TextReference -> Reference) -> TextReferent -> Referent
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 TextReference -> Reference
s2cTextReference TextReference -> Reference
s2cTextReference

s2cConstructorType :: S.ConstructorType -> C.ConstructorType
s2cConstructorType :: ConstructorType -> ConstructorType
s2cConstructorType = \case
  ConstructorType
S.DataConstructor -> ConstructorType
C.DataConstructor
  ConstructorType
S.EffectConstructor -> ConstructorType
C.EffectConstructor

c2sConstructorType :: C.ConstructorType -> S.ConstructorType
c2sConstructorType :: ConstructorType -> ConstructorType
c2sConstructorType = \case
  ConstructorType
C.DataConstructor -> ConstructorType
S.DataConstructor
  ConstructorType
C.EffectConstructor -> ConstructorType
S.EffectConstructor

s2cReferentId :: S.Referent.Id -> Transaction C.Referent.Id
s2cReferentId :: Id -> Transaction Id
s2cReferentId = (ObjectId -> Transaction Hash)
-> (ObjectId -> Transaction Hash) -> Id -> Transaction Id
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Id' a b -> f (Id' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId

c2sReferent :: C.Referent -> Transaction S.Referent
c2sReferent :: Referent -> Transaction (Referent'' TextId ObjectId)
c2sReferent = (Reference -> Transaction Reference)
-> (Reference -> Transaction Reference)
-> Referent
-> Transaction (Referent'' TextId ObjectId)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Reference -> Transaction Reference
c2sReference Reference -> Transaction Reference
c2sReference

c2sTextReferent :: C.Referent -> S.TextReferent
c2sTextReferent :: Referent -> TextReferent
c2sTextReferent = (Reference -> TextReference)
-> (Reference -> TextReference) -> Referent -> TextReferent
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 Reference -> TextReference
c2sTextReference Reference -> TextReference
c2sTextReference

c2sReferentId :: C.Referent.Id -> Transaction S.Referent.Id
c2sReferentId :: Id -> Transaction Id
c2sReferentId = (Hash -> Transaction ObjectId)
-> (Hash -> Transaction ObjectId) -> Id -> Transaction Id
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Id' a b -> f (Id' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash

h2cReferent :: S.ReferentH -> Transaction C.Referent
h2cReferent :: Referent'' TextId HashId -> Transaction Referent
h2cReferent = (Reference' TextId HashId -> Transaction Reference)
-> (Reference' TextId HashId -> Transaction Reference)
-> Referent'' TextId HashId
-> Transaction Referent
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Reference' TextId HashId -> Transaction Reference
h2cReference Reference' TextId HashId -> Transaction Reference
h2cReference

-- ** convert and save references

saveReferentH :: C.Referent -> Transaction S.ReferentH
saveReferentH :: Referent -> Transaction (Referent'' TextId HashId)
saveReferentH = (Reference -> Transaction (Reference' TextId HashId))
-> (Reference -> Transaction (Reference' TextId HashId))
-> Referent
-> Transaction (Referent'' TextId HashId)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Reference -> Transaction (Reference' TextId HashId)
Q.saveReferenceH Reference -> Transaction (Reference' TextId HashId)
Q.saveReferenceH

-- ** Edits transformations

s2cTermEdit :: S.TermEdit -> Transaction C.TermEdit
s2cTermEdit :: TermEdit' TextId ObjectId -> Transaction TermEdit
s2cTermEdit = \case
  S.TermEdit.Replace Referent'' TextId ObjectId
r Typing
t -> Referent -> Typing -> TermEdit
C.TermEdit.Replace (Referent -> Typing -> TermEdit)
-> Transaction Referent -> Transaction (Typing -> TermEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referent'' TextId ObjectId -> Transaction Referent
s2cReferent Referent'' TextId ObjectId
r Transaction (Typing -> TermEdit)
-> Transaction Typing -> Transaction TermEdit
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Typing -> Transaction Typing
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Typing -> Typing
s2cTyping Typing
t)
  TermEdit' TextId ObjectId
S.TermEdit.Deprecate -> TermEdit -> Transaction TermEdit
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermEdit
C.TermEdit.Deprecate

s2cTyping :: S.TermEdit.Typing -> C.TermEdit.Typing
s2cTyping :: Typing -> Typing
s2cTyping = \case
  Typing
S.TermEdit.Same -> Typing
C.TermEdit.Same
  Typing
S.TermEdit.Subtype -> Typing
C.TermEdit.Subtype
  Typing
S.TermEdit.Different -> Typing
C.TermEdit.Different

c2sTyping :: C.TermEdit.Typing -> S.TermEdit.Typing
c2sTyping :: Typing -> Typing
c2sTyping = \case
  Typing
C.TermEdit.Same -> Typing
S.TermEdit.Same
  Typing
C.TermEdit.Subtype -> Typing
S.TermEdit.Subtype
  Typing
C.TermEdit.Different -> Typing
S.TermEdit.Different

s2cTypeEdit :: S.TypeEdit -> Transaction C.TypeEdit
s2cTypeEdit :: TypeEdit' TextId ObjectId -> Transaction TypeEdit
s2cTypeEdit = \case
  S.TypeEdit.Replace Reference
r -> Reference -> TypeEdit
C.TypeEdit.Replace (Reference -> TypeEdit)
-> Transaction Reference -> Transaction TypeEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> Transaction Reference
s2cReference Reference
r
  TypeEdit' TextId ObjectId
S.TypeEdit.Deprecate -> TypeEdit -> Transaction TypeEdit
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeEdit
C.TypeEdit.Deprecate

-- | assumes that all relevant defns are already in the DB
c2sPatch :: C.Branch.Patch -> Transaction S.Patch
c2sPatch :: Patch -> Transaction Patch
c2sPatch (C.Branch.Patch Map Referent (Set TermEdit)
termEdits Map Reference (Set TypeEdit)
typeEdits) =
  Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
-> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
-> Patch
forall t h o.
Map (Referent'' t h) (Set (TermEdit' t o))
-> Map (Reference' t h) (Set (TypeEdit' t o)) -> Patch' t h o
S.Patch
    (Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
 -> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
 -> Patch)
-> Transaction
     (Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId)))
-> Transaction
     (Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
      -> Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Referent -> Transaction (Referent'' TextId HashId))
-> (Set TermEdit -> Transaction (Set (TermEdit' TextId ObjectId)))
-> Map Referent (Set TermEdit)
-> Transaction
     (Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Referent -> Transaction (Referent'' TextId HashId)
saveReferentH ((TermEdit -> Transaction (TermEdit' TextId ObjectId))
-> Set TermEdit -> Transaction (Set (TermEdit' TextId ObjectId))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse TermEdit -> Transaction (TermEdit' TextId ObjectId)
c2sTermEdit) Map Referent (Set TermEdit)
termEdits
    Transaction
  (Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
   -> Patch)
-> Transaction
     (Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId)))
-> Transaction Patch
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Reference -> Transaction (Reference' TextId HashId))
-> (Set TypeEdit -> Transaction (Set (TypeEdit' TextId ObjectId)))
-> Map Reference (Set TypeEdit)
-> Transaction
     (Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Reference -> Transaction (Reference' TextId HashId)
Q.saveReferenceH ((TypeEdit -> Transaction (TypeEdit' TextId ObjectId))
-> Set TypeEdit -> Transaction (Set (TypeEdit' TextId ObjectId))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse TypeEdit -> Transaction (TypeEdit' TextId ObjectId)
c2sTypeEdit) Map Reference (Set TypeEdit)
typeEdits
  where
    c2sTermEdit :: TermEdit -> Transaction (TermEdit' TextId ObjectId)
c2sTermEdit = \case
      C.TermEdit.Replace Referent
r Typing
t -> Referent'' TextId ObjectId -> Typing -> TermEdit' TextId ObjectId
forall t h. Referent' t h -> Typing -> TermEdit' t h
S.TermEdit.Replace (Referent'' TextId ObjectId -> Typing -> TermEdit' TextId ObjectId)
-> Transaction (Referent'' TextId ObjectId)
-> Transaction (Typing -> TermEdit' TextId ObjectId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referent -> Transaction (Referent'' TextId ObjectId)
c2sReferent Referent
r Transaction (Typing -> TermEdit' TextId ObjectId)
-> Transaction Typing -> Transaction (TermEdit' TextId ObjectId)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Typing -> Transaction Typing
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Typing -> Typing
c2sTyping Typing
t)
      TermEdit
C.TermEdit.Deprecate -> TermEdit' TextId ObjectId
-> Transaction (TermEdit' TextId ObjectId)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermEdit' TextId ObjectId
forall t h. TermEdit' t h
S.TermEdit.Deprecate

    c2sTypeEdit :: TypeEdit -> Transaction (TypeEdit' TextId ObjectId)
c2sTypeEdit = \case
      C.TypeEdit.Replace Reference
r -> Reference -> TypeEdit' TextId ObjectId
forall t h. Reference' t h -> TypeEdit' t h
S.TypeEdit.Replace (Reference -> TypeEdit' TextId ObjectId)
-> Transaction Reference -> Transaction (TypeEdit' TextId ObjectId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> Transaction Reference
c2sReference Reference
r
      TypeEdit
C.TypeEdit.Deprecate -> TypeEdit' TextId ObjectId
-> Transaction (TypeEdit' TextId ObjectId)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeEdit' TextId ObjectId
forall t h. TypeEdit' t h
S.TypeEdit.Deprecate

-- | produces a diff
-- diff = full - ref; full = diff + ref
diffPatch :: S.LocalPatch -> S.LocalPatch -> S.LocalPatchDiff
diffPatch :: LocalPatch -> LocalPatch -> LocalPatchDiff
diffPatch (S.Patch Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
fullTerms Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
fullTypes) (S.Patch Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
refTerms Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
refTypes) =
  (Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> LocalPatchDiff
forall t h d.
Map (Referent'' t h) (Set (TermEdit' t d))
-> Map (Reference' t h) (Set (TypeEdit' t d))
-> Map (Referent'' t h) (Set (TermEdit' t d))
-> Map (Reference' t h) (Set (TypeEdit' t d))
-> PatchDiff' t h d
S.PatchDiff Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
addTermEdits Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
addTypeEdits Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
removeTermEdits Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
removeTypeEdits)
  where
    -- add: present in full. but absent in ref.
    addTermEdits :: Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
addTermEdits = SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
-> SimpleWhenMissing
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
-> SimpleWhenMatched
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
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
Map.merge SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing SimpleWhenMatched
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
addDiffSet Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
fullTerms Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
refTerms
    addTypeEdits :: Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
addTypeEdits = SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
-> SimpleWhenMissing
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> SimpleWhenMatched
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
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
Map.merge SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing SimpleWhenMatched
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
addDiffSet Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
fullTypes Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
refTypes
    -- remove: present in ref. but absent in full.
    removeTermEdits :: Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
removeTermEdits = SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
-> SimpleWhenMissing
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
-> SimpleWhenMatched
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
-> Map
     (Referent'' LocalTextId LocalHashId)
     (Set (TermEdit' LocalTextId LocalDefnId))
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
Map.merge SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing SimpleWhenMissing
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing SimpleWhenMatched
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
  (Set (TermEdit' LocalTextId LocalDefnId))
forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
removeDiffSet Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
fullTerms Map
  (Referent'' LocalTextId LocalHashId)
  (Set (TermEdit' LocalTextId LocalDefnId))
refTerms
    removeTypeEdits :: Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
removeTypeEdits = SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
-> SimpleWhenMissing
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> SimpleWhenMatched
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
-> Map
     (Reference' LocalTextId LocalHashId)
     (Set (TypeEdit' LocalTextId LocalDefnId))
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
Map.merge SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing SimpleWhenMissing
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing SimpleWhenMatched
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
  (Set (TypeEdit' LocalTextId LocalDefnId))
forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
removeDiffSet Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
fullTypes Map
  (Reference' LocalTextId LocalHashId)
  (Set (TypeEdit' LocalTextId LocalDefnId))
refTypes
    -- things that are present in full but absent in ref
    addDiffSet,
      removeDiffSet ::
        (Ord k, Ord a) => Map.WhenMatched Identity k (Set a) (Set a) (Set a)
    addDiffSet :: forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
addDiffSet = (k -> Set a -> Set a -> Set a)
-> WhenMatched Identity k (Set a) (Set a) (Set a)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched ((Set a -> Set a -> Set a) -> k -> Set a -> Set a -> Set a
forall a b. a -> b -> a
const Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference)
    removeDiffSet :: forall k a.
(Ord k, Ord a) =>
WhenMatched Identity k (Set a) (Set a) (Set a)
removeDiffSet = (k -> Set a -> Set a -> Set a)
-> WhenMatched Identity k (Set a) (Set a) (Set a)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched ((Set a -> Set a -> Set a) -> k -> Set a -> Set a -> Set a
forall a b. a -> b -> a
const ((Set a -> Set a -> Set a) -> Set a -> Set a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference))

getCycleLen :: H.Hash -> Transaction (Maybe Word64)
getCycleLen :: Hash -> Transaction (Maybe Word64)
getCycleLen Hash
h = do
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"\ngetCycleLen " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
Text.unpack (Text -> [Char]) -> (Base32Hex -> Text) -> Base32Hex -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base32Hex -> Text
Base32Hex.toText (Base32Hex -> [Char]) -> Base32Hex -> [Char]
forall a b. (a -> b) -> a -> b
$ Hash -> Base32Hex
H.toBase32Hex Hash
h)
  MaybeT Transaction Word64 -> Transaction (Maybe Word64)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    -- actually want Nothing in case of non term/decl component hash
    ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForAnyHash Hash
h)
    -- todo: decodeComponentLengthOnly is unintentionally a hack that relies on
    -- the fact the two things that references can refer to (term and decl
    -- components) have the same basic serialized structure: first a format
    -- byte that is always 0 for now, followed by a framed array representing
    -- the strongly-connected component. :grimace:
    Transaction Word64 -> MaybeT Transaction Word64
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ObjectId
-> (ByteString -> Either DecodeError Word64) -> Transaction Word64
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectObject ObjectId
oid ByteString -> Either DecodeError Word64
decodeComponentLengthOnly)

-- | Get the 'C.DeclType.DeclType' of a 'C.Reference.Id'.
expectDeclTypeById :: C.Reference.Id -> Transaction C.Decl.DeclType
expectDeclTypeById :: Id -> Transaction DeclType
expectDeclTypeById =
  (DeclR TypeRef Symbol -> DeclType)
-> Transaction (DeclR TypeRef Symbol) -> Transaction DeclType
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeclR TypeRef Symbol -> DeclType
forall r v. DeclR r v -> DeclType
C.Decl.declType (Transaction (DeclR TypeRef Symbol) -> Transaction DeclType)
-> (Id -> Transaction (DeclR TypeRef Symbol))
-> Id
-> Transaction DeclType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Transaction (DeclR TypeRef Symbol)
expectDeclByReference

componentByObjectId :: Db.ObjectId -> Transaction [S.Reference.Id]
componentByObjectId :: ObjectId -> Transaction [Id]
componentByObjectId ObjectId
id = do
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Operations.componentByObjectId " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ObjectId -> [Char]
forall a. Show a => a -> [Char]
show ObjectId
id
  Word64
len <- ObjectId
-> (ByteString -> Either DecodeError Word64) -> Transaction Word64
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectObject ObjectId
id ByteString -> Either DecodeError Word64
decodeComponentLengthOnly
  pure [ObjectId -> Word64 -> Id
forall h. h -> Word64 -> Id' h
C.Reference.Id ObjectId
id Word64
i | Word64
i <- [Word64
0 .. Word64
len Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1]]

-- * Codebase operations

-- ** Saving & loading terms

loadTermComponent :: H.Hash -> MaybeT Transaction [(C.Term Symbol, C.Term.Type Symbol)]
loadTermComponent :: Hash -> MaybeT Transaction [(Term Symbol, Type Symbol)]
loadTermComponent Hash
h = do
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForAnyHash Hash
h)
  S.Term.Term (S.Term.LocallyIndexedComponent Vector (LocalIds' TextId ObjectId, Term, Type)
elements) <- Transaction (Maybe (TermFormat' TextId ObjectId))
-> MaybeT Transaction (TermFormat' TextId ObjectId)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString -> Either DecodeError (TermFormat' TextId ObjectId))
-> Transaction (Maybe (TermFormat' TextId ObjectId))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadTermObject ObjectId
oid ByteString -> Either DecodeError (TermFormat' TextId ObjectId)
decodeTermFormat)
  Transaction [(Term Symbol, Type Symbol)]
-> MaybeT Transaction [(Term Symbol, Type Symbol)]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [(Term Symbol, Type Symbol)]
 -> MaybeT Transaction [(Term Symbol, Type Symbol)])
-> ([(LocalIds' TextId ObjectId, Term, Type)]
    -> Transaction [(Term Symbol, Type Symbol)])
-> [(LocalIds' TextId ObjectId, Term, Type)]
-> MaybeT Transaction [(Term Symbol, Type Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LocalIds' TextId ObjectId, Term, Type)
 -> Transaction (Term Symbol, Type Symbol))
-> [(LocalIds' TextId ObjectId, Term, Type)]
-> Transaction [(Term Symbol, Type Symbol)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((LocalIds' TextId ObjectId
 -> Term -> Type -> Transaction (Term Symbol, Type Symbol))
-> (LocalIds' TextId ObjectId, Term, Type)
-> Transaction (Term Symbol, Type Symbol)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 LocalIds' TextId ObjectId
-> Term -> Type -> Transaction (Term Symbol, Type Symbol)
Q.s2cTermWithType) ([(LocalIds' TextId ObjectId, Term, Type)]
 -> MaybeT Transaction [(Term Symbol, Type Symbol)])
-> [(LocalIds' TextId ObjectId, Term, Type)]
-> MaybeT Transaction [(Term Symbol, Type Symbol)]
forall a b. (a -> b) -> a -> b
$ Vector (LocalIds' TextId ObjectId, Term, Type)
-> [(LocalIds' TextId ObjectId, Term, Type)]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Vector (LocalIds' TextId ObjectId, Term, Type)
elements

loadTermWithTypeByReference :: C.Reference.Id -> MaybeT Transaction (C.Term Symbol, C.Term.Type Symbol)
loadTermWithTypeByReference :: Id -> MaybeT Transaction (Term Symbol, Type Symbol)
loadTermWithTypeByReference (C.Reference.Id Hash
h Word64
i) = do
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForPrimaryHash Hash
h)
  -- retrieve and deserialize the blob
  (LocalIds' TextId ObjectId
localIds, Term
term, Type
typ) <- Transaction (Maybe (LocalIds' TextId ObjectId, Term, Type))
-> MaybeT Transaction (LocalIds' TextId ObjectId, Term, Type)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Term, Type))
-> Transaction (Maybe (LocalIds' TextId ObjectId, Term, Type))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadTermObject ObjectId
oid (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Term, Type)
decodeTermElementWithType Word64
i))
  Transaction (Term Symbol, Type Symbol)
-> MaybeT Transaction (Term Symbol, Type Symbol)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalIds' TextId ObjectId
-> Term -> Type -> Transaction (Term Symbol, Type Symbol)
Q.s2cTermWithType LocalIds' TextId ObjectId
localIds Term
term Type
typ)

loadTermByReference :: C.Reference.Id -> MaybeT Transaction (C.Term Symbol)
loadTermByReference :: Id -> MaybeT Transaction (Term Symbol)
loadTermByReference r :: Id
r@(C.Reference.Id Hash
h Word64
i) = do
  Bool -> MaybeT Transaction () -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (MaybeT Transaction () -> MaybeT Transaction ())
-> ([Char] -> MaybeT Transaction ())
-> [Char]
-> MaybeT Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> MaybeT Transaction ())
-> [Char] -> MaybeT Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"loadTermByReference " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
r
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForPrimaryHash Hash
h)
  -- retrieve and deserialize the blob
  (LocalIds' TextId ObjectId
localIds, Term
term) <- Transaction (Maybe (LocalIds' TextId ObjectId, Term))
-> MaybeT Transaction (LocalIds' TextId ObjectId, Term)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Term))
-> Transaction (Maybe (LocalIds' TextId ObjectId, Term))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadTermObject ObjectId
oid (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Term)
decodeTermElementDiscardingType Word64
i))
  Transaction (Term Symbol) -> MaybeT Transaction (Term Symbol)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalIds' TextId ObjectId -> Term -> Transaction (Term Symbol)
s2cTerm LocalIds' TextId ObjectId
localIds Term
term)

loadTypeOfTermByTermReference :: C.Reference.Id -> MaybeT Transaction (C.Term.Type Symbol)
loadTypeOfTermByTermReference :: Id -> MaybeT Transaction (Type Symbol)
loadTypeOfTermByTermReference id :: Id
id@(C.Reference.Id Hash
h Word64
i) = do
  Bool -> MaybeT Transaction () -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (MaybeT Transaction () -> MaybeT Transaction ())
-> ([Char] -> MaybeT Transaction ())
-> [Char]
-> MaybeT Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> MaybeT Transaction ())
-> [Char] -> MaybeT Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"loadTypeOfTermByTermReference " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
id
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForPrimaryHash Hash
h)
  -- retrieve and deserialize the blob
  (LocalIds' TextId ObjectId
localIds, Type
typ) <- Transaction (Maybe (LocalIds' TextId ObjectId, Type))
-> MaybeT Transaction (LocalIds' TextId ObjectId, Type)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Type))
-> Transaction (Maybe (LocalIds' TextId ObjectId, Type))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadTermObject ObjectId
oid (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Type)
decodeTermElementDiscardingTerm Word64
i))
  Transaction (Type Symbol) -> MaybeT Transaction (Type Symbol)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalIds' TextId ObjectId -> Type -> Transaction (Type Symbol)
s2cTypeOfTerm LocalIds' TextId ObjectId
localIds Type
typ)

s2cTerm :: LocalIds -> S.Term.Term -> Transaction (C.Term Symbol)
s2cTerm :: LocalIds' TextId ObjectId -> Term -> Transaction (Term Symbol)
s2cTerm LocalIds' TextId ObjectId
ids Term
tm = do
  (LocalTextId -> Text
substText, LocalDefnId -> Hash
substHash) <- (TextId -> Transaction Text)
-> (ObjectId -> Transaction Hash)
-> LocalIds' TextId ObjectId
-> Transaction (LocalTextId -> Text, LocalDefnId -> Hash)
forall (m :: * -> *) t d.
Monad m =>
(t -> m Text)
-> (d -> m Hash)
-> LocalIds' t d
-> m (LocalTextId -> Text, LocalDefnId -> Hash)
Q.localIdsToLookups TextId -> Transaction Text
Q.expectText ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId LocalIds' TextId ObjectId
ids
  Term Symbol -> Transaction (Term Symbol)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Symbol -> Transaction (Term Symbol))
-> Term Symbol -> Transaction (Term Symbol)
forall a b. (a -> b) -> a -> b
$ (LocalTextId -> Text)
-> (LocalDefnId -> Hash) -> Term -> Term Symbol
Q.x2cTerm LocalTextId -> Text
substText LocalDefnId -> Hash
substHash Term
tm

s2cTypeOfTerm :: LocalIds -> S.Term.Type -> Transaction (C.Term.Type Symbol)
s2cTypeOfTerm :: LocalIds' TextId ObjectId -> Type -> Transaction (Type Symbol)
s2cTypeOfTerm LocalIds' TextId ObjectId
ids Type
tp = do
  (LocalTextId -> Text
substText, LocalDefnId -> Hash
substHash) <- (TextId -> Transaction Text)
-> (ObjectId -> Transaction Hash)
-> LocalIds' TextId ObjectId
-> Transaction (LocalTextId -> Text, LocalDefnId -> Hash)
forall (m :: * -> *) t d.
Monad m =>
(t -> m Text)
-> (d -> m Hash)
-> LocalIds' t d
-> m (LocalTextId -> Text, LocalDefnId -> Hash)
Q.localIdsToLookups TextId -> Transaction Text
Q.expectText ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId LocalIds' TextId ObjectId
ids
  Type Symbol -> Transaction (Type Symbol)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type Symbol -> Transaction (Type Symbol))
-> Type Symbol -> Transaction (Type Symbol)
forall a b. (a -> b) -> a -> b
$ (LocalTextId -> Text)
-> (LocalDefnId -> Hash) -> Type -> Type Symbol
Q.x2cTType LocalTextId -> Text
substText LocalDefnId -> Hash
substHash Type
tp

-- *** Watch expressions

listWatches :: WatchKind -> Transaction [C.Reference.Id]
listWatches :: WatchKind -> Transaction [Id]
listWatches WatchKind
k = WatchKind -> Transaction [IdH]
Q.loadWatchesByWatchKind WatchKind
k Transaction [IdH]
-> ([IdH] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IdH -> Transaction Id) -> [IdH] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse IdH -> Transaction Id
h2cReferenceId

-- | returns Nothing if the expression isn't cached.
loadWatch :: WatchKind -> C.Reference.Id -> MaybeT Transaction (C.Term Symbol)
loadWatch :: WatchKind -> Id -> MaybeT Transaction (Term Symbol)
loadWatch WatchKind
k Id
r = do
  IdH
r' <- (Hash -> MaybeT Transaction HashId) -> Id -> MaybeT Transaction IdH
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH (Transaction (Maybe HashId) -> MaybeT Transaction HashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe HashId) -> MaybeT Transaction HashId)
-> (Hash -> Transaction (Maybe HashId))
-> Hash
-> MaybeT Transaction HashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Transaction (Maybe HashId)
Q.loadHashIdByHash) Id
r
  S.Term.WatchResult WatchLocalIds
wlids Term
t <- Transaction (Maybe WatchResultFormat)
-> MaybeT Transaction WatchResultFormat
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WatchKind
-> IdH
-> (ByteString -> Either DecodeError WatchResultFormat)
-> Transaction (Maybe WatchResultFormat)
forall e a.
SqliteExceptionReason e =>
WatchKind
-> IdH -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadWatch WatchKind
k IdH
r' ByteString -> Either DecodeError WatchResultFormat
decodeWatchResultFormat)
  Transaction (Term Symbol) -> MaybeT Transaction (Term Symbol)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WatchLocalIds -> Term -> Transaction (Term Symbol)
w2cTerm WatchLocalIds
wlids Term
t)

saveWatch :: WatchKind -> C.Reference.Id -> C.Term Symbol -> Transaction ()
saveWatch :: WatchKind -> Id -> Term Symbol -> Transaction ()
saveWatch WatchKind
w Id
r Term Symbol
t = do
  IdH
rs <- (Hash -> Transaction HashId) -> Id -> Transaction IdH
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH Hash -> Transaction HashId
Q.saveHashHash Id
r
  (WatchLocalIds, Term)
wterm <- Term Symbol -> Transaction (WatchLocalIds, Term)
c2wTerm Term Symbol
t
  let bytes :: ByteString
bytes = Put WatchResultFormat -> WatchResultFormat -> ByteString
forall a. Put a -> a -> ByteString
S.putBytes WatchResultFormat -> m ()
Put WatchResultFormat
S.putWatchResultFormat ((WatchLocalIds -> Term -> WatchResultFormat)
-> (WatchLocalIds, Term) -> WatchResultFormat
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WatchLocalIds -> Term -> WatchResultFormat
S.Term.WatchResult (WatchLocalIds, Term)
wterm)
  WatchKind -> IdH -> ByteString -> Transaction ()
Q.saveWatch WatchKind
w IdH
rs ByteString
bytes

c2wTerm :: C.Term Symbol -> Transaction (WatchLocalIds, S.Term.Term)
c2wTerm :: Term Symbol -> Transaction (WatchLocalIds, Term)
c2wTerm Term Symbol
tm = (Text -> Transaction TextId)
-> (Hash -> Transaction HashId)
-> Term Symbol
-> Maybe (Type Symbol)
-> Transaction (WatchLocalIds, Term, Maybe Type)
forall (m :: * -> *) t d.
Monad m =>
(Text -> m t)
-> (Hash -> m d)
-> Term Symbol
-> Maybe (Type Symbol)
-> m (LocalIds' t d, Term, Maybe Type)
Q.c2xTerm Text -> Transaction TextId
Q.saveText Hash -> Transaction HashId
Q.saveHashHash Term Symbol
tm Maybe (Type Symbol)
forall a. Maybe a
Nothing Transaction (WatchLocalIds, Term, Maybe Type)
-> ((WatchLocalIds, Term, Maybe Type) -> (WatchLocalIds, Term))
-> Transaction (WatchLocalIds, Term)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(WatchLocalIds
w, Term
tm, Maybe Type
_) -> (WatchLocalIds
w, Term
tm)

w2cTerm :: WatchLocalIds -> S.Term.Term -> Transaction (C.Term Symbol)
w2cTerm :: WatchLocalIds -> Term -> Transaction (Term Symbol)
w2cTerm WatchLocalIds
ids Term
tm = do
  (LocalTextId -> Text
substText, LocalDefnId -> Hash
substHash) <- (TextId -> Transaction Text)
-> (HashId -> Transaction Hash)
-> WatchLocalIds
-> Transaction (LocalTextId -> Text, LocalDefnId -> Hash)
forall (m :: * -> *) t d.
Monad m =>
(t -> m Text)
-> (d -> m Hash)
-> LocalIds' t d
-> m (LocalTextId -> Text, LocalDefnId -> Hash)
Q.localIdsToLookups TextId -> Transaction Text
Q.expectText HashId -> Transaction Hash
Q.expectHash WatchLocalIds
ids
  Term Symbol -> Transaction (Term Symbol)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Symbol -> Transaction (Term Symbol))
-> Term Symbol -> Transaction (Term Symbol)
forall a b. (a -> b) -> a -> b
$ (LocalTextId -> Text)
-> (LocalDefnId -> Hash) -> Term -> Term Symbol
Q.x2cTerm LocalTextId -> Text
substText LocalDefnId -> Hash
substHash Term
tm

-- ** Saving & loading type decls

loadDeclComponent :: H.Hash -> MaybeT Transaction [C.Decl Symbol]
loadDeclComponent :: Hash -> MaybeT Transaction [DeclR TypeRef Symbol]
loadDeclComponent Hash
h = do
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForAnyHash Hash
h)
  S.Decl.Decl (S.Decl.LocallyIndexedComponent Vector (LocalIds' TextId ObjectId, Decl Symbol)
elements) <- Transaction (Maybe (DeclFormat' TextId ObjectId))
-> MaybeT Transaction (DeclFormat' TextId ObjectId)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString -> Either DecodeError (DeclFormat' TextId ObjectId))
-> Transaction (Maybe (DeclFormat' TextId ObjectId))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadDeclObject ObjectId
oid ByteString -> Either DecodeError (DeclFormat' TextId ObjectId)
decodeDeclFormat)
  Transaction [DeclR TypeRef Symbol]
-> MaybeT Transaction [DeclR TypeRef Symbol]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [DeclR TypeRef Symbol]
 -> MaybeT Transaction [DeclR TypeRef Symbol])
-> ([(LocalIds' TextId ObjectId, Decl Symbol)]
    -> Transaction [DeclR TypeRef Symbol])
-> [(LocalIds' TextId ObjectId, Decl Symbol)]
-> MaybeT Transaction [DeclR TypeRef Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LocalIds' TextId ObjectId, Decl Symbol)
 -> Transaction (DeclR TypeRef Symbol))
-> [(LocalIds' TextId ObjectId, Decl Symbol)]
-> Transaction [DeclR TypeRef Symbol]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((LocalIds' TextId ObjectId
 -> Decl Symbol -> Transaction (DeclR TypeRef Symbol))
-> (LocalIds' TextId ObjectId, Decl Symbol)
-> Transaction (DeclR TypeRef Symbol)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LocalIds' TextId ObjectId
-> Decl Symbol -> Transaction (DeclR TypeRef Symbol)
Q.s2cDecl) ([(LocalIds' TextId ObjectId, Decl Symbol)]
 -> MaybeT Transaction [DeclR TypeRef Symbol])
-> [(LocalIds' TextId ObjectId, Decl Symbol)]
-> MaybeT Transaction [DeclR TypeRef Symbol]
forall a b. (a -> b) -> a -> b
$ Vector (LocalIds' TextId ObjectId, Decl Symbol)
-> [(LocalIds' TextId ObjectId, Decl Symbol)]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Vector (LocalIds' TextId ObjectId, Decl Symbol)
elements

loadDeclByReference :: C.Reference.Id -> MaybeT Transaction (C.Decl Symbol)
loadDeclByReference :: Id -> MaybeT Transaction (DeclR TypeRef Symbol)
loadDeclByReference r :: Id
r@(C.Reference.Id Hash
h Word64
i) = do
  Bool -> MaybeT Transaction () -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (MaybeT Transaction () -> MaybeT Transaction ())
-> ([Char] -> MaybeT Transaction ())
-> [Char]
-> MaybeT Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> MaybeT Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> MaybeT Transaction ())
-> [Char] -> MaybeT Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"loadDeclByReference " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
r
  ObjectId
oid <- Transaction (Maybe ObjectId) -> MaybeT Transaction ObjectId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Hash -> Transaction (Maybe ObjectId)
Q.loadObjectIdForPrimaryHash Hash
h)
  (LocalIds' TextId ObjectId
localIds, Decl Symbol
decl) <- Transaction (Maybe (LocalIds' TextId ObjectId, Decl Symbol))
-> MaybeT Transaction (LocalIds' TextId ObjectId, Decl Symbol)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol))
-> Transaction (Maybe (LocalIds' TextId ObjectId, Decl Symbol))
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a)
Q.loadDeclObject ObjectId
oid (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol)
decodeDeclElement Word64
i))
  Transaction (DeclR TypeRef Symbol)
-> MaybeT Transaction (DeclR TypeRef Symbol)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocalIds' TextId ObjectId
-> Decl Symbol -> Transaction (DeclR TypeRef Symbol)
Q.s2cDecl LocalIds' TextId ObjectId
localIds Decl Symbol
decl)

expectDeclByReference :: C.Reference.Id -> Transaction (C.Decl Symbol)
expectDeclByReference :: Id -> Transaction (DeclR TypeRef Symbol)
expectDeclByReference r :: Id
r@(C.Reference.Id Hash
h Word64
i) = do
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"expectDeclByReference " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
r
  -- retrieve the blob
  Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash Hash
h
    Transaction ObjectId
-> (ObjectId
    -> Transaction (LocalIds' TextId ObjectId, Decl Symbol))
-> Transaction (LocalIds' TextId ObjectId, Decl Symbol)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ObjectId
oid -> ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol))
-> Transaction (LocalIds' TextId ObjectId, Decl Symbol)
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectDeclObject ObjectId
oid (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol)
decodeDeclElement Word64
i))
    Transaction (LocalIds' TextId ObjectId, Decl Symbol)
-> ((LocalIds' TextId ObjectId, Decl Symbol)
    -> Transaction (DeclR TypeRef Symbol))
-> Transaction (DeclR TypeRef Symbol)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LocalIds' TextId ObjectId
 -> Decl Symbol -> Transaction (DeclR TypeRef Symbol))
-> (LocalIds' TextId ObjectId, Decl Symbol)
-> Transaction (DeclR TypeRef Symbol)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LocalIds' TextId ObjectId
-> Decl Symbol -> Transaction (DeclR TypeRef Symbol)
Q.s2cDecl

expectDeclNumConstructors :: C.Reference.Id -> Transaction Int
expectDeclNumConstructors :: Id -> Transaction Int
expectDeclNumConstructors (C.Reference.Id Hash
h Word64
i) = do
  ObjectId
oid <- Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash Hash
h
  ObjectId
-> (ByteString -> Either DecodeError Int) -> Transaction Int
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectDeclObject ObjectId
oid (Word64 -> ByteString -> Either DecodeError Int
decodeDeclElementNumConstructors Word64
i)

-- * Branch transformation

s2cBranch :: S.DbBranch -> Transaction (C.Branch.Branch Transaction)
s2cBranch :: Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction (Branch Transaction)
s2cBranch (S.Branch.Full.Branch Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
tms Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
tps Map TextId PatchObjectId
patches Map TextId (BranchObjectId, CausalHashId)
children) =
  Map NameSegment (Map Referent (Transaction MdValues))
-> Map NameSegment (Map Reference (Transaction MdValues))
-> Map NameSegment (PatchHash, Transaction Patch)
-> Map NameSegment (CausalBranch Transaction)
-> Branch Transaction
forall (m :: * -> *).
Map NameSegment (Map Referent (m MdValues))
-> Map NameSegment (Map Reference (m MdValues))
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment (CausalBranch m)
-> Branch m
C.Branch.Branch
    (Map NameSegment (Map Referent (Transaction MdValues))
 -> Map NameSegment (Map Reference (Transaction MdValues))
 -> Map NameSegment (PatchHash, Transaction Patch)
 -> Map NameSegment (CausalBranch Transaction)
 -> Branch Transaction)
-> Transaction
     (Map NameSegment (Map Referent (Transaction MdValues)))
-> Transaction
     (Map NameSegment (Map Reference (Transaction MdValues))
      -> Map NameSegment (PatchHash, Transaction Patch)
      -> Map NameSegment (CausalBranch Transaction)
      -> Branch Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Referent (Transaction MdValues)))
doTerms Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
tms
    Transaction
  (Map NameSegment (Map Reference (Transaction MdValues))
   -> Map NameSegment (PatchHash, Transaction Patch)
   -> Map NameSegment (CausalBranch Transaction)
   -> Branch Transaction)
-> Transaction
     (Map NameSegment (Map Reference (Transaction MdValues)))
-> Transaction
     (Map NameSegment (PatchHash, Transaction Patch)
      -> Map NameSegment (CausalBranch Transaction)
      -> Branch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Reference (Transaction MdValues)))
doTypes Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
tps
    Transaction
  (Map NameSegment (PatchHash, Transaction Patch)
   -> Map NameSegment (CausalBranch Transaction)
   -> Branch Transaction)
-> Transaction (Map NameSegment (PatchHash, Transaction Patch))
-> Transaction
     (Map NameSegment (CausalBranch Transaction) -> Branch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map TextId PatchObjectId
-> Transaction (Map NameSegment (PatchHash, Transaction Patch))
doPatches Map TextId PatchObjectId
patches
    Transaction
  (Map NameSegment (CausalBranch Transaction) -> Branch Transaction)
-> Transaction (Map NameSegment (CausalBranch Transaction))
-> Transaction (Branch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map TextId (BranchObjectId, CausalHashId)
-> Transaction (Map NameSegment (CausalBranch Transaction))
doChildren Map TextId (BranchObjectId, CausalHashId)
children
  where
    doTerms ::
      Map Db.TextId (Map S.Referent S.DbMetadataSet) ->
      Transaction (Map NameSegment (Map C.Referent (Transaction C.Branch.MdValues)))
    doTerms :: Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Referent (Transaction MdValues)))
doTerms =
      (TextId -> Transaction NameSegment)
-> (Map
      (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
    -> Transaction (Map Referent (Transaction MdValues)))
-> Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Referent (Transaction MdValues)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse
        TextId -> Transaction NameSegment
Q.expectNameSegment
        ( (Referent'' TextId ObjectId -> Transaction Referent)
-> (MetadataSetFormat' TextId ObjectId
    -> Transaction (Transaction MdValues))
-> Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
-> Transaction (Map Referent (Transaction MdValues))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Referent'' TextId ObjectId -> Transaction Referent
s2cReferent \case
            S.MetadataSet.Inline Set Reference
rs ->
              Transaction MdValues -> Transaction (Transaction MdValues)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transaction MdValues -> Transaction (Transaction MdValues))
-> Transaction MdValues -> Transaction (Transaction MdValues)
forall a b. (a -> b) -> a -> b
$ Set Reference -> MdValues
C.Branch.MdValues (Set Reference -> MdValues)
-> Transaction (Set Reference) -> Transaction MdValues
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
s2cReference Set Reference
rs
        )
    doTypes ::
      Map Db.TextId (Map S.Reference S.DbMetadataSet) ->
      Transaction (Map NameSegment (Map C.Reference (Transaction C.Branch.MdValues)))
    doTypes :: Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Reference (Transaction MdValues)))
doTypes =
      (TextId -> Transaction NameSegment)
-> (Map Reference (MetadataSetFormat' TextId ObjectId)
    -> Transaction (Map Reference (Transaction MdValues)))
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Transaction
     (Map NameSegment (Map Reference (Transaction MdValues)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse
        TextId -> Transaction NameSegment
Q.expectNameSegment
        ( (Reference -> Transaction Reference)
-> (MetadataSetFormat' TextId ObjectId
    -> Transaction (Transaction MdValues))
-> Map Reference (MetadataSetFormat' TextId ObjectId)
-> Transaction (Map Reference (Transaction MdValues))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Reference -> Transaction Reference
s2cReference \case
            S.MetadataSet.Inline Set Reference
rs ->
              Transaction MdValues -> Transaction (Transaction MdValues)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transaction MdValues -> Transaction (Transaction MdValues))
-> Transaction MdValues -> Transaction (Transaction MdValues)
forall a b. (a -> b) -> a -> b
$ Set Reference -> MdValues
C.Branch.MdValues (Set Reference -> MdValues)
-> Transaction (Set Reference) -> Transaction MdValues
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
s2cReference Set Reference
rs
        )
    doPatches ::
      Map Db.TextId Db.PatchObjectId ->
      Transaction (Map NameSegment (PatchHash, Transaction C.Branch.Patch))
    doPatches :: Map TextId PatchObjectId
-> Transaction (Map NameSegment (PatchHash, Transaction Patch))
doPatches = (TextId -> Transaction NameSegment)
-> (PatchObjectId -> Transaction (PatchHash, Transaction Patch))
-> Map TextId PatchObjectId
-> Transaction (Map NameSegment (PatchHash, Transaction Patch))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse TextId -> Transaction NameSegment
Q.expectNameSegment \PatchObjectId
patchId -> do
      PatchHash
h <- Hash -> PatchHash
PatchHash (Hash -> PatchHash) -> Transaction Hash -> Transaction PatchHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId (ObjectId -> Transaction Hash)
-> (PatchObjectId -> ObjectId) -> PatchObjectId -> Transaction Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchObjectId -> ObjectId
Db.unPatchObjectId) PatchObjectId
patchId
      pure (PatchHash
h, PatchObjectId -> Transaction Patch
expectPatch PatchObjectId
patchId)

    doChildren ::
      Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) ->
      Transaction (Map NameSegment (C.Branch.CausalBranch Transaction))
    doChildren :: Map TextId (BranchObjectId, CausalHashId)
-> Transaction (Map NameSegment (CausalBranch Transaction))
doChildren = (TextId -> Transaction NameSegment)
-> ((BranchObjectId, CausalHashId)
    -> Transaction (CausalBranch Transaction))
-> Map TextId (BranchObjectId, CausalHashId)
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse TextId -> Transaction NameSegment
Q.expectNameSegment \(BranchObjectId
boId, CausalHashId
chId) ->
      CausalHash
-> BranchHash
-> Map CausalHash (Transaction (CausalBranch Transaction))
-> Transaction (Branch Transaction)
-> CausalBranch Transaction
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
C.Causal
        (CausalHash
 -> BranchHash
 -> Map CausalHash (Transaction (CausalBranch Transaction))
 -> Transaction (Branch Transaction)
 -> CausalBranch Transaction)
-> Transaction CausalHash
-> Transaction
     (BranchHash
      -> Map CausalHash (Transaction (CausalBranch Transaction))
      -> Transaction (Branch Transaction)
      -> CausalBranch Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
chId
        Transaction
  (BranchHash
   -> Map CausalHash (Transaction (CausalBranch Transaction))
   -> Transaction (Branch Transaction)
   -> CausalBranch Transaction)
-> Transaction BranchHash
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction))
      -> Transaction (Branch Transaction) -> CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CausalHashId -> Transaction BranchHash
expectValueHashByCausalHashId CausalHashId
chId
        Transaction
  (Map CausalHash (Transaction (CausalBranch Transaction))
   -> Transaction (Branch Transaction) -> CausalBranch Transaction)
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
-> Transaction
     (Transaction (Branch Transaction) -> CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CausalHashId
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
headParents CausalHashId
chId
        Transaction
  (Transaction (Branch Transaction) -> CausalBranch Transaction)
-> Transaction (Transaction (Branch Transaction))
-> Transaction (CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Transaction (Branch Transaction)
-> Transaction (Transaction (Branch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchObjectId -> Transaction (Branch Transaction)
expectBranch BranchObjectId
boId)
      where
        headParents :: Db.CausalHashId -> Transaction (Map CausalHash (Transaction (C.Branch.CausalBranch Transaction)))
        headParents :: CausalHashId
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
headParents CausalHashId
chId = do
          [CausalHashId]
parentsChIds <- CausalHashId -> Transaction [CausalHashId]
Q.loadCausalParents CausalHashId
chId
          ([(CausalHash, Transaction (CausalBranch Transaction))]
 -> Map CausalHash (Transaction (CausalBranch Transaction)))
-> Transaction
     [(CausalHash, Transaction (CausalBranch Transaction))]
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(CausalHash, Transaction (CausalBranch Transaction))]
-> Map CausalHash (Transaction (CausalBranch Transaction))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Transaction [(CausalHash, Transaction (CausalBranch Transaction))]
 -> Transaction
      (Map CausalHash (Transaction (CausalBranch Transaction))))
-> Transaction
     [(CausalHash, Transaction (CausalBranch Transaction))]
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
forall a b. (a -> b) -> a -> b
$ (CausalHashId
 -> Transaction
      (CausalHash, Transaction (CausalBranch Transaction)))
-> [CausalHashId]
-> Transaction
     [(CausalHash, Transaction (CausalBranch Transaction))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse CausalHashId
-> Transaction (CausalHash, Transaction (CausalBranch Transaction))
pairParent [CausalHashId]
parentsChIds
        pairParent :: Db.CausalHashId -> Transaction (CausalHash, Transaction (C.Branch.CausalBranch Transaction))
        pairParent :: CausalHashId
-> Transaction (CausalHash, Transaction (CausalBranch Transaction))
pairParent CausalHashId
chId = do
          CausalHash
h <- CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
chId
          pure (CausalHash
h, CausalHashId -> Transaction (CausalBranch Transaction)
loadCausal CausalHashId
chId)
        loadCausal :: Db.CausalHashId -> Transaction (C.Branch.CausalBranch Transaction)
        loadCausal :: CausalHashId -> Transaction (CausalBranch Transaction)
loadCausal CausalHashId
chId = do
          CausalHash
-> BranchHash
-> Map CausalHash (Transaction (CausalBranch Transaction))
-> Transaction (Branch Transaction)
-> CausalBranch Transaction
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
C.Causal
            (CausalHash
 -> BranchHash
 -> Map CausalHash (Transaction (CausalBranch Transaction))
 -> Transaction (Branch Transaction)
 -> CausalBranch Transaction)
-> Transaction CausalHash
-> Transaction
     (BranchHash
      -> Map CausalHash (Transaction (CausalBranch Transaction))
      -> Transaction (Branch Transaction)
      -> CausalBranch Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
chId
            Transaction
  (BranchHash
   -> Map CausalHash (Transaction (CausalBranch Transaction))
   -> Transaction (Branch Transaction)
   -> CausalBranch Transaction)
-> Transaction BranchHash
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction))
      -> Transaction (Branch Transaction) -> CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CausalHashId -> Transaction BranchHash
expectValueHashByCausalHashId CausalHashId
chId
            Transaction
  (Map CausalHash (Transaction (CausalBranch Transaction))
   -> Transaction (Branch Transaction) -> CausalBranch Transaction)
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
-> Transaction
     (Transaction (Branch Transaction) -> CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CausalHashId
-> Transaction
     (Map CausalHash (Transaction (CausalBranch Transaction)))
headParents CausalHashId
chId
            Transaction
  (Transaction (Branch Transaction) -> CausalBranch Transaction)
-> Transaction (Transaction (Branch Transaction))
-> Transaction (CausalBranch Transaction)
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Transaction (Branch Transaction)
-> Transaction (Transaction (Branch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CausalHashId -> Transaction (Branch Transaction)
loadValue CausalHashId
chId)
        loadValue :: Db.CausalHashId -> Transaction (C.Branch.Branch Transaction)
        loadValue :: CausalHashId -> Transaction (Branch Transaction)
loadValue CausalHashId
chId = do
          BranchObjectId
boId <- CausalHashId -> Transaction BranchObjectId
Q.expectBranchObjectIdByCausalHashId CausalHashId
chId
          BranchObjectId -> Transaction (Branch Transaction)
expectBranch BranchObjectId
boId

-- saveBranch is kind of a "deep save causal"

-- we want a "shallow save causal" that could take a
--   forall m e. Causal m CausalHash BranchHash e
--
-- data Identity a = Identity
-- e == ()
--
-- data C.Branch m = Branch
--   { terms    :: Map NameSegment (Map Referent (m MdValues)),
--     types    :: Map NameSegment (Map Reference (m MdValues)),
--     patches  :: Map NameSegment (PatchHash, m Patch),
--     children :: Map NameSegment (Causal m)
--   }
--
-- U.Codebase.Sqlite.Branch.Full.Branch'
-- type ShallowBranch = Branch' NameSegment Hash PatchHash CausalHash
-- data ShallowBranch causalHash patchHash = ShallowBranch
--   { terms    :: Map NameSegment (Map Referent MdValues),
--     types    :: Map NameSegment (Map Reference MdValues),
--     patches  :: Map NameSegment patchHash,
--     children :: Map NameSegment causalHash
--   }
--
-- data Causal m hc he e = Causal
--  { causalHash :: hc,
--    valueHash :: he,
--    parents :: Map hc (m (Causal m hc he e)),
--    value :: m e
--  }
-- data ShallowCausal causalHash branchHash = ShallowCausal
--  { causalHash :: causalHash,
--    valueHash :: branchHash,
--    parents :: Set causalHash,
--  }
--
-- References, but also values
-- Shallow - Hash? representation of the database relationships

-- A couple small internal helper type that unifies V2 and V3 branches. This should be used as input to operations that
-- can work on either kind of branch.

data BranchV m
  = BranchV2 !(C.Branch.Branch m)
  | BranchV3 !(C.BranchV3.BranchV3 m)

data DbBranchV
  = DbBranchV2 !S.DbBranch
  | DbBranchV3 !S.DbBranchV3

saveBranch ::
  HashHandle ->
  C.Branch.CausalBranch Transaction ->
  Transaction (Db.BranchObjectId, Db.CausalHashId)
saveBranch :: HashHandle
-> CausalBranch Transaction
-> Transaction (BranchObjectId, CausalHashId)
saveBranch HashHandle
hh causal :: CausalBranch Transaction
causal@(C.Causal CausalHash
hc BranchHash
he Map CausalHash (Transaction (CausalBranch Transaction))
parents Transaction (Branch Transaction)
me) = do
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"\nOperations.saveBranch \n  hc = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CausalHash -> [Char]
forall a. Show a => a -> [Char]
show CausalHash
hc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
",\n  he = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BranchHash -> [Char]
forall a. Show a => a -> [Char]
show BranchHash
he [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
",\n  parents = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [CausalHash] -> [Char]
forall a. Show a => a -> [Char]
show (Map CausalHash (Transaction (CausalBranch Transaction))
-> [CausalHash]
forall k a. Map k a -> [k]
Map.keys Map CausalHash (Transaction (CausalBranch Transaction))
parents)
  (CausalHashId
chId, BranchHashId
bhId) <- HashHandle
-> CausalBranch Transaction
-> Transaction (CausalHashId, BranchHashId)
forall branch.
HashHandle
-> Causal
     Transaction CausalHash BranchHash (Branch Transaction) branch
-> Transaction (CausalHashId, BranchHashId)
saveCausalObject HashHandle
hh CausalBranch Transaction
causal
  BranchObjectId
boId <- HashHandle
-> BranchHashId
-> Transaction (BranchV Transaction)
-> Transaction BranchObjectId
saveNamespace HashHandle
hh BranchHashId
bhId (Branch Transaction -> BranchV Transaction
forall (m :: * -> *). Branch m -> BranchV m
BranchV2 (Branch Transaction -> BranchV Transaction)
-> Transaction (Branch Transaction)
-> Transaction (BranchV Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transaction (Branch Transaction)
me)
  pure (BranchObjectId
boId, CausalHashId
chId)

saveBranchV3 :: HashHandle -> C.BranchV3.CausalBranchV3 Transaction -> Transaction (Db.BranchObjectId, Db.CausalHashId)
saveBranchV3 :: HashHandle
-> CausalBranchV3 Transaction
-> Transaction (BranchObjectId, CausalHashId)
saveBranchV3 HashHandle
hh CausalBranchV3 Transaction
causal = do
  (CausalHashId
chId, BranchHashId
bhId) <- HashHandle
-> CausalBranchV3 Transaction
-> Transaction (CausalHashId, BranchHashId)
forall branch.
HashHandle
-> Causal
     Transaction CausalHash BranchHash (Branch Transaction) branch
-> Transaction (CausalHashId, BranchHashId)
saveCausalObject HashHandle
hh CausalBranchV3 Transaction
causal
  BranchObjectId
boId <- HashHandle
-> BranchHashId
-> Transaction (BranchV Transaction)
-> Transaction BranchObjectId
saveNamespace HashHandle
hh BranchHashId
bhId (BranchV3 Transaction -> BranchV Transaction
forall (m :: * -> *). BranchV3 m -> BranchV m
BranchV3 (BranchV3 Transaction -> BranchV Transaction)
-> Transaction (BranchV3 Transaction)
-> Transaction (BranchV Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CausalBranchV3 Transaction
causal CausalBranchV3 Transaction
-> Getting
     (Transaction (BranchV3 Transaction))
     (CausalBranchV3 Transaction)
     (Transaction (BranchV3 Transaction))
-> Transaction (BranchV3 Transaction)
forall s a. s -> Getting a s a -> a
^. Getting
  (Transaction (BranchV3 Transaction))
  (CausalBranchV3 Transaction)
  (Transaction (BranchV3 Transaction))
#value))
  pure (BranchObjectId
boId, CausalHashId
chId)

-- Save a namespace. Internal helper shared by `saveBranch` ("save V2 namespace") and `saveBranchV3`
-- ("save V3 namespace").
saveNamespace :: HashHandle -> Db.BranchHashId -> Transaction (BranchV Transaction) -> Transaction Db.BranchObjectId
saveNamespace :: HashHandle
-> BranchHashId
-> Transaction (BranchV Transaction)
-> Transaction BranchObjectId
saveNamespace HashHandle
hh BranchHashId
bhId Transaction (BranchV Transaction)
me = do
  BranchHashId -> Transaction (Maybe BranchObjectId)
Q.loadBranchObjectIdByBranchHashId BranchHashId
bhId Transaction (Maybe BranchObjectId)
-> (Transaction (Maybe BranchObjectId)
    -> Transaction BranchObjectId)
-> Transaction BranchObjectId
forall a b. a -> (a -> b) -> b
& Transaction BranchObjectId
-> Transaction (Maybe BranchObjectId) -> Transaction BranchObjectId
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
    BranchV Transaction
branch <- Transaction (BranchV Transaction)
me
    DbBranchV
dbBranch <- BranchV Transaction -> Transaction DbBranchV
c2sBranch BranchV Transaction
branch
    NamespaceStats
stats <- DbBranchV -> Transaction NamespaceStats
namespaceStatsForDbBranch DbBranchV
dbBranch
    HashHandle
-> BranchHashId
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
saveDbBranchUnderHashId HashHandle
hh BranchHashId
bhId NamespaceStats
stats DbBranchV
dbBranch
  where
    c2sBranch :: BranchV Transaction -> Transaction DbBranchV
    c2sBranch :: BranchV Transaction -> Transaction DbBranchV
c2sBranch = \case
      BranchV2 Branch Transaction
branch -> do
        Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms <- (NameSegment -> Transaction TextId)
-> (Map Referent (Transaction MdValues)
    -> Transaction
         (Map
            (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
-> Map NameSegment (Map Referent (Transaction MdValues))
-> Transaction
     (Map
        TextId
        (Map
           (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment ((Referent -> Transaction (Referent'' TextId ObjectId))
-> (Transaction MdValues
    -> Transaction (MetadataSetFormat' TextId ObjectId))
-> Map Referent (Transaction MdValues)
-> Transaction
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Referent -> Transaction (Referent'' TextId ObjectId)
c2sReferent Transaction MdValues
-> Transaction (MetadataSetFormat' TextId ObjectId)
c2sMetadata) (Branch Transaction
branch Branch Transaction
-> Getting
     (Map NameSegment (Map Referent (Transaction MdValues)))
     (Branch Transaction)
     (Map NameSegment (Map Referent (Transaction MdValues)))
-> Map NameSegment (Map Referent (Transaction MdValues))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Map Referent (Transaction MdValues)))
  (Branch Transaction)
  (Map NameSegment (Map Referent (Transaction MdValues)))
#terms)
        Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types <- (NameSegment -> Transaction TextId)
-> (Map Reference (Transaction MdValues)
    -> Transaction
         (Map Reference (MetadataSetFormat' TextId ObjectId)))
-> Map NameSegment (Map Reference (Transaction MdValues))
-> Transaction
     (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId)))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment ((Reference -> Transaction Reference)
-> (Transaction MdValues
    -> Transaction (MetadataSetFormat' TextId ObjectId))
-> Map Reference (Transaction MdValues)
-> Transaction (Map Reference (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Reference -> Transaction Reference
c2sReference Transaction MdValues
-> Transaction (MetadataSetFormat' TextId ObjectId)
c2sMetadata) (Branch Transaction
branch Branch Transaction
-> Getting
     (Map NameSegment (Map Reference (Transaction MdValues)))
     (Branch Transaction)
     (Map NameSegment (Map Reference (Transaction MdValues)))
-> Map NameSegment (Map Reference (Transaction MdValues))
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Map Reference (Transaction MdValues)))
  (Branch Transaction)
  (Map NameSegment (Map Reference (Transaction MdValues)))
#types)
        Map TextId PatchObjectId
patches <- (NameSegment -> Transaction TextId)
-> ((PatchHash, Transaction Patch) -> Transaction PatchObjectId)
-> Map NameSegment (PatchHash, Transaction Patch)
-> Transaction (Map TextId PatchObjectId)
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment (PatchHash, Transaction Patch) -> Transaction PatchObjectId
savePatchObjectId (Branch Transaction
branch Branch Transaction
-> Getting
     (Map NameSegment (PatchHash, Transaction Patch))
     (Branch Transaction)
     (Map NameSegment (PatchHash, Transaction Patch))
-> Map NameSegment (PatchHash, Transaction Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, Transaction Patch))
  (Branch Transaction)
  (Map NameSegment (PatchHash, Transaction Patch))
#patches)
        Map TextId (BranchObjectId, CausalHashId)
children <- (NameSegment -> Transaction TextId)
-> (CausalBranch Transaction
    -> Transaction (BranchObjectId, CausalHashId))
-> Map NameSegment (CausalBranch Transaction)
-> Transaction (Map TextId (BranchObjectId, CausalHashId))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment (HashHandle
-> CausalBranch Transaction
-> Transaction (BranchObjectId, CausalHashId)
saveBranch HashHandle
hh) (Branch Transaction
branch Branch Transaction
-> Getting
     (Map NameSegment (CausalBranch Transaction))
     (Branch Transaction)
     (Map NameSegment (CausalBranch Transaction))
-> Map NameSegment (CausalBranch Transaction)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (CausalBranch Transaction))
  (Branch Transaction)
  (Map NameSegment (CausalBranch Transaction))
#children)
        pure (Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> DbBranchV
DbBranchV2 S.Branch {Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms :: Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
$sel:terms:Branch :: Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms, Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types :: Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
$sel:types:Branch :: Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types, Map TextId PatchObjectId
patches :: Map TextId PatchObjectId
$sel:patches:Branch :: Map TextId PatchObjectId
patches, Map TextId (BranchObjectId, CausalHashId)
$sel:children:Branch :: Map TextId (BranchObjectId, CausalHashId)
children :: Map TextId (BranchObjectId, CausalHashId)
children})
      BranchV3 BranchV3 Transaction
branch -> do
        Map TextId (BranchObjectId, CausalHashId)
children <- (NameSegment -> Transaction TextId)
-> (CausalBranchV3 Transaction
    -> Transaction (BranchObjectId, CausalHashId))
-> Map NameSegment (CausalBranchV3 Transaction)
-> Transaction (Map TextId (BranchObjectId, CausalHashId))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment (HashHandle
-> CausalBranchV3 Transaction
-> Transaction (BranchObjectId, CausalHashId)
saveBranchV3 HashHandle
hh) (BranchV3 Transaction
branch BranchV3 Transaction
-> Getting
     (Map NameSegment (CausalBranchV3 Transaction))
     (BranchV3 Transaction)
     (Map NameSegment (CausalBranchV3 Transaction))
-> Map NameSegment (CausalBranchV3 Transaction)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (CausalBranchV3 Transaction))
  (BranchV3 Transaction)
  (Map NameSegment (CausalBranchV3 Transaction))
#children)
        Map TextId (Referent'' TextId ObjectId)
terms <- (NameSegment -> Transaction TextId)
-> (Referent -> Transaction (Referent'' TextId ObjectId))
-> Map NameSegment Referent
-> Transaction (Map TextId (Referent'' TextId ObjectId))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment Referent -> Transaction (Referent'' TextId ObjectId)
c2sReferent (BranchV3 Transaction
branch BranchV3 Transaction
-> Getting
     (Map NameSegment Referent)
     (BranchV3 Transaction)
     (Map NameSegment Referent)
-> Map NameSegment Referent
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment Referent)
  (BranchV3 Transaction)
  (Map NameSegment Referent)
#terms)
        Map TextId Reference
types <- (NameSegment -> Transaction TextId)
-> (Reference -> Transaction Reference)
-> Map NameSegment Reference
-> Transaction (Map TextId Reference)
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse NameSegment -> Transaction TextId
Q.saveNameSegment Reference -> Transaction Reference
c2sReference (BranchV3 Transaction
branch BranchV3 Transaction
-> Getting
     (Map NameSegment Reference)
     (BranchV3 Transaction)
     (Map NameSegment Reference)
-> Map NameSegment Reference
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment Reference)
  (BranchV3 Transaction)
  (Map NameSegment Reference)
#types)
        pure (DbBranchV3 -> DbBranchV
DbBranchV3 S.BranchV3 {Map TextId (BranchObjectId, CausalHashId)
children :: Map TextId (BranchObjectId, CausalHashId)
$sel:children:BranchV3 :: Map TextId (BranchObjectId, CausalHashId)
children, Map TextId (Referent'' TextId ObjectId)
terms :: Map TextId (Referent'' TextId ObjectId)
$sel:terms:BranchV3 :: Map TextId (Referent'' TextId ObjectId)
terms, Map TextId Reference
types :: Map TextId Reference
$sel:types:BranchV3 :: Map TextId Reference
types})

    c2sMetadata :: Transaction C.Branch.MdValues -> Transaction S.Branch.Full.DbMetadataSet
    c2sMetadata :: Transaction MdValues
-> Transaction (MetadataSetFormat' TextId ObjectId)
c2sMetadata Transaction MdValues
mm = do
      C.Branch.MdValues Set Reference
m <- Transaction MdValues
mm
      Set Reference -> MetadataSetFormat' TextId ObjectId
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
S.Branch.Full.Inline (Set Reference -> MetadataSetFormat' TextId ObjectId)
-> Transaction (Set Reference)
-> Transaction (MetadataSetFormat' TextId ObjectId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
c2sReference Set Reference
m

    savePatchObjectId :: (PatchHash, Transaction C.Branch.Patch) -> Transaction Db.PatchObjectId
    savePatchObjectId :: (PatchHash, Transaction Patch) -> Transaction PatchObjectId
savePatchObjectId (PatchHash
h, Transaction Patch
mp) = do
      PatchHash -> Transaction (Maybe PatchObjectId)
Q.loadPatchObjectIdForPrimaryHash PatchHash
h Transaction (Maybe PatchObjectId)
-> (Transaction (Maybe PatchObjectId) -> Transaction PatchObjectId)
-> Transaction PatchObjectId
forall a b. a -> (a -> b) -> b
& Transaction PatchObjectId
-> Transaction (Maybe PatchObjectId) -> Transaction PatchObjectId
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
        Patch
patch <- Transaction Patch
mp
        HashHandle -> PatchHash -> Patch -> Transaction PatchObjectId
savePatch HashHandle
hh PatchHash
h Patch
patch

-- Save just the causal object (i.e. the `causal` row and its associated `causal_parents`). Internal helper shared by
-- `saveBranch` and `saveBranchV3`.
saveCausalObject ::
  HashHandle ->
  C.Causal Transaction CausalHash BranchHash (C.Branch.Branch Transaction) branch ->
  Transaction (Db.CausalHashId, Db.BranchHashId)
saveCausalObject :: forall branch.
HashHandle
-> Causal
     Transaction CausalHash BranchHash (Branch Transaction) branch
-> Transaction (CausalHashId, BranchHashId)
saveCausalObject HashHandle
hh (C.Causal.Causal CausalHash
hc BranchHash
he Map CausalHash (Transaction (CausalBranch Transaction))
parents Transaction branch
_) = do
  CausalHash -> Transaction (Maybe (CausalHashId, BranchHashId))
Q.loadCausalByCausalHash CausalHash
hc Transaction (Maybe (CausalHashId, BranchHashId))
-> (Transaction (Maybe (CausalHashId, BranchHashId))
    -> Transaction (CausalHashId, BranchHashId))
-> Transaction (CausalHashId, BranchHashId)
forall a b. a -> (a -> b) -> b
& Transaction (CausalHashId, BranchHashId)
-> Transaction (Maybe (CausalHashId, BranchHashId))
-> Transaction (CausalHashId, BranchHashId)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
    -- if not exist, create these
    CausalHashId
chId <- CausalHash -> Transaction CausalHashId
Q.saveCausalHash CausalHash
hc
    BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.saveBranchHash BranchHash
he

    [CausalHashId]
parentCausalHashIds <-
      -- so try to save each parent (recursively) before continuing to save hc
      [(CausalHash, Transaction (CausalBranch Transaction))]
-> ((CausalHash, Transaction (CausalBranch Transaction))
    -> Transaction CausalHashId)
-> Transaction [CausalHashId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map CausalHash (Transaction (CausalBranch Transaction))
-> [(CausalHash, Transaction (CausalBranch Transaction))]
forall k a. Map k a -> [(k, a)]
Map.toList Map CausalHash (Transaction (CausalBranch Transaction))
parents) (((CausalHash, Transaction (CausalBranch Transaction))
  -> Transaction CausalHashId)
 -> Transaction [CausalHashId])
-> ((CausalHash, Transaction (CausalBranch Transaction))
    -> Transaction CausalHashId)
-> Transaction [CausalHashId]
forall a b. (a -> b) -> a -> b
$ \(CausalHash
parentHash, Transaction (CausalBranch Transaction)
mcausal) ->
        -- check if we can short circuit the parent before loading it,
        -- by checking if there are causal parents associated with hc
        ((Transaction CausalHashId
 -> Transaction (Maybe CausalHashId) -> Transaction CausalHashId)
-> Transaction (Maybe CausalHashId)
-> Transaction CausalHashId
-> Transaction CausalHashId
forall a b c. (a -> b -> c) -> b -> a -> c
flip Transaction CausalHashId
-> Transaction (Maybe CausalHashId) -> Transaction CausalHashId
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
Monad.fromMaybeM)
          (CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
parentHash)
          (Transaction (CausalBranch Transaction)
mcausal Transaction (CausalBranch Transaction)
-> (CausalBranch Transaction -> Transaction CausalHashId)
-> Transaction CausalHashId
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((BranchObjectId, CausalHashId) -> CausalHashId)
-> Transaction (BranchObjectId, CausalHashId)
-> Transaction CausalHashId
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BranchObjectId, CausalHashId) -> CausalHashId
forall a b. (a, b) -> b
snd (Transaction (BranchObjectId, CausalHashId)
 -> Transaction CausalHashId)
-> (CausalBranch Transaction
    -> Transaction (BranchObjectId, CausalHashId))
-> CausalBranch Transaction
-> Transaction CausalHashId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashHandle
-> CausalBranch Transaction
-> Transaction (BranchObjectId, CausalHashId)
saveBranch HashHandle
hh)

    -- Save these CausalHashIds to the causal_parents table,
    HashHandle
-> CausalHashId -> BranchHashId -> [CausalHashId] -> Transaction ()
Q.saveCausal HashHandle
hh CausalHashId
chId BranchHashId
bhId [CausalHashId]
parentCausalHashIds
    pure (CausalHashId
chId, BranchHashId
bhId)

loadCausalBranchByCausalHash :: CausalHash -> Transaction (Maybe (C.Branch.CausalBranch Transaction))
loadCausalBranchByCausalHash :: CausalHash -> Transaction (Maybe (CausalBranch Transaction))
loadCausalBranchByCausalHash CausalHash
hc = do
  CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
hc Transaction (Maybe CausalHashId)
-> (Maybe CausalHashId
    -> Transaction (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CausalHashId
chId -> CausalBranch Transaction -> Maybe (CausalBranch Transaction)
forall a. a -> Maybe a
Just (CausalBranch Transaction -> Maybe (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> Transaction (Maybe (CausalBranch Transaction))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHashId -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHashId CausalHashId
chId
    Maybe CausalHashId
Nothing -> Maybe (CausalBranch Transaction)
-> Transaction (Maybe (CausalBranch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CausalBranch Transaction)
forall a. Maybe a
Nothing

expectCausalBranchByCausalHashId :: Db.CausalHashId -> Transaction (C.Branch.CausalBranch Transaction)
expectCausalBranchByCausalHashId :: CausalHashId -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHashId CausalHashId
id = do
  CausalHash
hc <- CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
id
  BranchHash
hb <- CausalHashId -> Transaction BranchHash
expectValueHashByCausalHashId CausalHashId
id
  [CausalHashId]
parentHashIds <- CausalHashId -> Transaction [CausalHashId]
Q.loadCausalParents CausalHashId
id
  [(CausalHash, Transaction (CausalBranch Transaction))]
loadParents <- [CausalHashId]
-> (CausalHashId
    -> Transaction
         (CausalHash, Transaction (CausalBranch Transaction)))
-> Transaction
     [(CausalHash, Transaction (CausalBranch Transaction))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CausalHashId]
parentHashIds \CausalHashId
hId -> do
    CausalHash
h <- CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
hId
    pure (CausalHash
h, CausalHashId -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHashId CausalHashId
hId)
  pure $ CausalHash
-> BranchHash
-> Map CausalHash (Transaction (CausalBranch Transaction))
-> Transaction (Branch Transaction)
-> CausalBranch Transaction
forall (m :: * -> *) hc he pe e.
hc
-> he
-> Map hc (m (Causal m hc he pe pe))
-> m e
-> Causal m hc he pe e
C.Causal CausalHash
hc BranchHash
hb ([(CausalHash, Transaction (CausalBranch Transaction))]
-> Map CausalHash (Transaction (CausalBranch Transaction))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CausalHash, Transaction (CausalBranch Transaction))]
loadParents) (CausalHashId -> Transaction (Branch Transaction)
expectBranchByCausalHashId CausalHashId
id)

expectCausalBranchByCausalHash :: CausalHash -> Transaction (C.Branch.CausalBranch Transaction)
expectCausalBranchByCausalHash :: CausalHash -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHash CausalHash
hash = do
  CausalHashId
chId <- CausalHash -> Transaction CausalHashId
Q.expectCausalHashIdByCausalHash CausalHash
hash
  CausalHashId -> Transaction (CausalBranch Transaction)
expectCausalBranchByCausalHashId CausalHashId
chId

expectBranchByCausalHashId :: Db.CausalHashId -> Transaction (C.Branch.Branch Transaction)
expectBranchByCausalHashId :: CausalHashId -> Transaction (Branch Transaction)
expectBranchByCausalHashId CausalHashId
id = do
  BranchObjectId
boId <- CausalHashId -> Transaction BranchObjectId
Q.expectBranchObjectIdByCausalHashId CausalHashId
id
  BranchObjectId -> Transaction (Branch Transaction)
expectBranch BranchObjectId
boId

-- | Load a branch value given its causal hash id.
loadDbBranchByCausalHashId :: Db.CausalHashId -> Transaction (Maybe S.DbBranch)
loadDbBranchByCausalHashId :: CausalHashId
-> Transaction
     (Maybe
        (Branch'
           TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
loadDbBranchByCausalHashId CausalHashId
causalHashId =
  CausalHashId -> Transaction (Maybe BranchObjectId)
Q.loadBranchObjectIdByCausalHashId CausalHashId
causalHashId Transaction (Maybe BranchObjectId)
-> (Maybe BranchObjectId
    -> Transaction
         (Maybe
            (Branch'
               TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))))
-> Transaction
     (Maybe
        (Branch'
           TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BranchObjectId
Nothing -> Maybe
  (Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
-> Transaction
     (Maybe
        (Branch'
           TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a. Maybe a
Nothing
    Just BranchObjectId
branchObjectId -> Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Maybe
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a. a -> Maybe a
Just (Branch'
   TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
 -> Maybe
      (Branch'
         TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
-> Transaction
     (Maybe
        (Branch'
           TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BranchObjectId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranch BranchObjectId
branchObjectId

expectBranchByBranchHashId :: Db.BranchHashId -> Transaction (C.Branch.Branch Transaction)
expectBranchByBranchHashId :: BranchHashId -> Transaction (Branch Transaction)
expectBranchByBranchHashId BranchHashId
bhId = do
  BranchObjectId
boId <- BranchHashId -> Transaction BranchObjectId
Q.expectBranchObjectIdByBranchHashId BranchHashId
bhId
  BranchObjectId -> Transaction (Branch Transaction)
expectBranch BranchObjectId
boId

expectBranchByBranchHash :: BranchHash -> Transaction (C.Branch.Branch Transaction)
expectBranchByBranchHash :: BranchHash -> Transaction (Branch Transaction)
expectBranchByBranchHash BranchHash
bh = do
  BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
bh
  BranchHashId -> Transaction (Branch Transaction)
expectBranchByBranchHashId BranchHashId
bhId

-- | Expect a branch value given its causal hash id.
expectDbBranchByCausalHashId :: Db.CausalHashId -> Transaction S.DbBranch
expectDbBranchByCausalHashId :: CausalHashId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranchByCausalHashId CausalHashId
causalHashId = do
  BranchObjectId
branchObjectId <- CausalHashId -> Transaction BranchObjectId
Q.expectBranchObjectIdByCausalHashId CausalHashId
causalHashId
  BranchObjectId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranch BranchObjectId
branchObjectId

expectDbBranch :: Db.BranchObjectId -> Transaction S.DbBranch
expectDbBranch :: BranchObjectId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranch BranchObjectId
id =
  BranchObjectId -> Transaction BranchFormat
deserializeBranchObject BranchObjectId
id Transaction BranchFormat
-> (BranchFormat
    -> Transaction
         (Branch'
            TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    S.BranchFormat.Full BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalBranch
f -> Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> LocalBranch
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
S.BranchFormat.localToDbBranch BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalBranch
f)
    S.BranchFormat.Diff BranchObjectId
r BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalDiff
d -> BranchObjectId
-> [Diff]
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
doDiff BranchObjectId
r [BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> LocalDiff -> Diff
S.BranchFormat.localToDbDiff BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalDiff
d]
  where
    deserializeBranchObject :: Db.BranchObjectId -> Transaction S.BranchFormat
    deserializeBranchObject :: BranchObjectId -> Transaction BranchFormat
deserializeBranchObject BranchObjectId
id = do
      Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"deserializeBranchObject " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BranchObjectId -> [Char]
forall a. Show a => a -> [Char]
show BranchObjectId
id
      ObjectId
-> (ByteString -> Either DecodeError BranchFormat)
-> Transaction BranchFormat
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectNamespaceObject (BranchObjectId -> ObjectId
Db.unBranchObjectId BranchObjectId
id) ByteString -> Either DecodeError BranchFormat
decodeBranchFormat

    doDiff :: Db.BranchObjectId -> [S.Branch.Diff] -> Transaction S.DbBranch
    doDiff :: BranchObjectId
-> [Diff]
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
doDiff BranchObjectId
ref [Diff]
ds =
      BranchObjectId -> Transaction BranchFormat
deserializeBranchObject BranchObjectId
ref Transaction BranchFormat
-> (BranchFormat
    -> Transaction
         (Branch'
            TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)))
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        S.BranchFormat.Full BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalBranch
f -> Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> [Diff]
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
joinFull (BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> LocalBranch
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
S.BranchFormat.localToDbBranch BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li LocalBranch
f) [Diff]
ds)
        S.BranchFormat.Diff BranchObjectId
ref' BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li' LocalDiff
d' -> BranchObjectId
-> [Diff]
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
doDiff BranchObjectId
ref' (BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> LocalDiff -> Diff
S.BranchFormat.localToDbDiff BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
li' LocalDiff
d' Diff -> [Diff] -> [Diff]
forall a. a -> [a] -> [a]
: [Diff]
ds)
      where
        joinFull :: S.DbBranch -> [S.Branch.Diff] -> S.DbBranch
        joinFull :: Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> [Diff]
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
joinFull Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
f [] = Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
f
        joinFull
          (S.Branch.Full.Branch Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
tms Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
tps Map TextId PatchObjectId
patches Map TextId (BranchObjectId, CausalHashId)
children)
          (S.Branch.Diff Map
  TextId (Map (Referent'' TextId ObjectId) (DefinitionOp' Reference))
tms' Map TextId (Map Reference (DefinitionOp' Reference))
tps' Map TextId (PatchOp' PatchObjectId)
patches' Map TextId (ChildOp' (BranchObjectId, CausalHashId))
children' : [Diff]
ds) = Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> [Diff]
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
joinFull Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
f' [Diff]
ds
            where
              f' :: Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
f' =
                Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Map TextId PatchObjectId
-> Map TextId (BranchObjectId, CausalHashId)
-> Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
S.Branch.Full.Branch
                  (Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Map
     TextId (Map (Referent'' TextId ObjectId) (DefinitionOp' Reference))
-> Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
forall ns r.
(Ord ns, Ord r) =>
Map ns (Map r (MetadataSetFormat' TextId ObjectId))
-> Map ns (Map r (DefinitionOp' Reference))
-> Map ns (Map r (MetadataSetFormat' TextId ObjectId))
mergeDefns Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
tms Map
  TextId (Map (Referent'' TextId ObjectId) (DefinitionOp' Reference))
tms')
                  (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Map TextId (Map Reference (DefinitionOp' Reference))
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
forall ns r.
(Ord ns, Ord r) =>
Map ns (Map r (MetadataSetFormat' TextId ObjectId))
-> Map ns (Map r (DefinitionOp' Reference))
-> Map ns (Map r (MetadataSetFormat' TextId ObjectId))
mergeDefns Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
tps Map TextId (Map Reference (DefinitionOp' Reference))
tps')
                  (Map TextId PatchObjectId
-> Map TextId (PatchOp' PatchObjectId) -> Map TextId PatchObjectId
forall ns.
Ord ns =>
Map ns PatchObjectId
-> Map ns (PatchOp' PatchObjectId) -> Map ns PatchObjectId
mergePatches Map TextId PatchObjectId
patches Map TextId (PatchOp' PatchObjectId)
patches')
                  (Map TextId (BranchObjectId, CausalHashId)
-> Map TextId (ChildOp' (BranchObjectId, CausalHashId))
-> Map TextId (BranchObjectId, CausalHashId)
forall ns.
Ord ns =>
Map ns (BranchObjectId, CausalHashId)
-> Map ns (ChildOp' (BranchObjectId, CausalHashId))
-> Map ns (BranchObjectId, CausalHashId)
mergeChildren Map TextId (BranchObjectId, CausalHashId)
children Map TextId (ChildOp' (BranchObjectId, CausalHashId))
children')
        mergeChildren ::
          (Ord ns) =>
          Map ns (Db.BranchObjectId, Db.CausalHashId) ->
          Map ns S.BranchDiff.ChildOp ->
          Map ns (Db.BranchObjectId, Db.CausalHashId)
        mergeChildren :: forall ns.
Ord ns =>
Map ns (BranchObjectId, CausalHashId)
-> Map ns (ChildOp' (BranchObjectId, CausalHashId))
-> Map ns (BranchObjectId, CausalHashId)
mergeChildren =
          SimpleWhenMissing
  ns (BranchObjectId, CausalHashId) (BranchObjectId, CausalHashId)
-> SimpleWhenMissing
     ns
     (ChildOp' (BranchObjectId, CausalHashId))
     (BranchObjectId, CausalHashId)
-> SimpleWhenMatched
     ns
     (BranchObjectId, CausalHashId)
     (ChildOp' (BranchObjectId, CausalHashId))
     (BranchObjectId, CausalHashId)
-> Map ns (BranchObjectId, CausalHashId)
-> Map ns (ChildOp' (BranchObjectId, CausalHashId))
-> Map ns (BranchObjectId, CausalHashId)
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
Map.merge
            SimpleWhenMissing
  ns (BranchObjectId, CausalHashId) (BranchObjectId, CausalHashId)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
            ((ns
 -> ChildOp' (BranchObjectId, CausalHashId)
 -> (BranchObjectId, CausalHashId))
-> SimpleWhenMissing
     ns
     (ChildOp' (BranchObjectId, CausalHashId))
     (BranchObjectId, CausalHashId)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ns
-> ChildOp' (BranchObjectId, CausalHashId)
-> (BranchObjectId, CausalHashId)
forall ns.
ns
-> ChildOp' (BranchObjectId, CausalHashId)
-> (BranchObjectId, CausalHashId)
fromChildOp)
            ((ns
 -> (BranchObjectId, CausalHashId)
 -> ChildOp' (BranchObjectId, CausalHashId)
 -> Maybe (BranchObjectId, CausalHashId))
-> SimpleWhenMatched
     ns
     (BranchObjectId, CausalHashId)
     (ChildOp' (BranchObjectId, CausalHashId))
     (BranchObjectId, CausalHashId)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ns
-> (BranchObjectId, CausalHashId)
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall ns.
ns
-> (BranchObjectId, CausalHashId)
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
mergeChildOp)
        mergeChildOp ::
          ns ->
          (Db.BranchObjectId, Db.CausalHashId) ->
          S.BranchDiff.ChildOp ->
          Maybe (Db.BranchObjectId, Db.CausalHashId)
        mergeChildOp :: forall ns.
ns
-> (BranchObjectId, CausalHashId)
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
mergeChildOp =
          (ChildOp' (BranchObjectId, CausalHashId)
 -> Maybe (BranchObjectId, CausalHashId))
-> (BranchObjectId, CausalHashId)
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall a b. a -> b -> a
const ((ChildOp' (BranchObjectId, CausalHashId)
  -> Maybe (BranchObjectId, CausalHashId))
 -> (BranchObjectId, CausalHashId)
 -> ChildOp' (BranchObjectId, CausalHashId)
 -> Maybe (BranchObjectId, CausalHashId))
-> (ns
    -> ChildOp' (BranchObjectId, CausalHashId)
    -> Maybe (BranchObjectId, CausalHashId))
-> ns
-> (BranchObjectId, CausalHashId)
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChildOp' (BranchObjectId, CausalHashId)
 -> Maybe (BranchObjectId, CausalHashId))
-> ns
-> ChildOp' (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall a b. a -> b -> a
const \case
            S.BranchDiff.ChildAddReplace (BranchObjectId, CausalHashId)
id -> (BranchObjectId, CausalHashId)
-> Maybe (BranchObjectId, CausalHashId)
forall a. a -> Maybe a
Just (BranchObjectId, CausalHashId)
id
            ChildOp' (BranchObjectId, CausalHashId)
S.BranchDiff.ChildRemove -> Maybe (BranchObjectId, CausalHashId)
forall a. Maybe a
Nothing
        fromChildOp :: ns -> S.BranchDiff.ChildOp -> (Db.BranchObjectId, Db.CausalHashId)
        fromChildOp :: forall ns.
ns
-> ChildOp' (BranchObjectId, CausalHashId)
-> (BranchObjectId, CausalHashId)
fromChildOp = (ChildOp' (BranchObjectId, CausalHashId)
 -> (BranchObjectId, CausalHashId))
-> ns
-> ChildOp' (BranchObjectId, CausalHashId)
-> (BranchObjectId, CausalHashId)
forall a b. a -> b -> a
const \case
          S.BranchDiff.ChildAddReplace (BranchObjectId, CausalHashId)
id -> (BranchObjectId, CausalHashId)
id
          ChildOp' (BranchObjectId, CausalHashId)
S.BranchDiff.ChildRemove -> [Char] -> (BranchObjectId, CausalHashId)
forall a. HasCallStack => [Char] -> a
error [Char]
"diff tries to remove a nonexistent child"
        mergePatches ::
          (Ord ns) =>
          Map ns Db.PatchObjectId ->
          Map ns S.BranchDiff.PatchOp ->
          Map ns Db.PatchObjectId
        mergePatches :: forall ns.
Ord ns =>
Map ns PatchObjectId
-> Map ns (PatchOp' PatchObjectId) -> Map ns PatchObjectId
mergePatches =
          SimpleWhenMissing ns PatchObjectId PatchObjectId
-> SimpleWhenMissing ns (PatchOp' PatchObjectId) PatchObjectId
-> SimpleWhenMatched
     ns PatchObjectId (PatchOp' PatchObjectId) PatchObjectId
-> Map ns PatchObjectId
-> Map ns (PatchOp' PatchObjectId)
-> Map ns PatchObjectId
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
Map.merge SimpleWhenMissing ns PatchObjectId PatchObjectId
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing ((ns -> PatchOp' PatchObjectId -> PatchObjectId)
-> SimpleWhenMissing ns (PatchOp' PatchObjectId) PatchObjectId
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ns -> PatchOp' PatchObjectId -> PatchObjectId
forall ns. ns -> PatchOp' PatchObjectId -> PatchObjectId
fromPatchOp) ((ns
 -> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId)
-> SimpleWhenMatched
     ns PatchObjectId (PatchOp' PatchObjectId) PatchObjectId
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ns
-> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId
forall ns.
ns
-> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId
mergePatchOp)
        fromPatchOp :: ns -> S.BranchDiff.PatchOp -> Db.PatchObjectId
        fromPatchOp :: forall ns. ns -> PatchOp' PatchObjectId -> PatchObjectId
fromPatchOp = (PatchOp' PatchObjectId -> PatchObjectId)
-> ns -> PatchOp' PatchObjectId -> PatchObjectId
forall a b. a -> b -> a
const \case
          S.BranchDiff.PatchAddReplace PatchObjectId
id -> PatchObjectId
id
          PatchOp' PatchObjectId
S.BranchDiff.PatchRemove -> [Char] -> PatchObjectId
forall a. HasCallStack => [Char] -> a
error [Char]
"diff tries to remove a nonexistent child"
        mergePatchOp :: ns -> Db.PatchObjectId -> S.BranchDiff.PatchOp -> Maybe Db.PatchObjectId
        mergePatchOp :: forall ns.
ns
-> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId
mergePatchOp =
          (PatchOp' PatchObjectId -> Maybe PatchObjectId)
-> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId
forall a b. a -> b -> a
const ((PatchOp' PatchObjectId -> Maybe PatchObjectId)
 -> PatchObjectId -> PatchOp' PatchObjectId -> Maybe PatchObjectId)
-> (ns -> PatchOp' PatchObjectId -> Maybe PatchObjectId)
-> ns
-> PatchObjectId
-> PatchOp' PatchObjectId
-> Maybe PatchObjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchOp' PatchObjectId -> Maybe PatchObjectId)
-> ns -> PatchOp' PatchObjectId -> Maybe PatchObjectId
forall a b. a -> b -> a
const \case
            S.BranchDiff.PatchAddReplace PatchObjectId
id -> PatchObjectId -> Maybe PatchObjectId
forall a. a -> Maybe a
Just PatchObjectId
id
            PatchOp' PatchObjectId
S.BranchDiff.PatchRemove -> Maybe PatchObjectId
forall a. Maybe a
Nothing

        mergeDefns ::
          (Ord ns, Ord r) =>
          Map ns (Map r S.MetadataSet.DbMetadataSet) ->
          Map ns (Map r S.BranchDiff.DefinitionOp) ->
          Map ns (Map r S.MetadataSet.DbMetadataSet)
        mergeDefns :: forall ns r.
(Ord ns, Ord r) =>
Map ns (Map r (MetadataSetFormat' TextId ObjectId))
-> Map ns (Map r (DefinitionOp' Reference))
-> Map ns (Map r (MetadataSetFormat' TextId ObjectId))
mergeDefns =
          SimpleWhenMissing
  ns
  (Map r (MetadataSetFormat' TextId ObjectId))
  (Map r (MetadataSetFormat' TextId ObjectId))
-> SimpleWhenMissing
     ns
     (Map r (DefinitionOp' Reference))
     (Map r (MetadataSetFormat' TextId ObjectId))
-> SimpleWhenMatched
     ns
     (Map r (MetadataSetFormat' TextId ObjectId))
     (Map r (DefinitionOp' Reference))
     (Map r (MetadataSetFormat' TextId ObjectId))
-> Map ns (Map r (MetadataSetFormat' TextId ObjectId))
-> Map ns (Map r (DefinitionOp' Reference))
-> Map ns (Map r (MetadataSetFormat' TextId ObjectId))
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
Map.merge
            SimpleWhenMissing
  ns
  (Map r (MetadataSetFormat' TextId ObjectId))
  (Map r (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
            ((ns
 -> Map r (DefinitionOp' Reference)
 -> Map r (MetadataSetFormat' TextId ObjectId))
-> SimpleWhenMissing
     ns
     (Map r (DefinitionOp' Reference))
     (Map r (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ((Map r (DefinitionOp' Reference)
 -> Map r (MetadataSetFormat' TextId ObjectId))
-> ns
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
forall a b. a -> b -> a
const ((DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
forall a b. (a -> b) -> Map r a -> Map r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId
fromDefnOp)))
            ((ns
 -> Map r (MetadataSetFormat' TextId ObjectId)
 -> Map r (DefinitionOp' Reference)
 -> Map r (MetadataSetFormat' TextId ObjectId))
-> SimpleWhenMatched
     ns
     (Map r (MetadataSetFormat' TextId ObjectId))
     (Map r (DefinitionOp' Reference))
     (Map r (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched ((Map r (MetadataSetFormat' TextId ObjectId)
 -> Map r (DefinitionOp' Reference)
 -> Map r (MetadataSetFormat' TextId ObjectId))
-> ns
-> Map r (MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
forall a b. a -> b -> a
const Map r (MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
forall r.
Ord r =>
Map r (MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
mergeDefnOp))
        fromDefnOp :: S.BranchDiff.DefinitionOp -> S.MetadataSet.DbMetadataSet
        fromDefnOp :: DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId
fromDefnOp = \case
          S.Branch.Diff.AddDefWithMetadata Set Reference
md -> Set Reference -> MetadataSetFormat' TextId ObjectId
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
S.MetadataSet.Inline Set Reference
md
          DefinitionOp' Reference
S.Branch.Diff.RemoveDef -> [Char] -> MetadataSetFormat' TextId ObjectId
forall a. HasCallStack => [Char] -> a
error [Char]
"diff tries to remove a nonexistent definition"
          S.Branch.Diff.AlterDefMetadata AddRemove Reference
_md -> [Char] -> MetadataSetFormat' TextId ObjectId
forall a. HasCallStack => [Char] -> a
error [Char]
"diff tries to change metadata for a nonexistent definition"
        mergeDefnOp ::
          (Ord r) =>
          Map r S.MetadataSet.DbMetadataSet ->
          Map r S.BranchDiff.DefinitionOp ->
          Map r S.MetadataSet.DbMetadataSet
        mergeDefnOp :: forall r.
Ord r =>
Map r (MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
mergeDefnOp =
          SimpleWhenMissing
  r
  (MetadataSetFormat' TextId ObjectId)
  (MetadataSetFormat' TextId ObjectId)
-> SimpleWhenMissing
     r (DefinitionOp' Reference) (MetadataSetFormat' TextId ObjectId)
-> SimpleWhenMatched
     r
     (MetadataSetFormat' TextId ObjectId)
     (DefinitionOp' Reference)
     (MetadataSetFormat' TextId ObjectId)
-> Map r (MetadataSetFormat' TextId ObjectId)
-> Map r (DefinitionOp' Reference)
-> Map r (MetadataSetFormat' TextId ObjectId)
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
Map.merge
            SimpleWhenMissing
  r
  (MetadataSetFormat' TextId ObjectId)
  (MetadataSetFormat' TextId ObjectId)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.preserveMissing
            ((r
 -> DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId)
-> SimpleWhenMissing
     r (DefinitionOp' Reference) (MetadataSetFormat' TextId ObjectId)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ((DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId)
-> r
-> DefinitionOp' Reference
-> MetadataSetFormat' TextId ObjectId
forall a b. a -> b -> a
const DefinitionOp' Reference -> MetadataSetFormat' TextId ObjectId
fromDefnOp))
            ((r
 -> MetadataSetFormat' TextId ObjectId
 -> DefinitionOp' Reference
 -> Maybe (MetadataSetFormat' TextId ObjectId))
-> SimpleWhenMatched
     r
     (MetadataSetFormat' TextId ObjectId)
     (DefinitionOp' Reference)
     (MetadataSetFormat' TextId ObjectId)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ((MetadataSetFormat' TextId ObjectId
 -> DefinitionOp' Reference
 -> Maybe (MetadataSetFormat' TextId ObjectId))
-> r
-> MetadataSetFormat' TextId ObjectId
-> DefinitionOp' Reference
-> Maybe (MetadataSetFormat' TextId ObjectId)
forall a b. a -> b -> a
const MetadataSetFormat' TextId ObjectId
-> DefinitionOp' Reference
-> Maybe (MetadataSetFormat' TextId ObjectId)
mergeDefnOp'))
        mergeDefnOp' ::
          S.MetadataSet.DbMetadataSet ->
          S.BranchDiff.DefinitionOp ->
          Maybe S.MetadataSet.DbMetadataSet
        mergeDefnOp' :: MetadataSetFormat' TextId ObjectId
-> DefinitionOp' Reference
-> Maybe (MetadataSetFormat' TextId ObjectId)
mergeDefnOp' (S.MetadataSet.Inline Set Reference
md) = \case
          S.Branch.Diff.AddDefWithMetadata Set Reference
_md ->
            [Char] -> Maybe (MetadataSetFormat' TextId ObjectId)
forall a. HasCallStack => [Char] -> a
error [Char]
"diff tries to create a child that already exists"
          DefinitionOp' Reference
S.Branch.Diff.RemoveDef -> Maybe (MetadataSetFormat' TextId ObjectId)
forall a. Maybe a
Nothing
          S.Branch.Diff.AlterDefMetadata AddRemove Reference
md' ->
            let ([Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList -> Set Reference
adds, [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList -> Set Reference
removes) = AddRemove Reference -> ([Reference], [Reference])
forall a. AddRemove a -> ([a], [a])
S.BranchDiff.addsRemoves AddRemove Reference
md'
             in MetadataSetFormat' TextId ObjectId
-> Maybe (MetadataSetFormat' TextId ObjectId)
forall a. a -> Maybe a
Just (MetadataSetFormat' TextId ObjectId
 -> Maybe (MetadataSetFormat' TextId ObjectId))
-> (Set Reference -> MetadataSetFormat' TextId ObjectId)
-> Set Reference
-> Maybe (MetadataSetFormat' TextId ObjectId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> MetadataSetFormat' TextId ObjectId
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
S.MetadataSet.Inline (Set Reference -> Maybe (MetadataSetFormat' TextId ObjectId))
-> Set Reference -> Maybe (MetadataSetFormat' TextId ObjectId)
forall a b. (a -> b) -> a -> b
$ (Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Reference
adds (Set Reference -> Set Reference) -> Set Reference -> Set Reference
forall a b. (a -> b) -> a -> b
$ Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Reference
md Set Reference
removes)

-- | Save a 'S.DbBranch', given its hash (which the caller is expected to produce from the branch).
--
-- Note: long-standing question: should this package depend on the hashing package? (If so, we would only need to take
-- the DbBranch, and hash internally).
saveDbBranch ::
  HashHandle ->
  BranchHash ->
  C.Branch.NamespaceStats ->
  DbBranchV ->
  Transaction Db.BranchObjectId
saveDbBranch :: HashHandle
-> BranchHash
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
saveDbBranch HashHandle
hh BranchHash
hash NamespaceStats
stats DbBranchV
branch = do
  BranchHashId
hashId <- BranchHash -> Transaction BranchHashId
Q.saveBranchHash BranchHash
hash
  HashHandle
-> BranchHashId
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
saveDbBranchUnderHashId HashHandle
hh BranchHashId
hashId NamespaceStats
stats DbBranchV
branch

-- | Variant of 'saveDbBranch' that might be preferred by callers that already have a hash id, not a hash.
saveDbBranchUnderHashId ::
  HashHandle ->
  Db.BranchHashId ->
  C.Branch.NamespaceStats ->
  DbBranchV ->
  Transaction Db.BranchObjectId
saveDbBranchUnderHashId :: HashHandle
-> BranchHashId
-> NamespaceStats
-> DbBranchV
-> Transaction BranchObjectId
saveDbBranchUnderHashId HashHandle
hh bhId :: BranchHashId
bhId@(BranchHashId -> HashId
Db.unBranchHashId -> HashId
hashId) NamespaceStats
stats = \case
  DbBranchV2 Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
branch -> Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction BranchObjectId
saveV2 Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
branch
  -- Here, we elect to serialize V3 branches as V2 branches just before saving them to the database. We could save a
  -- little space instead by actually having a proper serialization format for V3 branches.
  DbBranchV3 S.BranchV3 {Map TextId (BranchObjectId, CausalHashId)
$sel:children:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t c
children :: Map TextId (BranchObjectId, CausalHashId)
children, Map TextId (Referent'' TextId ObjectId)
$sel:terms:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t (Referent'' t h)
terms :: Map TextId (Referent'' TextId ObjectId)
terms, Map TextId Reference
$sel:types:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t (TypeReference' t h)
types :: Map TextId Reference
types} ->
    Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction BranchObjectId
saveV2
      S.Branch
        { Map TextId (BranchObjectId, CausalHashId)
$sel:children:Branch :: Map TextId (BranchObjectId, CausalHashId)
children :: Map TextId (BranchObjectId, CausalHashId)
children,
          $sel:patches:Branch :: Map TextId PatchObjectId
patches = Map TextId PatchObjectId
forall k a. Map k a
Map.empty,
          $sel:terms:Branch :: Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms = (Referent'' TextId ObjectId
 -> Map
      (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Map TextId (Referent'' TextId ObjectId)
-> Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Referent'' TextId ObjectId
-> Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
forall ref. ref -> Map ref (MetadataSetFormat' TextId ObjectId)
unconflictedAndWithoutMetadata Map TextId (Referent'' TextId ObjectId)
terms,
          $sel:types:Branch :: Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types = (Reference -> Map Reference (MetadataSetFormat' TextId ObjectId))
-> Map TextId Reference
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Reference -> Map Reference (MetadataSetFormat' TextId ObjectId)
forall ref. ref -> Map ref (MetadataSetFormat' TextId ObjectId)
unconflictedAndWithoutMetadata Map TextId Reference
types
        }
    where
      -- Carry a v3 term or type (one ref, no metadata) to a v2 term or type (set of refs, each with metadata)
      unconflictedAndWithoutMetadata :: ref -> Map ref S.DbMetadataSet
      unconflictedAndWithoutMetadata :: forall ref. ref -> Map ref (MetadataSetFormat' TextId ObjectId)
unconflictedAndWithoutMetadata ref
ref =
        ref
-> MetadataSetFormat' TextId ObjectId
-> Map ref (MetadataSetFormat' TextId ObjectId)
forall k a. k -> a -> Map k a
Map.singleton ref
ref (Set Reference -> MetadataSetFormat' TextId ObjectId
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
S.MetadataSet.Inline Set Reference
forall a. Set a
Set.empty)
  where
    saveV2 :: S.DbBranch -> Transaction Db.BranchObjectId
    saveV2 :: Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction BranchObjectId
saveV2 Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
branch = do
      let (BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
localBranchIds, LocalBranch
localBranch) = Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> (BranchLocalIds'
      TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId),
    LocalBranch)
LocalizeObject.localizeBranch Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
branch
      let bytes :: ByteString
bytes = Put BranchFormat -> BranchFormat -> ByteString
forall a. Put a -> a -> ByteString
S.putBytes BranchFormat -> m ()
Put BranchFormat
S.putBranchFormat (BranchFormat -> ByteString) -> BranchFormat -> ByteString
forall a b. (a -> b) -> a -> b
$ BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> LocalBranch -> BranchFormat
forall text defRef patchRef childRef branchRef.
BranchLocalIds' text defRef patchRef childRef
-> LocalBranch
-> BranchFormat' text defRef patchRef childRef branchRef
S.BranchFormat.Full BranchLocalIds'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
localBranchIds LocalBranch
localBranch
      ObjectId
oId <- HashHandle
-> HashId -> ObjectType -> ByteString -> Transaction ObjectId
Q.saveObject HashHandle
hh HashId
hashId ObjectType
ObjectType.Namespace ByteString
bytes
      BranchHashId -> NamespaceStats -> Transaction ()
Q.saveNamespaceStats BranchHashId
bhId NamespaceStats
stats
      pure $ ObjectId -> BranchObjectId
Db.BranchObjectId ObjectId
oId

expectBranch :: Db.BranchObjectId -> Transaction (C.Branch.Branch Transaction)
expectBranch :: BranchObjectId -> Transaction (Branch Transaction)
expectBranch BranchObjectId
id =
  BranchObjectId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranch BranchObjectId
id Transaction
  (Branch'
     TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
-> (Branch'
      TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
    -> Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> Transaction (Branch Transaction)
s2cBranch

-- * Patch transformation

expectPatch :: Db.PatchObjectId -> Transaction C.Branch.Patch
expectPatch :: PatchObjectId -> Transaction Patch
expectPatch PatchObjectId
patchId =
  PatchObjectId -> Transaction Patch
expectDbPatch PatchObjectId
patchId Transaction Patch
-> (Patch -> Transaction Patch) -> Transaction Patch
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Patch -> Transaction Patch
s2cPatch

expectDbPatch :: Db.PatchObjectId -> Transaction S.Patch
expectDbPatch :: PatchObjectId -> Transaction Patch
expectDbPatch PatchObjectId
patchId =
  PatchObjectId -> Transaction PatchFormat
deserializePatchObject PatchObjectId
patchId Transaction PatchFormat
-> (PatchFormat -> Transaction Patch) -> Transaction Patch
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    S.Patch.Format.Full PatchLocalIds
li LocalPatch
p -> Patch -> Transaction Patch
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatchLocalIds -> LocalPatch -> Patch
S.Patch.Format.localPatchToPatch PatchLocalIds
li LocalPatch
p)
    S.Patch.Format.Diff PatchObjectId
ref PatchLocalIds
li LocalPatchDiff
d -> PatchObjectId -> [PatchDiff] -> Transaction Patch
doDiff PatchObjectId
ref [PatchLocalIds -> LocalPatchDiff -> PatchDiff
S.Patch.Format.localPatchDiffToPatchDiff PatchLocalIds
li LocalPatchDiff
d]
  where
    doDiff :: Db.PatchObjectId -> [S.PatchDiff] -> Transaction S.Patch
    doDiff :: PatchObjectId -> [PatchDiff] -> Transaction Patch
doDiff PatchObjectId
ref [PatchDiff]
ds =
      PatchObjectId -> Transaction PatchFormat
deserializePatchObject PatchObjectId
ref Transaction PatchFormat
-> (PatchFormat -> Transaction Patch) -> Transaction Patch
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        S.Patch.Format.Full PatchLocalIds
li LocalPatch
f -> Patch -> Transaction Patch
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Patch -> [PatchDiff] -> Patch
S.Patch.Format.applyPatchDiffs (PatchLocalIds -> LocalPatch -> Patch
S.Patch.Format.localPatchToPatch PatchLocalIds
li LocalPatch
f) [PatchDiff]
ds)
        S.Patch.Format.Diff PatchObjectId
ref' PatchLocalIds
li' LocalPatchDiff
d' -> PatchObjectId -> [PatchDiff] -> Transaction Patch
doDiff PatchObjectId
ref' (PatchLocalIds -> LocalPatchDiff -> PatchDiff
S.Patch.Format.localPatchDiffToPatchDiff PatchLocalIds
li' LocalPatchDiff
d' PatchDiff -> [PatchDiff] -> [PatchDiff]
forall a. a -> [a] -> [a]
: [PatchDiff]
ds)

savePatch ::
  HashHandle ->
  PatchHash ->
  C.Branch.Patch ->
  Transaction Db.PatchObjectId
savePatch :: HashHandle -> PatchHash -> Patch -> Transaction PatchObjectId
savePatch HashHandle
hh PatchHash
h Patch
c = do
  (PatchLocalIds
li, LocalPatch
lPatch) <- Patch -> (PatchLocalIds, LocalPatch)
LocalizeObject.localizePatch (Patch -> (PatchLocalIds, LocalPatch))
-> Transaction Patch -> Transaction (PatchLocalIds, LocalPatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Patch -> Transaction Patch
c2sPatch Patch
c
  HashHandle -> PatchHash -> PatchFormat -> Transaction PatchObjectId
saveDbPatch HashHandle
hh PatchHash
h (PatchLocalIds -> LocalPatch -> PatchFormat
S.Patch.Format.Full PatchLocalIds
li LocalPatch
lPatch)

saveDbPatch ::
  HashHandle ->
  PatchHash ->
  S.PatchFormat ->
  Transaction Db.PatchObjectId
saveDbPatch :: HashHandle -> PatchHash -> PatchFormat -> Transaction PatchObjectId
saveDbPatch HashHandle
hh PatchHash
hash PatchFormat
patch = do
  HashId
hashId <- Hash -> Transaction HashId
Q.saveHashHash (PatchHash -> Hash
unPatchHash PatchHash
hash)
  let bytes :: ByteString
bytes = Put PatchFormat -> PatchFormat -> ByteString
forall a. Put a -> a -> ByteString
S.putBytes PatchFormat -> m ()
Put PatchFormat
S.putPatchFormat PatchFormat
patch
  ObjectId -> PatchObjectId
Db.PatchObjectId (ObjectId -> PatchObjectId)
-> Transaction ObjectId -> Transaction PatchObjectId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashHandle
-> HashId -> ObjectType -> ByteString -> Transaction ObjectId
Q.saveObject HashHandle
hh HashId
hashId ObjectType
ObjectType.Patch ByteString
bytes

s2cPatch :: S.Patch -> Transaction C.Branch.Patch
s2cPatch :: Patch -> Transaction Patch
s2cPatch (S.Patch Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits) =
  Map Referent (Set TermEdit)
-> Map Reference (Set TypeEdit) -> Patch
C.Branch.Patch
    (Map Referent (Set TermEdit)
 -> Map Reference (Set TypeEdit) -> Patch)
-> Transaction (Map Referent (Set TermEdit))
-> Transaction (Map Reference (Set TypeEdit) -> Patch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Referent'' TextId HashId -> Transaction Referent)
-> (Set (TermEdit' TextId ObjectId) -> Transaction (Set TermEdit))
-> Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
-> Transaction (Map Referent (Set TermEdit))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Referent'' TextId HashId -> Transaction Referent
h2cReferent ((TermEdit' TextId ObjectId -> Transaction TermEdit)
-> Set (TermEdit' TextId ObjectId) -> Transaction (Set TermEdit)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse TermEdit' TextId ObjectId -> Transaction TermEdit
s2cTermEdit) Map (Referent'' TextId HashId) (Set (TermEdit' TextId ObjectId))
termEdits
    Transaction (Map Reference (Set TypeEdit) -> Patch)
-> Transaction (Map Reference (Set TypeEdit)) -> Transaction Patch
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Reference' TextId HashId -> Transaction Reference)
-> (Set (TypeEdit' TextId ObjectId) -> Transaction (Set TypeEdit))
-> Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
-> Transaction (Map Reference (Set TypeEdit))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse Reference' TextId HashId -> Transaction Reference
h2cReference ((TypeEdit' TextId ObjectId -> Transaction TypeEdit)
-> Set (TypeEdit' TextId ObjectId) -> Transaction (Set TypeEdit)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse TypeEdit' TextId ObjectId -> Transaction TypeEdit
s2cTypeEdit) Map (Reference' TextId HashId) (Set (TypeEdit' TextId ObjectId))
typeEdits

deserializePatchObject :: Db.PatchObjectId -> Transaction S.PatchFormat
deserializePatchObject :: PatchObjectId -> Transaction PatchFormat
deserializePatchObject PatchObjectId
id = do
  Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Operations.deserializePatchObject " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchObjectId -> [Char]
forall a. Show a => a -> [Char]
show PatchObjectId
id
  ObjectId
-> (ByteString -> Either DecodeError PatchFormat)
-> Transaction PatchFormat
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectPatchObject (PatchObjectId -> ObjectId
Db.unPatchObjectId PatchObjectId
id) ByteString -> Either DecodeError PatchFormat
decodePatchFormat

lca :: CausalHash -> CausalHash -> Transaction (Maybe CausalHash)
lca :: CausalHash -> CausalHash -> Transaction (Maybe CausalHash)
lca CausalHash
h1 CausalHash
h2 = MaybeT Transaction CausalHash -> Transaction (Maybe CausalHash)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  CausalHashId
chId1 <- Transaction (Maybe CausalHashId) -> MaybeT Transaction CausalHashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe CausalHashId)
 -> MaybeT Transaction CausalHashId)
-> Transaction (Maybe CausalHashId)
-> MaybeT Transaction CausalHashId
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
h1
  CausalHashId
chId2 <- Transaction (Maybe CausalHashId) -> MaybeT Transaction CausalHashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe CausalHashId)
 -> MaybeT Transaction CausalHashId)
-> Transaction (Maybe CausalHashId)
-> MaybeT Transaction CausalHashId
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
h2
  CausalHashId
chId3 <- Transaction (Maybe CausalHashId) -> MaybeT Transaction CausalHashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe CausalHashId)
 -> MaybeT Transaction CausalHashId)
-> Transaction (Maybe CausalHashId)
-> MaybeT Transaction CausalHashId
forall a b. (a -> b) -> a -> b
$ CausalHashId -> CausalHashId -> Transaction (Maybe CausalHashId)
Q.lca CausalHashId
chId1 CausalHashId
chId2
  Transaction CausalHash -> MaybeT Transaction CausalHash
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
chId3)

before :: CausalHash -> CausalHash -> Transaction (Maybe Bool)
before :: CausalHash -> CausalHash -> Transaction (Maybe Bool)
before CausalHash
h1 CausalHash
h2 = MaybeT Transaction Bool -> Transaction (Maybe Bool)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  CausalHashId
chId2 <- Transaction (Maybe CausalHashId) -> MaybeT Transaction CausalHashId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe CausalHashId)
 -> MaybeT Transaction CausalHashId)
-> Transaction (Maybe CausalHashId)
-> MaybeT Transaction CausalHashId
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
h2
  Transaction (Maybe CausalHashId)
-> MaybeT Transaction (Maybe CausalHashId)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CausalHash -> Transaction (Maybe CausalHashId)
Q.loadCausalHashIdByCausalHash CausalHash
h1) MaybeT Transaction (Maybe CausalHashId)
-> (Maybe CausalHashId -> MaybeT Transaction Bool)
-> MaybeT Transaction Bool
forall a b.
MaybeT Transaction a
-> (a -> MaybeT Transaction b) -> MaybeT Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CausalHashId
chId1 -> Transaction Bool -> MaybeT Transaction Bool
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CausalHashId -> CausalHashId -> Transaction Bool
Q.before CausalHashId
chId1 CausalHashId
chId2)
    Maybe CausalHashId
Nothing -> Bool -> MaybeT Transaction Bool
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- * Searches

termsHavingType :: C.Reference -> Transaction (Set C.Referent.Id)
termsHavingType :: Reference -> Transaction (Set Id)
termsHavingType Reference
cTypeRef =
  MaybeT Transaction (Reference' TextId HashId)
-> Transaction (Maybe (Reference' TextId HashId))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Reference -> MaybeT Transaction (Reference' TextId HashId)
c2hReference Reference
cTypeRef) Transaction (Maybe (Reference' TextId HashId))
-> (Maybe (Reference' TextId HashId) -> Transaction (Set Id))
-> Transaction (Set Id)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Reference' TextId HashId)
Nothing -> Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Id
forall a. Set a
Set.empty
    Just Reference' TextId HashId
sTypeRef -> do
      [Id]
sIds <- Reference' TextId HashId -> Transaction [Id]
Q.getReferentsByType Reference' TextId HashId
sTypeRef
      [Id]
set <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferentId [Id]
sIds
      pure ([Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList [Id]
set)

filterTermsByReferenceHavingType :: C.TypeReference -> [C.Reference.Id] -> Transaction [C.Reference.Id]
filterTermsByReferenceHavingType :: Reference -> [Id] -> Transaction [Id]
filterTermsByReferenceHavingType Reference
cTypeRef [Id]
cTermRefIds =
  MaybeT Transaction (Reference' TextId HashId)
-> Transaction (Maybe (Reference' TextId HashId))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Reference -> MaybeT Transaction (Reference' TextId HashId)
c2hReference Reference
cTypeRef) Transaction (Maybe (Reference' TextId HashId))
-> (Maybe (Reference' TextId HashId) -> Transaction [Id])
-> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Reference' TextId HashId)
Nothing -> [Id] -> Transaction [Id]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Reference' TextId HashId
sTypeRef -> do
      [Id]
sTermRefIds <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
c2sReferenceId [Id]
cTermRefIds
      [Id]
matches <- Reference' TextId HashId -> [Id] -> Transaction [Id]
Q.filterTermsByReferenceHavingType Reference' TextId HashId
sTypeRef [Id]
sTermRefIds
      (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferenceId [Id]
matches

filterTermsByReferentHavingType :: C.TypeReference -> [C.Referent.Id] -> Transaction [C.Referent.Id]
filterTermsByReferentHavingType :: Reference -> [Id] -> Transaction [Id]
filterTermsByReferentHavingType Reference
cTypeRef [Id]
cTermRefIds =
  MaybeT Transaction (Reference' TextId HashId)
-> Transaction (Maybe (Reference' TextId HashId))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Reference -> MaybeT Transaction (Reference' TextId HashId)
c2hReference Reference
cTypeRef) Transaction (Maybe (Reference' TextId HashId))
-> (Maybe (Reference' TextId HashId) -> Transaction [Id])
-> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Reference' TextId HashId)
Nothing -> [Id] -> Transaction [Id]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Reference' TextId HashId
sTypeRef -> do
      [Id]
sTermRefIds <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
c2sReferentId [Id]
cTermRefIds
      [Id]
matches <- Reference' TextId HashId -> [Id] -> Transaction [Id]
Q.filterTermsByReferentHavingType Reference' TextId HashId
sTypeRef [Id]
sTermRefIds
      (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferentId [Id]
matches

termsMentioningType :: C.Reference -> Transaction (Set C.Referent.Id)
termsMentioningType :: Reference -> Transaction (Set Id)
termsMentioningType Reference
cTypeRef =
  MaybeT Transaction (Reference' TextId HashId)
-> Transaction (Maybe (Reference' TextId HashId))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (Reference -> MaybeT Transaction (Reference' TextId HashId)
c2hReference Reference
cTypeRef) Transaction (Maybe (Reference' TextId HashId))
-> (Maybe (Reference' TextId HashId) -> Transaction (Set Id))
-> Transaction (Set Id)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Reference' TextId HashId)
Nothing -> Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Id
forall a. Set a
Set.empty
    Just Reference' TextId HashId
sTypeRef -> do
      [Id]
sIds <- Reference' TextId HashId -> Transaction [Id]
Q.getReferentsByTypeMention Reference' TextId HashId
sTypeRef
      [Id]
set <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferentId [Id]
sIds
      pure ([Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList [Id]
set)

-- something kind of funny here.  first, we don't need to enumerate all the reference pos if we're just picking one
-- second, it would be nice if we could leave these as S.References a little longer
-- so that we remember how to blow up if they're missing
componentReferencesByPrefix :: ObjectType.ObjectType -> Text -> Maybe C.Reference.Pos -> Transaction [S.Reference.Id]
componentReferencesByPrefix :: ObjectType -> Text -> Maybe Word64 -> Transaction [Id]
componentReferencesByPrefix ObjectType
ot Text
b32prefix Maybe Word64
pos = do
  [ObjectId]
oIds :: [Db.ObjectId] <- ObjectType -> Text -> Transaction [ObjectId]
Q.objectIdByBase32Prefix ObjectType
ot Text
b32prefix
  let test :: Word64 -> Bool
test = (Word64 -> Bool)
-> (Word64 -> Word64 -> Bool) -> Maybe Word64 -> Word64 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Word64 -> Bool
forall a b. a -> b -> a
const Bool
True) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe Word64
pos
  let filterComponent :: [Id] -> [Id]
filterComponent [Id]
l = [Id
x | x :: Id
x@(C.Reference.Id ObjectId
_ Word64
pos) <- [Id]
l, Word64 -> Bool
test Word64
pos]
  [[Id]] -> [Id]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Id]] -> [Id]) -> Transaction [[Id]] -> Transaction [Id]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectId -> Transaction [Id]) -> [ObjectId] -> Transaction [[Id]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (([Id] -> [Id]) -> Transaction [Id] -> Transaction [Id]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Id] -> [Id]
filterComponent (Transaction [Id] -> Transaction [Id])
-> (ObjectId -> Transaction [Id]) -> ObjectId -> Transaction [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectId -> Transaction [Id]
componentByObjectId) [ObjectId]
oIds

-- | Get the set of user-defined terms whose hash matches the given prefix.
termReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [C.Reference.Id]
termReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [Id]
termReferencesByPrefix Text
t Maybe Word64
w =
  ObjectType -> Text -> Maybe Word64 -> Transaction [Id]
componentReferencesByPrefix ObjectType
ObjectType.TermComponent Text
t Maybe Word64
w
    Transaction [Id] -> ([Id] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ObjectId -> Transaction Hash) -> Id -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId)

declReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [C.Reference.Id]
declReferencesByPrefix :: Text -> Maybe Word64 -> Transaction [Id]
declReferencesByPrefix Text
t Maybe Word64
w =
  ObjectType -> Text -> Maybe Word64 -> Transaction [Id]
componentReferencesByPrefix ObjectType
ObjectType.DeclComponent Text
t Maybe Word64
w
    Transaction [Id] -> ([Id] -> Transaction [Id]) -> Transaction [Id]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ObjectId -> Transaction Hash) -> Id -> Transaction Id
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.Reference.idH ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId)

termReferentsByPrefix :: Text -> Maybe Word64 -> Transaction [C.Referent.Id]
termReferentsByPrefix :: Text -> Maybe Word64 -> Transaction [Id]
termReferentsByPrefix Text
b32prefix Maybe Word64
pos =
  (Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Id
forall hTm hTp. Id' hTm -> Id' hTm hTp
C.Referent.RefId ([Id] -> [Id]) -> Transaction [Id] -> Transaction [Id]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Word64 -> Transaction [Id]
termReferencesByPrefix Text
b32prefix Maybe Word64
pos

-- todo: simplify this if we stop caring about constructor type
-- todo: remove the cycle length once we drop it from Unison.Reference
declReferentsByPrefix ::
  Text ->
  Maybe C.Reference.Pos ->
  Maybe ConstructorId ->
  Transaction [(H.Hash, C.Reference.Pos, C.DeclType, [C.Decl.ConstructorId])]
declReferentsByPrefix :: Text
-> Maybe Word64
-> Maybe Word64
-> Transaction [(Hash, Word64, DeclType, [Word64])]
declReferentsByPrefix Text
b32prefix Maybe Word64
pos Maybe Word64
cid = do
  ObjectType -> Text -> Maybe Word64 -> Transaction [Id]
componentReferencesByPrefix ObjectType
ObjectType.DeclComponent Text
b32prefix Maybe Word64
pos
    Transaction [Id]
-> ([Id] -> Transaction [(Hash, Word64, DeclType, [Word64])])
-> Transaction [(Hash, Word64, DeclType, [Word64])]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Id -> Transaction (Hash, Word64, DeclType, [Word64]))
-> [Id] -> Transaction [(Hash, Word64, DeclType, [Word64])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Maybe Word64
-> Id -> Transaction (Hash, Word64, DeclType, [Word64])
loadConstructors Maybe Word64
cid)
  where
    loadConstructors ::
      Maybe Word64 ->
      S.Reference.Id ->
      Transaction (H.Hash, C.Reference.Pos, C.DeclType, [ConstructorId])
    loadConstructors :: Maybe Word64
-> Id -> Transaction (Hash, Word64, DeclType, [Word64])
loadConstructors Maybe Word64
cid rid :: Id
rid@(C.Reference.Id ObjectId
oId Word64
pos) = do
      (DeclType
dt, Int
ctorCount) <- Id -> Transaction (DeclType, Int)
getDeclCtorCount Id
rid
      Hash
h <- ObjectId -> Transaction Hash
Q.expectPrimaryHashByObjectId ObjectId
oId
      let cids :: [Word64]
cids =
            case Maybe Word64
cid of
              Maybe Word64
Nothing -> Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take Int
ctorCount [Word64
0 :: ConstructorId ..]
              Just Word64
cid -> if Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ctorCount then [Word64
cid] else []
      pure (Hash
h, Word64
pos, DeclType
dt, [Word64]
cids)
    getDeclCtorCount :: S.Reference.Id -> Transaction (C.Decl.DeclType, Int)
    getDeclCtorCount :: Id -> Transaction (DeclType, Int)
getDeclCtorCount id :: Id
id@(C.Reference.Id ObjectId
r Word64
i) = do
      Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall (f :: * -> *). Applicative f => [Char] -> f ()
traceM ([Char] -> Transaction ()) -> [Char] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char]
"getDeclCtorCount " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
id
      (LocalIds' TextId ObjectId
_localIds, Decl Symbol
decl) <- ObjectId
-> (ByteString
    -> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol))
-> Transaction (LocalIds' TextId ObjectId, Decl Symbol)
forall e a.
SqliteExceptionReason e =>
ObjectId -> (ByteString -> Either e a) -> Transaction a
Q.expectDeclObject ObjectId
r (Word64
-> ByteString
-> Either DecodeError (LocalIds' TextId ObjectId, Decl Symbol)
decodeDeclElement Word64
i)
      pure (Decl Symbol -> DeclType
forall r v. DeclR r v -> DeclType
C.Decl.declType Decl Symbol
decl, [TypeR TypeRef Symbol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Decl Symbol -> [TypeR TypeRef Symbol]
forall r v. DeclR r v -> [TypeR r v]
C.Decl.constructorTypes Decl Symbol
decl))

namespaceHashesByPrefix :: ShortNamespaceHash -> Transaction (Set BranchHash)
namespaceHashesByPrefix :: ShortNamespaceHash -> Transaction (Set BranchHash)
namespaceHashesByPrefix (ShortNamespaceHash Text
b32prefix) = do
  [BranchHashId]
hashIds <- Text -> Transaction [BranchHashId]
Q.namespaceHashIdByBase32Prefix Text
b32prefix
  [Hash]
hashes <- (BranchHashId -> Transaction Hash)
-> [BranchHashId] -> Transaction [Hash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (HashId -> Transaction Hash
Q.expectHash (HashId -> Transaction Hash)
-> (BranchHashId -> HashId) -> BranchHashId -> Transaction Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchHashId -> HashId
Db.unBranchHashId) [BranchHashId]
hashIds
  pure $ [BranchHash] -> Set BranchHash
forall a. Ord a => [a] -> Set a
Set.fromList ([BranchHash] -> Set BranchHash)
-> ([Hash] -> [BranchHash]) -> [Hash] -> Set BranchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash -> BranchHash) -> [Hash] -> [BranchHash]
forall a b. (a -> b) -> [a] -> [b]
map Hash -> BranchHash
BranchHash ([Hash] -> Set BranchHash) -> [Hash] -> Set BranchHash
forall a b. (a -> b) -> a -> b
$ [Hash]
hashes

causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
causalHashesByPrefix (ShortCausalHash Text
b32prefix) = do
  [CausalHashId]
hashIds <- Text -> Transaction [CausalHashId]
Q.causalHashIdByBase32Prefix Text
b32prefix
  [Hash]
hashes <- (CausalHashId -> Transaction Hash)
-> [CausalHashId] -> Transaction [Hash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (HashId -> Transaction Hash
Q.expectHash (HashId -> Transaction Hash)
-> (CausalHashId -> HashId) -> CausalHashId -> Transaction Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHashId -> HashId
Db.unCausalHashId) [CausalHashId]
hashIds
  pure $ [CausalHash] -> Set CausalHash
forall a. Ord a => [a] -> Set a
Set.fromList ([CausalHash] -> Set CausalHash)
-> ([Hash] -> [CausalHash]) -> [Hash] -> Set CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash -> CausalHash) -> [Hash] -> [CausalHash]
forall a b. (a -> b) -> [a] -> [b]
map Hash -> CausalHash
CausalHash ([Hash] -> Set CausalHash) -> [Hash] -> Set CausalHash
forall a b. (a -> b) -> a -> b
$ [Hash]
hashes

directDependenciesOfScope ::
  DefnsF Set C.TermReferenceId C.TypeReferenceId ->
  Transaction (DefnsF Set C.TermReference C.TypeReference)
directDependenciesOfScope :: DefnsF Set Id Id -> Transaction (DefnsF Set Reference Reference)
directDependenciesOfScope DefnsF Set Id Id
scope0 = do
  -- Convert C -> S
  Defns (Set Id) (Set Id)
scope1 <- (Set Id -> Transaction (Set Id))
-> (Set Id -> Transaction (Set Id))
-> DefnsF Set Id Id
-> Transaction (Defns (Set Id) (Set Id))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
c2sReferenceId) ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
c2sReferenceId) DefnsF Set Id Id
scope0

  -- Do the query
  DefnsF Set Reference Reference
dependencies0 <- Defns (Set Id) (Set Id)
-> Transaction (DefnsF Set Reference Reference)
Q.getDirectDependenciesOfScope Defns (Set Id) (Set Id)
scope1

  -- Convert S -> C
  DefnsF Set Reference Reference
dependencies1 <- (Set Reference -> Transaction (Set Reference))
-> (Set Reference -> Transaction (Set Reference))
-> DefnsF Set Reference Reference
-> Transaction (DefnsF Set Reference Reference)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
s2cReference) ((Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
s2cReference) DefnsF Set Reference Reference
dependencies0

  pure DefnsF Set Reference Reference
dependencies1

-- | returns a list of known definitions referencing `r`
dependents :: Q.DependentsSelector -> C.Reference -> Transaction (Set C.Reference.Id)
dependents :: DependentsSelector -> Reference -> Transaction (Set Id)
dependents DependentsSelector
selector Reference
r = do
  Maybe Reference
mr <- case Reference
r of
    C.ReferenceBuiltin {} -> Maybe Reference -> Transaction (Maybe Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r)
    C.ReferenceDerived Id
id_ ->
      Hash -> Transaction Bool
objectExistsForHash (Getting Hash Id Hash -> Id -> Hash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Hash Id Hash
forall h h' (f :: * -> *).
Functor f =>
(h -> f h') -> Id' h -> f (Id' h')
C.idH Id
id_) Transaction Bool
-> (Bool -> Maybe Reference) -> Transaction (Maybe Reference)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Bool
True -> Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
r
        Bool
False -> Maybe Reference
forall a. Maybe a
Nothing
  case Maybe Reference
mr of
    Maybe Reference
Nothing -> Set Id -> Transaction (Set Id)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Id
forall a. Monoid a => a
mempty
    Just Reference
r -> do
      Reference
r' <- Reference -> Transaction Reference
c2sReference Reference
r
      Set Id
sIds <- DependentsSelector -> Reference -> Transaction (Set Id)
Q.getDependentsForDependency DependentsSelector
selector Reference
r'
      (Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
s2cReferenceId Set Id
sIds

-- | `directDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not
-- including `query` itself).
directDependentsWithinScope ::
  Set C.Reference.Id ->
  Set C.Reference ->
  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
directDependentsWithinScope :: Set Id -> Set Reference -> Transaction (DefnsF Set Id Id)
directDependentsWithinScope Set Id
scope0 Set Reference
query0 = do
  -- Convert C -> S
  Set Id
scope1 <- (Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
c2sReferenceId Set Id
scope0
  Set Reference
query1 <- (Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
c2sReference Set Reference
query0

  -- Do the query
  Defns (Set Id) (Set Id)
dependents0 <- Set Id -> Set Reference -> Transaction (Defns (Set Id) (Set Id))
Q.getDirectDependentsWithinScope Set Id
scope1 Set Reference
query1

  -- Convert S -> C
  DefnsF Set Id Id
dependents1 <- (Set Id -> Transaction (Set Id))
-> (Set Id -> Transaction (Set Id))
-> Defns (Set Id) (Set Id)
-> Transaction (DefnsF Set Id Id)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
s2cReferenceId) ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
s2cReferenceId) Defns (Set Id) (Set Id)
dependents0

  pure DefnsF Set Id Id
dependents1

-- | `transitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` (not
-- including `query` itself).
transitiveDependentsWithinScope ::
  Set C.Reference.Id ->
  Set C.Reference ->
  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
transitiveDependentsWithinScope :: Set Id -> Set Reference -> Transaction (DefnsF Set Id Id)
transitiveDependentsWithinScope Set Id
scope0 Set Reference
query0 = do
  -- Convert C -> S
  Set Id
scope1 <- (Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
c2sReferenceId Set Id
scope0
  Set Reference
query1 <- (Reference -> Transaction Reference)
-> Set Reference -> Transaction (Set Reference)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference -> Transaction Reference
c2sReference Set Reference
query0

  -- Do the query
  Defns (Set Id) (Set Id)
dependents0 <- Set Id -> Set Reference -> Transaction (Defns (Set Id) (Set Id))
Q.getTransitiveDependentsWithinScope Set Id
scope1 Set Reference
query1

  -- Convert S -> C
  DefnsF Set Id Id
dependents1 <- (Set Id -> Transaction (Set Id))
-> (Set Id -> Transaction (Set Id))
-> Defns (Set Id) (Set Id)
-> Transaction (DefnsF Set Id Id)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
s2cReferenceId) ((Id -> Transaction Id) -> Set Id -> Transaction (Set Id)
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Id -> Transaction Id
s2cReferenceId) Defns (Set Id) (Set Id)
dependents0

  pure DefnsF Set Id Id
dependents1

-- | returns a list of known definitions referencing `h`
dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)
dependentsOfComponent :: Hash -> Transaction (Set Id)
dependentsOfComponent Hash
h = do
  ObjectId
oId <- Hash -> Transaction ObjectId
Q.expectObjectIdForPrimaryHash Hash
h
  [Id]
sIds :: [S.Reference.Id] <- ObjectId -> Transaction [Id]
Q.getDependentsForDependencyComponent ObjectId
oId
  [Id]
cIds <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferenceId [Id]
sIds
  pure $ [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList [Id]
cIds

-- | returns empty set for unknown inputs; doesn't distinguish between term and decl
derivedDependencies :: C.Reference.Id -> Transaction (Set C.Reference.Id)
derivedDependencies :: Id -> Transaction (Set Id)
derivedDependencies Id
cid = do
  Id
sid <- Id -> Transaction Id
c2sReferenceId Id
cid
  [Id]
sids <- Id -> Transaction [Id]
Q.getDependencyIdsForDependent Id
sid
  [Id]
cids <- (Id -> Transaction Id) -> [Id] -> Transaction [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Id -> Transaction Id
s2cReferenceId [Id]
sids
  pure $ [Id] -> Set Id
forall a. Ord a => [a] -> Set a
Set.fromList [Id]
cids

-- | Apply a set of name updates to an existing index.
buildNameLookupForBranchHash ::
  -- The existing name lookup index to copy before applying the diff.
  -- If Nothing, run the diff against an empty index.
  -- If Just, the name lookup must exist or an error will be thrown.
  Maybe BranchHash ->
  BranchHash ->
  ( ( -- (add terms, remove terms)
      ([S.NamedRef (C.Referent, Maybe C.ConstructorType)], [S.NamedRef C.Referent]) ->
      --  (add types, remove types)
      ([S.NamedRef C.Reference], [S.NamedRef C.Reference]) ->
      Transaction ()
    ) ->
    Transaction ()
  ) ->
  Transaction ()
buildNameLookupForBranchHash :: Maybe BranchHash
-> BranchHash
-> ((([NamedRef (Referent, Maybe ConstructorType)],
      [NamedRef Referent])
     -> ([NamedRef Reference], [NamedRef Reference]) -> Transaction ())
    -> Transaction ())
-> Transaction ()
buildNameLookupForBranchHash Maybe BranchHash
mayExistingBranchIndex BranchHash
newBranchHash (([NamedRef (Referent, Maybe ConstructorType)],
  [NamedRef Referent])
 -> ([NamedRef Reference], [NamedRef Reference]) -> Transaction ())
-> Transaction ()
callback = do
  BranchHashId
newBranchHashId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
newBranchHash
  BranchHashId -> Transaction ()
Q.trackNewBranchHashNameLookup BranchHashId
newBranchHashId
  case Maybe BranchHash
mayExistingBranchIndex of
    Maybe BranchHash
Nothing -> () -> Transaction ()
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just BranchHash
existingBranchIndex -> do
      Transaction Bool -> Transaction () -> Transaction ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (BranchHash -> Transaction Bool
checkBranchHashNameLookupExists BranchHash
existingBranchIndex) (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Transaction ()
forall a. HasCallStack => [Char] -> a
error [Char]
"buildNameLookupForBranchHash: existingBranchIndex was provided, but no index was found for that branch hash."
      BranchHashId
existingBranchHashId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
existingBranchIndex
      BranchHashId -> BranchHashId -> Transaction ()
Q.copyScopedNameLookup BranchHashId
existingBranchHashId BranchHashId
newBranchHashId
  (([NamedRef (Referent, Maybe ConstructorType)],
  [NamedRef Referent])
 -> ([NamedRef Reference], [NamedRef Reference]) -> Transaction ())
-> Transaction ()
callback \([NamedRef (Referent, Maybe ConstructorType)]
newTermNames, [NamedRef Referent]
removedTermNames) ([NamedRef Reference]
newTypeNames, [NamedRef Reference]
removedTypeNames) -> do
    BranchHashId -> [NamedRef TextReferent] -> Transaction ()
Q.removeScopedTermNames BranchHashId
newBranchHashId (((Referent -> TextReferent)
-> NamedRef Referent -> NamedRef TextReferent
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Referent -> TextReferent
c2sTextReferent (NamedRef Referent -> NamedRef TextReferent)
-> [NamedRef Referent] -> [NamedRef TextReferent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef Referent]
removedTermNames))
    BranchHashId -> [NamedRef TextReference] -> Transaction ()
Q.removeScopedTypeNames BranchHashId
newBranchHashId (((Reference -> TextReference)
-> NamedRef Reference -> NamedRef TextReference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> TextReference
c2sTextReference (NamedRef Reference -> NamedRef TextReference)
-> [NamedRef Reference] -> [NamedRef TextReference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef Reference]
removedTypeNames))
    BranchHashId
-> [NamedRef (TextReferent, Maybe ConstructorType)]
-> Transaction ()
Q.insertScopedTermNames BranchHashId
newBranchHashId (((Referent, Maybe ConstructorType)
 -> (TextReferent, Maybe ConstructorType))
-> NamedRef (Referent, Maybe ConstructorType)
-> NamedRef (TextReferent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Referent -> TextReferent
c2sTextReferent (Referent -> TextReferent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** (ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
c2sConstructorType) (NamedRef (Referent, Maybe ConstructorType)
 -> NamedRef (TextReferent, Maybe ConstructorType))
-> [NamedRef (Referent, Maybe ConstructorType)]
-> [NamedRef (TextReferent, Maybe ConstructorType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef (Referent, Maybe ConstructorType)]
newTermNames)
    BranchHashId -> [NamedRef TextReference] -> Transaction ()
Q.insertScopedTypeNames BranchHashId
newBranchHashId ((Reference -> TextReference)
-> NamedRef Reference -> NamedRef TextReference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> TextReference
c2sTextReference (NamedRef Reference -> NamedRef TextReference)
-> [NamedRef Reference] -> [NamedRef TextReference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef Reference]
newTypeNames)

-- | Save a list of (mount-path, branch hash) mounts for the provided name lookup index branch
-- hash.
--
-- E.g. associateNameLookupMounts #roothash [(["lib", "base"], #basehash)]
associateNameLookupMounts :: BranchHash -> [(PathSegments, BranchHash)] -> Transaction ()
associateNameLookupMounts :: BranchHash -> [(PathSegments, BranchHash)] -> Transaction ()
associateNameLookupMounts BranchHash
rootBh [(PathSegments, BranchHash)]
dependencyMounts = do
  BranchHashId
rootBhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
rootBh
  [(PathSegments, BranchHashId)]
depMounts <- [(PathSegments, BranchHash)]
-> ((PathSegments, BranchHash)
    -> Transaction (PathSegments, BranchHashId))
-> Transaction [(PathSegments, BranchHashId)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(PathSegments, BranchHash)]
dependencyMounts \(PathSegments
path, BranchHash
branchHash) -> do
    BranchHashId
branchHashId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
branchHash
    pure (PathSegments
path, BranchHashId
branchHashId)
  BranchHashId -> [(PathSegments, BranchHashId)] -> Transaction ()
Q.associateNameLookupMounts BranchHashId
rootBhId [(PathSegments, BranchHashId)]
depMounts

-- | Any time we need to lookup or search names we need to know what the scope of that search
-- should be. This can be complicated to keep track of, so this is a helper type to make it
-- easy to pass around.
--
-- You should use 'namesPerspectiveForRootAndPath' to construct this type.
--
-- E.g. if we're in loose code, we need to search the correct name lookup for the
-- user's perspective. If their perspective is "myprojects.json.latest.lib.base.data.List",
-- we need to search names using the name index mounted at "myprojects.json.latest.lib.base".
--
-- The NamesPerspective representing this viewpoint would be:
--
-- @@
-- NamesPerspective
--  { nameLookupBranchHashId = #libbasehash
--  , pathToMountedNameLookup = ["myprojects.json", "latest", "lib", "base"]
--  , relativePerspective = ["data", "List"]
--  }
-- @@
data NamesPerspective = NamesPerspective
  { -- | The branch hash of the name lookup we'll use for queries
    NamesPerspective -> BranchHashId
nameLookupBranchHashId :: Db.BranchHashId,
    -- | Where the name lookup is mounted relative to the root branch
    NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments,
    -- | The path to the perspective relative to the current name lookup
    NamesPerspective -> PathSegments
relativePerspective :: PathSegments
  }
  deriving (NamesPerspective -> NamesPerspective -> Bool
(NamesPerspective -> NamesPerspective -> Bool)
-> (NamesPerspective -> NamesPerspective -> Bool)
-> Eq NamesPerspective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamesPerspective -> NamesPerspective -> Bool
== :: NamesPerspective -> NamesPerspective -> Bool
$c/= :: NamesPerspective -> NamesPerspective -> Bool
/= :: NamesPerspective -> NamesPerspective -> Bool
Eq, Int -> NamesPerspective -> [Char] -> [Char]
[NamesPerspective] -> [Char] -> [Char]
NamesPerspective -> [Char]
(Int -> NamesPerspective -> [Char] -> [Char])
-> (NamesPerspective -> [Char])
-> ([NamesPerspective] -> [Char] -> [Char])
-> Show NamesPerspective
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> NamesPerspective -> [Char] -> [Char]
showsPrec :: Int -> NamesPerspective -> [Char] -> [Char]
$cshow :: NamesPerspective -> [Char]
show :: NamesPerspective -> [Char]
$cshowList :: [NamesPerspective] -> [Char] -> [Char]
showList :: [NamesPerspective] -> [Char] -> [Char]
Show)

-- | Determine which nameLookup is the closest parent of the provided perspective.
--
-- Returns (rootBranchId of the closest parent index, namespace that index is mounted at, location of the perspective within the mounted namespace)
--
-- E.g.
-- If your namespace is "lib.distributed.lib.base.data.List", you'd get back
-- (rootBranchId of the lib.distributed.lib.base name lookup, "lib.distributed.lib.base", "data.List")
--
-- Or if your namespace is "subnamespace.user", you'd get back
-- (the rootBranchId you provided, "", "subnamespace.user")
namesPerspectiveForRootAndPath :: BranchHash -> PathSegments -> Transaction NamesPerspective
namesPerspectiveForRootAndPath :: BranchHash -> PathSegments -> Transaction NamesPerspective
namesPerspectiveForRootAndPath BranchHash
rootBh PathSegments
namespace = do
  BranchHashId
rootBhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
rootBh
  BranchHashId -> PathSegments -> Transaction NamesPerspective
namesPerspectiveForRootAndPathHelper BranchHashId
rootBhId PathSegments
namespace
  where
    namesPerspectiveForRootAndPathHelper :: Db.BranchHashId -> PathSegments -> Transaction NamesPerspective
    namesPerspectiveForRootAndPathHelper :: BranchHashId -> PathSegments -> Transaction NamesPerspective
namesPerspectiveForRootAndPathHelper BranchHashId
rootBhId PathSegments
pathSegments = do
      let defaultPerspective :: NamesPerspective
defaultPerspective =
            NamesPerspective
              { $sel:nameLookupBranchHashId:NamesPerspective :: BranchHashId
nameLookupBranchHashId = BranchHashId
rootBhId,
                $sel:pathToMountedNameLookup:NamesPerspective :: PathSegments
pathToMountedNameLookup = ([Text] -> PathSegments
PathSegments []),
                $sel:relativePerspective:NamesPerspective :: PathSegments
relativePerspective = PathSegments
pathSegments
              }
      (Maybe NamesPerspective -> NamesPerspective)
-> Transaction (Maybe NamesPerspective)
-> Transaction NamesPerspective
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NamesPerspective -> Maybe NamesPerspective -> NamesPerspective
forall a. a -> Maybe a -> a
fromMaybe NamesPerspective
defaultPerspective) (Transaction (Maybe NamesPerspective)
 -> Transaction NamesPerspective)
-> (MaybeT Transaction NamesPerspective
    -> Transaction (Maybe NamesPerspective))
-> MaybeT Transaction NamesPerspective
-> Transaction NamesPerspective
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT Transaction NamesPerspective
-> Transaction (Maybe NamesPerspective)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Transaction NamesPerspective
 -> Transaction NamesPerspective)
-> MaybeT Transaction NamesPerspective
-> Transaction NamesPerspective
forall a b. (a -> b) -> a -> b
$
        do
          [(PathSegments, BranchHashId)]
mounts <- Transaction [(PathSegments, BranchHashId)]
-> MaybeT Transaction [(PathSegments, BranchHashId)]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [(PathSegments, BranchHashId)]
 -> MaybeT Transaction [(PathSegments, BranchHashId)])
-> Transaction [(PathSegments, BranchHashId)]
-> MaybeT Transaction [(PathSegments, BranchHashId)]
forall a b. (a -> b) -> a -> b
$ BranchHashId -> Transaction [(PathSegments, BranchHashId)]
Q.listNameLookupMounts BranchHashId
rootBhId
          [(PathSegments, BranchHashId)]
mounts
            [(PathSegments, BranchHashId)]
-> ([(PathSegments, BranchHashId)]
    -> MaybeT Transaction NamesPerspective)
-> MaybeT Transaction NamesPerspective
forall a b. a -> (a -> b) -> b
& ((PathSegments, BranchHashId)
 -> MaybeT Transaction NamesPerspective)
-> [(PathSegments, BranchHashId)]
-> MaybeT Transaction NamesPerspective
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
altMap \(PathSegments
mountPathSegments, BranchHashId
mountBranchHash) -> do
              case [Text] -> [Text] -> ([Text], [Text], [Text])
forall a. Eq a => [a] -> [a] -> ([a], [a], [a])
List.splitOnLongestCommonPrefix (forall target source. From source target => source -> target
into @[Text] PathSegments
pathSegments) (forall target source. From source target => source -> target
into @[Text] PathSegments
mountPathSegments) of
                -- The path is within this mount:
                ([Text]
_, [Text]
remainingPath, []) ->
                  Transaction NamesPerspective -> MaybeT Transaction NamesPerspective
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction NamesPerspective
 -> MaybeT Transaction NamesPerspective)
-> Transaction NamesPerspective
-> MaybeT Transaction NamesPerspective
forall a b. (a -> b) -> a -> b
$
                    BranchHashId -> PathSegments -> Transaction NamesPerspective
namesPerspectiveForRootAndPathHelper BranchHashId
mountBranchHash (forall target source. From source target => source -> target
into @PathSegments [Text]
remainingPath)
                      Transaction NamesPerspective
-> (NamesPerspective -> NamesPerspective)
-> Transaction NamesPerspective
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, $sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup = PathSegments
mountLocation, PathSegments
$sel:relativePerspective:NamesPerspective :: NamesPerspective -> PathSegments
relativePerspective :: PathSegments
relativePerspective}) ->
                        NamesPerspective
                          { BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId,
                            -- Ensure we return the correct mount location even if the mount is
                            -- several levels deep
                            $sel:pathToMountedNameLookup:NamesPerspective :: PathSegments
pathToMountedNameLookup = PathSegments
mountPathSegments PathSegments -> PathSegments -> PathSegments
forall a. Semigroup a => a -> a -> a
<> PathSegments
mountLocation,
                            PathSegments
$sel:relativePerspective:NamesPerspective :: PathSegments
relativePerspective :: PathSegments
relativePerspective
                          }
                -- The path is not within this mount:
                ([Text], [Text], [Text])
_ -> MaybeT Transaction NamesPerspective
forall a. MaybeT Transaction a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Check whether we've already got an index for a given branch hash.
checkBranchHashNameLookupExists :: BranchHash -> Transaction Bool
checkBranchHashNameLookupExists :: BranchHash -> Transaction Bool
checkBranchHashNameLookupExists BranchHash
bh = do
  BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
bh
  BranchHashId -> Transaction Bool
Q.checkBranchHashNameLookupExists BranchHashId
bhId

data NamesInPerspective = NamesInPerspective
  { NamesInPerspective -> [NamedRef (Referent, Maybe ConstructorType)]
termNamesInPerspective :: [S.NamedRef (C.Referent, Maybe C.ConstructorType)],
    NamesInPerspective -> [NamedRef Reference]
typeNamesInPerspective :: [S.NamedRef C.Reference]
  }

-- | Get all the term and type names for the given namespace from the lookup table.
-- Requires that an index for this branch hash already exists, which is currently
-- only true on Share.
allNamesInPerspective ::
  NamesPerspective ->
  Transaction NamesInPerspective
allNamesInPerspective :: NamesPerspective -> Transaction NamesInPerspective
allNamesInPerspective NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} = do
  [NamedRef (TextReferent, Maybe ConstructorType)]
termNamesInPerspective <- BranchHashId
-> PathSegments
-> Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
Q.termNamesWithinNamespace BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty
  [NamedRef TextReference]
typeNamesInPerspective <- BranchHashId
-> PathSegments -> Transaction [NamedRef TextReference]
Q.typeNamesWithinNamespace BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty
  let convertTerms :: NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
convertTerms = PathSegments
-> NamedRef (Referent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef (Referent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> (NamedRef (TextReferent, Maybe ConstructorType)
    -> NamedRef (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TextReferent, Maybe ConstructorType)
 -> (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReferent -> Referent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextReferent -> Referent
s2cTextReferent ((ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
s2cConstructorType))
  let convertTypes :: NamedRef TextReference -> NamedRef Reference
convertTypes = PathSegments -> NamedRef Reference -> NamedRef Reference
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef Reference -> NamedRef Reference)
-> (NamedRef TextReference -> NamedRef Reference)
-> NamedRef TextReference
-> NamedRef Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextReference -> Reference)
-> NamedRef TextReference -> NamedRef Reference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextReference -> Reference
s2cTextReference
  pure $
    NamesInPerspective
      { $sel:termNamesInPerspective:NamesInPerspective :: [NamedRef (Referent, Maybe ConstructorType)]
termNamesInPerspective = NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
convertTerms (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> [NamedRef (TextReferent, Maybe ConstructorType)]
-> [NamedRef (Referent, Maybe ConstructorType)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef (TextReferent, Maybe ConstructorType)]
termNamesInPerspective,
        $sel:typeNamesInPerspective:NamesInPerspective :: [NamedRef Reference]
typeNamesInPerspective = NamedRef TextReference -> NamedRef Reference
convertTypes (NamedRef TextReference -> NamedRef Reference)
-> [NamedRef TextReference] -> [NamedRef Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedRef TextReference]
typeNamesInPerspective
      }

-- | NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this
-- is only true on Share.
--
-- Get the list of a names for a given Referent.
termNamesForRefWithinNamespace :: NamesPerspective -> C.Referent -> Maybe S.ReversedName -> Transaction [S.ReversedName]
termNamesForRefWithinNamespace :: NamesPerspective
-> Referent -> Maybe ReversedName -> Transaction [ReversedName]
termNamesForRefWithinNamespace NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} Referent
ref Maybe ReversedName
maySuffix = do
  BranchHashId
-> PathSegments
-> TextReferent
-> Maybe ReversedName
-> Transaction [ReversedName]
Q.termNamesForRefWithinNamespace BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty (Referent -> TextReferent
c2sTextReferent Referent
ref) Maybe ReversedName
maySuffix
    Transaction [ReversedName]
-> ([ReversedName] -> [ReversedName]) -> Transaction [ReversedName]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ReversedName -> ReversedName) -> [ReversedName] -> [ReversedName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments -> ReversedName -> ReversedName
prefixReversedName PathSegments
pathToMountedNameLookup)

-- | NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this
-- is only true on Share.
--
-- Get the list of a names for a given Reference, with an optional required suffix.
typeNamesForRefWithinNamespace :: NamesPerspective -> C.Reference -> Maybe S.ReversedName -> Transaction [S.ReversedName]
typeNamesForRefWithinNamespace :: NamesPerspective
-> Reference -> Maybe ReversedName -> Transaction [ReversedName]
typeNamesForRefWithinNamespace NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} Reference
ref Maybe ReversedName
maySuffix = do
  BranchHashId
-> PathSegments
-> TextReference
-> Maybe ReversedName
-> Transaction [ReversedName]
Q.typeNamesForRefWithinNamespace BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty (Reference -> TextReference
c2sTextReference Reference
ref) Maybe ReversedName
maySuffix
    Transaction [ReversedName]
-> ([ReversedName] -> [ReversedName]) -> Transaction [ReversedName]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ReversedName -> ReversedName) -> [ReversedName] -> [ReversedName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments -> ReversedName -> ReversedName
prefixReversedName PathSegments
pathToMountedNameLookup)

termNamesBySuffix :: NamesPerspective -> S.ReversedName -> Transaction [S.NamedRef (C.Referent, Maybe C.ConstructorType)]
termNamesBySuffix :: NamesPerspective
-> ReversedName
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
termNamesBySuffix NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} ReversedName
suffix = do
  BranchHashId
-> PathSegments
-> ReversedName
-> Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
Q.termNamesBySuffix BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty ReversedName
suffix
    Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
-> ([NamedRef (TextReferent, Maybe ConstructorType)]
    -> [NamedRef (Referent, Maybe ConstructorType)])
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> [NamedRef (TextReferent, Maybe ConstructorType)]
-> [NamedRef (Referent, Maybe ConstructorType)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (TextReferent, Maybe ConstructorType)
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (TextReferent, Maybe ConstructorType))
-> (NamedRef (TextReferent, Maybe ConstructorType)
    -> NamedRef (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((TextReferent, Maybe ConstructorType)
 -> (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReferent -> Referent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextReferent -> Referent
s2cTextReferent ((ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
s2cConstructorType)))

typeNamesBySuffix :: NamesPerspective -> S.ReversedName -> Transaction [S.NamedRef C.Reference]
typeNamesBySuffix :: NamesPerspective
-> ReversedName -> Transaction [NamedRef Reference]
typeNamesBySuffix NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} ReversedName
suffix = do
  BranchHashId
-> PathSegments
-> ReversedName
-> Transaction [NamedRef TextReference]
Q.typeNamesBySuffix BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty ReversedName
suffix
    Transaction [NamedRef TextReference]
-> ([NamedRef TextReference] -> [NamedRef Reference])
-> Transaction [NamedRef Reference]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef TextReference -> NamedRef Reference)
-> [NamedRef TextReference] -> [NamedRef Reference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments -> NamedRef TextReference -> NamedRef TextReference
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef TextReference -> NamedRef TextReference)
-> (NamedRef TextReference -> NamedRef Reference)
-> NamedRef TextReference
-> NamedRef Reference
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (TextReference -> Reference)
-> NamedRef TextReference -> NamedRef Reference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextReference -> Reference
s2cTextReference)

-- | Helper for findings refs by name within the correct mounted indexes.
refsForExactName ::
  (Db.BranchHashId -> S.ReversedName -> Transaction [S.NamedRef ref]) ->
  NamesPerspective ->
  S.ReversedName ->
  Transaction [S.NamedRef ref]
refsForExactName :: forall ref.
(BranchHashId -> ReversedName -> Transaction [NamedRef ref])
-> NamesPerspective -> ReversedName -> Transaction [NamedRef ref]
refsForExactName BranchHashId -> ReversedName -> Transaction [NamedRef ref]
query NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} ReversedName
name = do
  [NamedRef ref]
namedRefs <- BranchHashId -> ReversedName -> Transaction [NamedRef ref]
query BranchHashId
nameLookupBranchHashId ReversedName
name
  pure $
    [NamedRef ref]
namedRefs
      [NamedRef ref] -> (NamedRef ref -> NamedRef ref) -> [NamedRef ref]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PathSegments -> NamedRef ref -> NamedRef ref
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup

-- | Requalifies a NamedRef to some namespace prefix.
prefixNamedRef :: NameLookups.PathSegments -> S.NamedRef ref -> S.NamedRef ref
prefixNamedRef :: forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
prefix S.NamedRef {ReversedName
reversedSegments :: ReversedName
$sel:reversedSegments:NamedRef :: forall ref. NamedRef ref -> ReversedName
reversedSegments, ref
ref :: ref
$sel:ref:NamedRef :: forall ref. NamedRef ref -> ref
ref} =
  S.NamedRef {$sel:reversedSegments:NamedRef :: ReversedName
reversedSegments = PathSegments -> ReversedName -> ReversedName
prefixReversedName PathSegments
prefix ReversedName
reversedSegments, ref
ref :: ref
$sel:ref:NamedRef :: ref
ref}

-- | Requalifies a ReversedName to some namespace prefix.
prefixReversedName :: PathSegments -> S.ReversedName -> S.ReversedName
prefixReversedName :: PathSegments -> ReversedName -> ReversedName
prefixReversedName (S.PathSegments [Text]
prefix) (S.ReversedName NonEmpty Text
reversedSegments) =
  NonEmpty Text -> ReversedName
S.ReversedName (NonEmpty Text -> ReversedName) -> NonEmpty Text -> ReversedName
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text] -> NonEmpty Text
forall a. NonEmpty a -> [a] -> NonEmpty a
NonEmpty.appendl NonEmpty Text
reversedSegments ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
prefix)

termRefsForExactName :: NamesPerspective -> S.ReversedName -> Transaction [S.NamedRef (C.Referent, Maybe C.ConstructorType)]
termRefsForExactName :: NamesPerspective
-> ReversedName
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
termRefsForExactName NamesPerspective
namesPerspective ReversedName
reversedName = do
  (BranchHashId
 -> ReversedName
 -> Transaction [NamedRef (TextReferent, Maybe ConstructorType)])
-> NamesPerspective
-> ReversedName
-> Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
forall ref.
(BranchHashId -> ReversedName -> Transaction [NamedRef ref])
-> NamesPerspective -> ReversedName -> Transaction [NamedRef ref]
refsForExactName BranchHashId
-> ReversedName
-> Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
Q.termRefsForExactName NamesPerspective
namesPerspective ReversedName
reversedName
    Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
-> ([NamedRef (TextReferent, Maybe ConstructorType)]
    -> [NamedRef (Referent, Maybe ConstructorType)])
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> [NamedRef (TextReferent, Maybe ConstructorType)]
-> [NamedRef (Referent, Maybe ConstructorType)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TextReferent, Maybe ConstructorType)
 -> (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReferent -> Referent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextReferent -> Referent
s2cTextReferent ((ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
s2cConstructorType)))

typeRefsForExactName :: NamesPerspective -> S.ReversedName -> Transaction [S.NamedRef C.Reference]
typeRefsForExactName :: NamesPerspective
-> ReversedName -> Transaction [NamedRef Reference]
typeRefsForExactName NamesPerspective
namesPerspective ReversedName
reversedName = do
  (BranchHashId
 -> ReversedName -> Transaction [NamedRef TextReference])
-> NamesPerspective
-> ReversedName
-> Transaction [NamedRef TextReference]
forall ref.
(BranchHashId -> ReversedName -> Transaction [NamedRef ref])
-> NamesPerspective -> ReversedName -> Transaction [NamedRef ref]
refsForExactName BranchHashId
-> ReversedName -> Transaction [NamedRef TextReference]
Q.typeRefsForExactName NamesPerspective
namesPerspective ReversedName
reversedName Transaction [NamedRef TextReference]
-> ([NamedRef TextReference] -> [NamedRef Reference])
-> Transaction [NamedRef Reference]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef TextReference -> NamedRef Reference)
-> [NamedRef TextReference] -> [NamedRef Reference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReference -> Reference)
-> NamedRef TextReference -> NamedRef Reference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextReference -> Reference
s2cTextReference)

-- | Get the name within the provided namespace that has the longest matching suffix
-- with the provided name, but a different ref.
-- This is a bit of a hack but allows us to shortcut suffixification.
-- We can clean this up if we make a custom PPE type just for sqlite pretty printing, but
-- for now this works fine.
longestMatchingTermNameForSuffixification :: NamesPerspective -> S.NamedRef C.Referent -> Transaction (Maybe (S.NamedRef (C.Referent, Maybe C.ConstructorType)))
longestMatchingTermNameForSuffixification :: NamesPerspective
-> NamedRef Referent
-> Transaction (Maybe (NamedRef (Referent, Maybe ConstructorType)))
longestMatchingTermNameForSuffixification NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} NamedRef Referent
namedRef = do
  BranchHashId
-> PathSegments
-> NamedRef TextReferent
-> Transaction
     (Maybe (NamedRef (TextReferent, Maybe ConstructorType)))
Q.longestMatchingTermNameForSuffixification BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty (Referent -> TextReferent
c2sTextReferent (Referent -> TextReferent)
-> NamedRef Referent -> NamedRef TextReferent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRef Referent
namedRef)
    Transaction
  (Maybe (NamedRef (TextReferent, Maybe ConstructorType)))
-> (Maybe (NamedRef (TextReferent, Maybe ConstructorType))
    -> Maybe (NamedRef (Referent, Maybe ConstructorType)))
-> Transaction (Maybe (NamedRef (Referent, Maybe ConstructorType)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> Maybe (NamedRef (TextReferent, Maybe ConstructorType))
-> Maybe (NamedRef (Referent, Maybe ConstructorType))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (TextReferent, Maybe ConstructorType)
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (TextReferent, Maybe ConstructorType))
-> (NamedRef (TextReferent, Maybe ConstructorType)
    -> NamedRef (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((TextReferent, Maybe ConstructorType)
 -> (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReferent -> Referent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextReferent -> Referent
s2cTextReferent ((ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
s2cConstructorType)))

-- | Get the name within the provided namespace that has the longest matching suffix
-- with the provided name, but a different ref.
-- This is a bit of a hack but allows us to shortcut suffixification.
-- We can clean this up if we make a custom PPE type just for sqlite pretty printing, but
-- for now this works fine.
longestMatchingTypeNameForSuffixification :: NamesPerspective -> S.NamedRef C.Reference -> Transaction (Maybe (S.NamedRef C.Reference))
longestMatchingTypeNameForSuffixification :: NamesPerspective
-> NamedRef Reference -> Transaction (Maybe (NamedRef Reference))
longestMatchingTypeNameForSuffixification NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup :: PathSegments
pathToMountedNameLookup} NamedRef Reference
namedRef = do
  BranchHashId
-> PathSegments
-> NamedRef TextReference
-> Transaction (Maybe (NamedRef TextReference))
Q.longestMatchingTypeNameForSuffixification BranchHashId
nameLookupBranchHashId PathSegments
forall a. Monoid a => a
mempty (Reference -> TextReference
c2sTextReference (Reference -> TextReference)
-> NamedRef Reference -> NamedRef TextReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRef Reference
namedRef)
    Transaction (Maybe (NamedRef TextReference))
-> (Maybe (NamedRef TextReference) -> Maybe (NamedRef Reference))
-> Transaction (Maybe (NamedRef Reference))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef TextReference -> NamedRef Reference)
-> Maybe (NamedRef TextReference) -> Maybe (NamedRef Reference)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PathSegments -> NamedRef TextReference -> NamedRef TextReference
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
prefixNamedRef PathSegments
pathToMountedNameLookup (NamedRef TextReference -> NamedRef TextReference)
-> (NamedRef TextReference -> NamedRef Reference)
-> NamedRef TextReference
-> NamedRef Reference
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (TextReference -> Reference)
-> NamedRef TextReference -> NamedRef Reference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextReference -> Reference
s2cTextReference)

-- | Searches all dependencies transitively looking for the provided ref within the
-- provided namespace.
-- Prefer 'termNamesForRefWithinNamespace' in most cases.
-- This is slower and only necessary when resolving the name of refs when you don't know which
-- dependency it may exist in.
--
-- Searching transitive dependencies is exponential so we want to replace this with a more
-- efficient approach as soon as possible.
--
-- Note: this returns the first name it finds by searching in order of:
-- Names in the current namespace, then names in the current namespace's dependencies, then
-- through the current namespace's dependencies' dependencies, etc.
recursiveTermNameSearch :: NamesPerspective -> C.Referent -> Transaction (Maybe S.ReversedName)
recursiveTermNameSearch :: NamesPerspective -> Referent -> Transaction (Maybe ReversedName)
recursiveTermNameSearch NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId} Referent
r = do
  BranchHashId -> TextReferent -> Transaction (Maybe ReversedName)
Q.recursiveTermNameSearch BranchHashId
nameLookupBranchHashId (Referent -> TextReferent
c2sTextReferent Referent
r)

-- | Searches all dependencies transitively looking for the provided ref within the provided
-- namespace.
-- Prefer 'typeNamesForRefWithinNamespace' in most cases.
-- This is slower and only necessary when resolving the name of references when you don't know which
-- dependency it may exist in.
--
-- Searching transitive dependencies is exponential so we want to replace this with a more
-- efficient approach as soon as possible.
--
-- Note: this returns the first name it finds by searching in order of:
-- Names in the current namespace, then names in the current namespace's dependencies, then
-- through the current namespace's dependencies' dependencies, etc.
recursiveTypeNameSearch :: NamesPerspective -> C.Reference -> Transaction (Maybe S.ReversedName)
recursiveTypeNameSearch :: NamesPerspective -> Reference -> Transaction (Maybe ReversedName)
recursiveTypeNameSearch NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId} Reference
r = do
  BranchHashId -> TextReference -> Transaction (Maybe ReversedName)
Q.recursiveTypeNameSearch BranchHashId
nameLookupBranchHashId (Reference -> TextReference
c2sTextReference Reference
r)

-- | Looks up statistics for a given branch, if none exist, we compute them and save them
-- then return them.
expectNamespaceStatsByHash :: BranchHash -> Transaction C.Branch.NamespaceStats
expectNamespaceStatsByHash :: BranchHash -> Transaction NamespaceStats
expectNamespaceStatsByHash BranchHash
bh = do
  BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
bh
  BranchHashId -> Transaction NamespaceStats
expectNamespaceStatsByHashId BranchHashId
bhId

-- | Looks up statistics for a given branch, if none exist, we compute them and save them
-- then return them.
expectNamespaceStatsByHashId :: Db.BranchHashId -> Transaction C.Branch.NamespaceStats
expectNamespaceStatsByHashId :: BranchHashId -> Transaction NamespaceStats
expectNamespaceStatsByHashId BranchHashId
bhId = do
  BranchHashId -> Transaction (Maybe NamespaceStats)
Q.loadNamespaceStatsByHashId BranchHashId
bhId Transaction (Maybe NamespaceStats)
-> Transaction NamespaceStats -> Transaction NamespaceStats
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` do
    BranchObjectId
boId <- ObjectId -> BranchObjectId
Db.BranchObjectId (ObjectId -> BranchObjectId)
-> Transaction ObjectId -> Transaction BranchObjectId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashId -> Transaction ObjectId
Q.expectObjectIdForPrimaryHashId (BranchHashId -> HashId
Db.unBranchHashId BranchHashId
bhId)
    Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
dbBranch <- BranchObjectId
-> Transaction
     (Branch'
        TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId))
expectDbBranch BranchObjectId
boId
    NamespaceStats
stats <- DbBranchV -> Transaction NamespaceStats
namespaceStatsForDbBranch (Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
-> DbBranchV
DbBranchV2 Branch'
  TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
dbBranch)
    BranchHashId -> NamespaceStats -> Transaction ()
Q.saveNamespaceStats BranchHashId
bhId NamespaceStats
stats
    pure NamespaceStats
stats

namespaceStatsForDbBranch :: DbBranchV -> Transaction NamespaceStats
namespaceStatsForDbBranch :: DbBranchV -> Transaction NamespaceStats
namespaceStatsForDbBranch = \case
  DbBranchV2 S.Branch {Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms :: Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms, Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types :: Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types, Map TextId PatchObjectId
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
patches :: Map TextId PatchObjectId
patches, Map TextId (BranchObjectId, CausalHashId)
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
children :: Map TextId (BranchObjectId, CausalHashId)
children} -> do
    let myStats :: NamespaceStats
myStats =
          NamespaceStats
            { $sel:numContainedTerms:NamespaceStats :: Int
numContainedTerms = Getting
  (Endo (Endo Int))
  (Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
  (MetadataSetFormat' TextId ObjectId)
-> Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Int
forall s a. Getting (Endo (Endo Int)) s a -> s -> Int
lengthOf ((Map
   (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
 -> Const
      (Endo (Endo Int))
      (Map
         (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
-> Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
-> Const
     (Endo (Endo Int))
     (Map
        TextId
        (Map
           (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map
     TextId
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
folded ((Map
    (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
  -> Const
       (Endo (Endo Int))
       (Map
          (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
 -> Map
      TextId
      (Map
         (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
 -> Const
      (Endo (Endo Int))
      (Map
         TextId
         (Map
            (Referent'' TextId ObjectId)
            (MetadataSetFormat' TextId ObjectId))))
-> ((MetadataSetFormat' TextId ObjectId
     -> Const (Endo (Endo Int)) (MetadataSetFormat' TextId ObjectId))
    -> Map
         (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
    -> Const
         (Endo (Endo Int))
         (Map
            (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
-> Getting
     (Endo (Endo Int))
     (Map
        TextId
        (Map
           (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)))
     (MetadataSetFormat' TextId ObjectId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataSetFormat' TextId ObjectId
 -> Const (Endo (Endo Int)) (MetadataSetFormat' TextId ObjectId))
-> Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId)
-> Const
     (Endo (Endo Int))
     (Map
        (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
  (MetadataSetFormat' TextId ObjectId)
folded) Map
  TextId
  (Map
     (Referent'' TextId ObjectId) (MetadataSetFormat' TextId ObjectId))
terms,
              $sel:numContainedTypes:NamespaceStats :: Int
numContainedTypes = Getting
  (Endo (Endo Int))
  (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId)))
  (MetadataSetFormat' TextId ObjectId)
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Int
forall s a. Getting (Endo (Endo Int)) s a -> s -> Int
lengthOf ((Map Reference (MetadataSetFormat' TextId ObjectId)
 -> Const
      (Endo (Endo Int))
      (Map Reference (MetadataSetFormat' TextId ObjectId)))
-> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
-> Const
     (Endo (Endo Int))
     (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId)))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId)))
  (Map Reference (MetadataSetFormat' TextId ObjectId))
folded ((Map Reference (MetadataSetFormat' TextId ObjectId)
  -> Const
       (Endo (Endo Int))
       (Map Reference (MetadataSetFormat' TextId ObjectId)))
 -> Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
 -> Const
      (Endo (Endo Int))
      (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))))
-> ((MetadataSetFormat' TextId ObjectId
     -> Const (Endo (Endo Int)) (MetadataSetFormat' TextId ObjectId))
    -> Map Reference (MetadataSetFormat' TextId ObjectId)
    -> Const
         (Endo (Endo Int))
         (Map Reference (MetadataSetFormat' TextId ObjectId)))
-> Getting
     (Endo (Endo Int))
     (Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId)))
     (MetadataSetFormat' TextId ObjectId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataSetFormat' TextId ObjectId
 -> Const (Endo (Endo Int)) (MetadataSetFormat' TextId ObjectId))
-> Map Reference (MetadataSetFormat' TextId ObjectId)
-> Const
     (Endo (Endo Int))
     (Map Reference (MetadataSetFormat' TextId ObjectId))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map Reference (MetadataSetFormat' TextId ObjectId))
  (MetadataSetFormat' TextId ObjectId)
folded) Map TextId (Map Reference (MetadataSetFormat' TextId ObjectId))
types,
              $sel:numContainedPatches:NamespaceStats :: Int
numContainedPatches = Map TextId PatchObjectId -> Int
forall k a. Map k a -> Int
Map.size Map TextId PatchObjectId
patches
            }
    NamespaceStats
childrenStats <- Map TextId (BranchObjectId, CausalHashId)
-> Transaction NamespaceStats
getChildrenStats Map TextId (BranchObjectId, CausalHashId)
children
    pure (NamespaceStats
myStats NamespaceStats -> NamespaceStats -> NamespaceStats
forall a. Semigroup a => a -> a -> a
<> NamespaceStats
childrenStats)
  DbBranchV3 S.BranchV3 {Map TextId (BranchObjectId, CausalHashId)
$sel:children:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t c
children :: Map TextId (BranchObjectId, CausalHashId)
children, Map TextId (Referent'' TextId ObjectId)
$sel:terms:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t (Referent'' t h)
terms :: Map TextId (Referent'' TextId ObjectId)
terms, Map TextId Reference
$sel:types:BranchV3 :: forall t h c. GBranchV3 t h c -> Map t (TypeReference' t h)
types :: Map TextId Reference
types} -> do
    let myStats :: NamespaceStats
myStats =
          NamespaceStats
            { $sel:numContainedTerms:NamespaceStats :: Int
numContainedTerms = Map TextId (Referent'' TextId ObjectId) -> Int
forall k a. Map k a -> Int
Map.size Map TextId (Referent'' TextId ObjectId)
terms,
              $sel:numContainedTypes:NamespaceStats :: Int
numContainedTypes = Map TextId Reference -> Int
forall k a. Map k a -> Int
Map.size Map TextId Reference
types,
              $sel:numContainedPatches:NamespaceStats :: Int
numContainedPatches = Int
0
            }
    NamespaceStats
childrenStats <- Map TextId (BranchObjectId, CausalHashId)
-> Transaction NamespaceStats
getChildrenStats Map TextId (BranchObjectId, CausalHashId)
children
    pure (NamespaceStats
myStats NamespaceStats -> NamespaceStats -> NamespaceStats
forall a. Semigroup a => a -> a -> a
<> NamespaceStats
childrenStats)
  where
    getChildrenStats :: Map Db.TextId (Db.BranchObjectId, Db.CausalHashId) -> Transaction NamespaceStats
    getChildrenStats :: Map TextId (BranchObjectId, CausalHashId)
-> Transaction NamespaceStats
getChildrenStats =
      ((BranchObjectId, CausalHashId) -> Transaction NamespaceStats)
-> Map TextId (BranchObjectId, CausalHashId)
-> Transaction NamespaceStats
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \(BranchObjectId
_boId, CausalHashId
chId) -> do
        BranchHashId
bhId <- CausalHashId -> Transaction BranchHashId
Q.expectCausalValueHashId CausalHashId
chId
        BranchHashId -> Transaction NamespaceStats
expectNamespaceStatsByHashId BranchHashId
bhId

-- | Gets the specified number of reflog entries in chronological order, most recent first.
getDeprecatedRootReflog :: Int -> Transaction [Reflog.Entry CausalHash Text]
getDeprecatedRootReflog :: Int -> Transaction [Entry CausalHash Text]
getDeprecatedRootReflog Int
numEntries = do
  [Entry CausalHashId Text]
entries <- Int -> Transaction [Entry CausalHashId Text]
Q.getDeprecatedRootReflog Int
numEntries
  (Entry CausalHashId Text -> Transaction (Entry CausalHash Text))
-> [Entry CausalHashId Text] -> Transaction [Entry CausalHash Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((CausalHashId -> Transaction CausalHash)
-> (Text -> Transaction Text)
-> Entry CausalHashId Text
-> Transaction (Entry CausalHash Text)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Entry a b -> f (Entry c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse CausalHashId -> Transaction CausalHash
Q.expectCausalHash Text -> Transaction Text
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Entry CausalHashId Text]
entries

-- | Gets the specified number of reflog entries for the given project in chronological order, most recent first.
getProjectReflog :: Int -> Db.ProjectId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]
getProjectReflog :: Int
-> ProjectId
-> Transaction [Entry Project ProjectBranch CausalHash]
getProjectReflog Int
numEntries ProjectId
projectId = do
  [Entry ProjectId ProjectBranchId CausalHashId]
entries <- Int
-> ProjectId
-> Transaction [Entry ProjectId ProjectBranchId CausalHashId]
Q.getProjectReflog Int
numEntries ProjectId
projectId
  (Entry ProjectId ProjectBranchId CausalHashId
 -> Transaction (Entry Project ProjectBranch CausalHash))
-> [Entry ProjectId ProjectBranchId CausalHashId]
-> Transaction [Entry Project ProjectBranch CausalHash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Entry ProjectId ProjectBranchId CausalHashId
-> Transaction (Entry Project ProjectBranch CausalHash)
hydrateProjectReflogEntry [Entry ProjectId ProjectBranchId CausalHashId]
entries

-- | Gets the specified number of reflog entries for the specified ProjectBranch in chronological order, most recent first.
getProjectBranchReflog :: Int -> Db.ProjectBranchId -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]
getProjectBranchReflog :: Int
-> ProjectBranchId
-> Transaction [Entry Project ProjectBranch CausalHash]
getProjectBranchReflog Int
numEntries ProjectBranchId
projectBranchId = do
  [Entry ProjectId ProjectBranchId CausalHashId]
entries <- Int
-> ProjectBranchId
-> Transaction [Entry ProjectId ProjectBranchId CausalHashId]
Q.getProjectBranchReflog Int
numEntries ProjectBranchId
projectBranchId
  (Entry ProjectId ProjectBranchId CausalHashId
 -> Transaction (Entry Project ProjectBranch CausalHash))
-> [Entry ProjectId ProjectBranchId CausalHashId]
-> Transaction [Entry Project ProjectBranch CausalHash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Entry ProjectId ProjectBranchId CausalHashId
-> Transaction (Entry Project ProjectBranch CausalHash)
hydrateProjectReflogEntry [Entry ProjectId ProjectBranchId CausalHashId]
entries

-- | Gets the specified number of reflog entries in chronological order, most recent first.
getGlobalReflog :: Int -> Transaction [ProjectReflog.Entry Project ProjectBranch CausalHash]
getGlobalReflog :: Int -> Transaction [Entry Project ProjectBranch CausalHash]
getGlobalReflog Int
numEntries = do
  [Entry ProjectId ProjectBranchId CausalHashId]
entries <- Int -> Transaction [Entry ProjectId ProjectBranchId CausalHashId]
Q.getGlobalReflog Int
numEntries
  (Entry ProjectId ProjectBranchId CausalHashId
 -> Transaction (Entry Project ProjectBranch CausalHash))
-> [Entry ProjectId ProjectBranchId CausalHashId]
-> Transaction [Entry Project ProjectBranch CausalHash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Entry ProjectId ProjectBranchId CausalHashId
-> Transaction (Entry Project ProjectBranch CausalHash)
hydrateProjectReflogEntry [Entry ProjectId ProjectBranchId CausalHashId]
entries

hydrateProjectReflogEntry :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId Db.CausalHashId -> Transaction (ProjectReflog.Entry Project ProjectBranch CausalHash)
hydrateProjectReflogEntry :: Entry ProjectId ProjectBranchId CausalHashId
-> Transaction (Entry Project ProjectBranch CausalHash)
hydrateProjectReflogEntry Entry ProjectId ProjectBranchId CausalHashId
entry = do
  (CausalHashId -> Transaction CausalHash)
-> Entry ProjectId ProjectBranchId CausalHashId
-> Transaction (Entry ProjectId ProjectBranchId CausalHash)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Entry ProjectId ProjectBranchId a
-> f (Entry ProjectId ProjectBranchId b)
traverse CausalHashId -> Transaction CausalHash
Q.expectCausalHash Entry ProjectId ProjectBranchId CausalHashId
entry
    Transaction (Entry ProjectId ProjectBranchId CausalHash)
-> (Entry ProjectId ProjectBranchId CausalHash
    -> Transaction (Entry Project ProjectBranch CausalHash))
-> Transaction (Entry Project ProjectBranch CausalHash)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ProjectId, ProjectBranchId)
 -> Transaction (Project, ProjectBranch))
-> Entry ProjectId ProjectBranchId CausalHash
-> Transaction (Entry Project ProjectBranch CausalHash)
forall project branch causal project' branch' (f :: * -> *).
Functor f =>
((project, branch) -> f (project', branch'))
-> Entry project branch causal -> f (Entry project' branch' causal)
ProjectReflog.projectAndBranch_
      (((ProjectId, ProjectBranchId)
  -> Transaction (Project, ProjectBranch))
 -> Entry ProjectId ProjectBranchId CausalHash
 -> Transaction (Entry Project ProjectBranch CausalHash))
-> ((ProjectId, ProjectBranchId)
    -> Transaction (Project, ProjectBranch))
-> Entry ProjectId ProjectBranchId CausalHash
-> Transaction (Entry Project ProjectBranch CausalHash)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ ( \(ProjectId
projId, ProjectBranchId
branchId) -> do
              Project
proj <- ProjectId -> Transaction Project
Q.expectProject ProjectId
projId
              ProjectBranch
branch <- ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Q.expectProjectBranch ProjectId
projId ProjectBranchId
branchId
              pure (Project
proj, ProjectBranch
branch)
          )

appendProjectReflog :: ProjectReflog.Entry Db.ProjectId Db.ProjectBranchId CausalHash -> Transaction ()
appendProjectReflog :: Entry ProjectId ProjectBranchId CausalHash -> Transaction ()
appendProjectReflog Entry ProjectId ProjectBranchId CausalHash
entry = do
  Entry ProjectId ProjectBranchId CausalHashId
dbEntry <- (CausalHash -> Transaction CausalHashId)
-> Entry ProjectId ProjectBranchId CausalHash
-> Transaction (Entry ProjectId ProjectBranchId CausalHashId)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Entry ProjectId ProjectBranchId a
-> f (Entry ProjectId ProjectBranchId b)
traverse CausalHash -> Transaction CausalHashId
Q.saveCausalHash Entry ProjectId ProjectBranchId CausalHash
entry
  Entry ProjectId ProjectBranchId CausalHashId -> Transaction ()
Q.appendProjectBranchReflog Entry ProjectId ProjectBranchId CausalHashId
dbEntry

-- | Delete any name lookup that's not in the provided list.
--
-- This can be used to garbage collect unreachable name lookups.
deleteNameLookupsExceptFor :: Set BranchHash -> Transaction ()
deleteNameLookupsExceptFor :: Set BranchHash -> Transaction ()
deleteNameLookupsExceptFor Set BranchHash
reachable = do
  [BranchHashId]
bhIds <- [BranchHash]
-> (BranchHash -> Transaction BranchHashId)
-> Transaction [BranchHashId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set BranchHash -> [BranchHash]
forall a. Set a -> [a]
Set.toList Set BranchHash
reachable) BranchHash -> Transaction BranchHashId
Q.expectBranchHashId
  [BranchHashId] -> Transaction ()
Q.deleteNameLookupsExceptFor [BranchHashId]
bhIds

-- | Get the causal hash which would be the result of squashing the provided branch hash.
-- Returns Nothing if we haven't computed it before.
tryGetSquashResult :: BranchHash -> Transaction (Maybe CausalHash)
tryGetSquashResult :: BranchHash -> Transaction (Maybe CausalHash)
tryGetSquashResult BranchHash
bh = do
  BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
bh
  Maybe CausalHashId
chId <- BranchHashId -> Transaction (Maybe CausalHashId)
Q.tryGetSquashResult BranchHashId
bhId
  (CausalHashId -> Transaction CausalHash)
-> Maybe CausalHashId -> Transaction (Maybe CausalHash)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse CausalHashId -> Transaction CausalHash
Q.expectCausalHash Maybe CausalHashId
chId

-- | Saves the result of a squash
saveSquashResult :: BranchHash -> CausalHash -> Transaction ()
saveSquashResult :: BranchHash -> CausalHash -> Transaction ()
saveSquashResult BranchHash
bh CausalHash
ch = do
  BranchHashId
bhId <- BranchHash -> Transaction BranchHashId
Q.expectBranchHashId BranchHash
bh
  CausalHashId
chId <- CausalHash -> Transaction CausalHashId
Q.saveCausalHash CausalHash
ch
  BranchHashId -> CausalHashId -> Transaction ()
Q.saveSquashResult BranchHashId
bhId CausalHashId
chId

-- | Search for term or type names which contain the provided list of segments in order.
-- Search is case insensitive.
fuzzySearchDefinitions ::
  Bool ->
  NamesPerspective ->
  -- | Will return at most n terms and n types; i.e. max number of results is 2n
  Int ->
  [Text] ->
  Transaction ([S.NamedRef (C.Referent, Maybe C.ConstructorType)], [S.NamedRef C.Reference])
fuzzySearchDefinitions :: Bool
-> NamesPerspective
-> Int
-> [Text]
-> Transaction
     ([NamedRef (Referent, Maybe ConstructorType)],
      [NamedRef Reference])
fuzzySearchDefinitions Bool
includeDependencies NamesPerspective {BranchHashId
$sel:nameLookupBranchHashId:NamesPerspective :: NamesPerspective -> BranchHashId
nameLookupBranchHashId :: BranchHashId
nameLookupBranchHashId, PathSegments
$sel:relativePerspective:NamesPerspective :: NamesPerspective -> PathSegments
relativePerspective :: PathSegments
relativePerspective} Int
limit [Text]
querySegments = do
  [NamedRef (Referent, Maybe ConstructorType)]
termNames <-
    Bool
-> BranchHashId
-> Int
-> PathSegments
-> [Text]
-> Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
Q.fuzzySearchTerms Bool
includeDependencies BranchHashId
nameLookupBranchHashId Int
limit PathSegments
relativePerspective [Text]
querySegments
      Transaction [NamedRef (TextReferent, Maybe ConstructorType)]
-> ([NamedRef (TextReferent, Maybe ConstructorType)]
    -> [NamedRef (Referent, Maybe ConstructorType)])
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef (TextReferent, Maybe ConstructorType)
 -> NamedRef (Referent, Maybe ConstructorType))
-> [NamedRef (TextReferent, Maybe ConstructorType)]
-> [NamedRef (Referent, Maybe ConstructorType)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \NamedRef (TextReferent, Maybe ConstructorType)
termName ->
        NamedRef (TextReferent, Maybe ConstructorType)
termName
          NamedRef (TextReferent, Maybe ConstructorType)
-> (NamedRef (TextReferent, Maybe ConstructorType)
    -> NamedRef (Referent, Maybe ConstructorType))
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. a -> (a -> b) -> b
& (((TextReferent, Maybe ConstructorType)
 -> (Referent, Maybe ConstructorType))
-> NamedRef (TextReferent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReferent -> Referent)
-> (Maybe ConstructorType -> Maybe ConstructorType)
-> (TextReferent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextReferent -> Referent
s2cTextReferent ((ConstructorType -> ConstructorType)
-> Maybe ConstructorType -> Maybe ConstructorType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorType -> ConstructorType
s2cConstructorType)))
          NamedRef (Referent, Maybe ConstructorType)
-> (NamedRef (Referent, Maybe ConstructorType)
    -> NamedRef (Referent, Maybe ConstructorType))
-> NamedRef (Referent, Maybe ConstructorType)
forall a b. a -> (a -> b) -> b
& PathSegments
-> NamedRef (Referent, Maybe ConstructorType)
-> NamedRef (Referent, Maybe ConstructorType)
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
stripPrefixFromNamedRef PathSegments
relativePerspective
  [NamedRef Reference]
typeNames <-
    Bool
-> BranchHashId
-> Int
-> PathSegments
-> [Text]
-> Transaction [NamedRef TextReference]
Q.fuzzySearchTypes Bool
includeDependencies BranchHashId
nameLookupBranchHashId Int
limit PathSegments
relativePerspective [Text]
querySegments
      Transaction [NamedRef TextReference]
-> ([NamedRef TextReference] -> [NamedRef Reference])
-> Transaction [NamedRef Reference]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef TextReference -> NamedRef Reference)
-> [NamedRef TextReference] -> [NamedRef Reference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextReference -> Reference)
-> NamedRef TextReference -> NamedRef Reference
forall a b. (a -> b) -> NamedRef a -> NamedRef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextReference -> Reference
s2cTextReference)
      Transaction [NamedRef Reference]
-> ([NamedRef Reference] -> [NamedRef Reference])
-> Transaction [NamedRef Reference]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NamedRef Reference -> NamedRef Reference)
-> [NamedRef Reference] -> [NamedRef Reference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \NamedRef Reference
typeName ->
        NamedRef Reference
typeName
          NamedRef Reference
-> (NamedRef Reference -> NamedRef Reference) -> NamedRef Reference
forall a b. a -> (a -> b) -> b
& PathSegments -> NamedRef Reference -> NamedRef Reference
forall ref. PathSegments -> NamedRef ref -> NamedRef ref
stripPrefixFromNamedRef PathSegments
relativePerspective
  pure ([NamedRef (Referent, Maybe ConstructorType)]
termNames, [NamedRef Reference]
typeNames)

-- | Strips a prefix path from a named ref. No-op if the prefix doesn't match.
--
-- >>> stripPrefixFromNamedRef (PathSegments ["foo", "bar"]) (S.NamedRef (S.ReversedName ("baz" NonEmpty.:| ["bar", "foo"])) ())
-- NamedRef {reversedSegments = ReversedName ("baz" :| []), ref = ()}
--
-- >>> stripPrefixFromNamedRef (PathSegments ["no", "match"]) (S.NamedRef (S.ReversedName ("baz" NonEmpty.:| ["bar", "foo"])) ())
-- NamedRef {reversedSegments = ReversedName ("baz" :| ["bar","foo"]), ref = ()}
stripPrefixFromNamedRef :: PathSegments -> S.NamedRef r -> S.NamedRef r
stripPrefixFromNamedRef :: forall ref. PathSegments -> NamedRef ref -> NamedRef ref
stripPrefixFromNamedRef (PathSegments [Text]
prefix) NamedRef r
namedRef =
  let newReversedName :: ReversedName
newReversedName =
        NamedRef r -> ReversedName
forall ref. NamedRef ref -> ReversedName
S.reversedSegments NamedRef r
namedRef
          ReversedName -> (ReversedName -> ReversedName) -> ReversedName
forall a b. a -> (a -> b) -> b
& \case
            reversedName :: ReversedName
reversedName@(S.ReversedName (Text
name NonEmpty.:| [Text]
reversedPath)) ->
              case [Text] -> [Text] -> Maybe [Text]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripSuffix ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
prefix) [Text]
reversedPath of
                Maybe [Text]
Nothing -> ReversedName
reversedName
                Just [Text]
strippedReversedPath -> NonEmpty Text -> ReversedName
S.ReversedName (Text
name Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [Text]
strippedReversedPath)
   in NamedRef r
namedRef {S.reversedSegments = newReversedName}

expectProjectAndBranchNames :: Db.ProjectId -> Db.ProjectBranchId -> Transaction (ProjectName, ProjectBranchName)
expectProjectAndBranchNames :: ProjectId
-> ProjectBranchId -> Transaction (ProjectName, ProjectBranchName)
expectProjectAndBranchNames ProjectId
projectId ProjectBranchId
projectBranchId = do
  Project {$sel:name:Project :: Project -> ProjectName
name = ProjectName
pName} <- ProjectId -> Transaction Project
Q.expectProject ProjectId
projectId
  ProjectBranch {$sel:name:ProjectBranch :: ProjectBranch -> ProjectBranchName
name = ProjectBranchName
bName} <- ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Q.expectProjectBranch ProjectId
projectId ProjectBranchId
projectBranchId
  (ProjectName, ProjectBranchName)
-> Transaction (ProjectName, ProjectBranchName)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName
pName, ProjectBranchName
bName)

expectProjectBranchHead :: Db.ProjectId -> Db.ProjectBranchId -> Transaction CausalHash
expectProjectBranchHead :: ProjectId -> ProjectBranchId -> Transaction CausalHash
expectProjectBranchHead ProjectId
projId ProjectBranchId
projectBranchId = do
  CausalHashId
chId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projId ProjectBranchId
projectBranchId
  CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
chId