module Unison.Codebase
  ( Codebase,

    -- * UCM session state
    expectCurrentProjectPath,
    setCurrentProjectPath,
    resolveProjectPathIds,

    -- * Terms
    getTerm,
    unsafeGetTerm,
    unsafeGetTermWithType,
    getTermComponentWithTypes,
    unsafeGetTermComponent,
    getTypeOfTerm,
    getDeclType,
    unsafeGetTypeOfTermById,
    isTerm,
    putTerm,
    putTermComponent,

    -- ** Referents (sorta-termlike)
    getTypeOfReferent,

    -- ** Search
    termsOfType,
    filterTermsByReferenceIdHavingType,
    filterTermsByReferentHavingType,
    termsMentioningType,
    SqliteCodebase.Operations.termReferencesByPrefix,
    termReferentsByPrefix,

    -- * Type declarations
    getTypeDeclaration,
    unsafeGetTypeDeclaration,
    SqliteCodebase.Operations.getDeclComponent,
    putTypeDeclaration,
    putTypeDeclarationComponent,
    SqliteCodebase.Operations.typeReferencesByPrefix,
    isType,

    -- * Branches
    SqliteCodebase.Operations.branchExists,
    getBranchForHash,
    expectBranchForHash,
    putBranch,
    SqliteCodebase.Operations.causalHashesByPrefix,
    lca,
    SqliteCodebase.Operations.before,
    getShallowBranchAtPath,
    getMaybeShallowBranchAtPath,
    getShallowCausalAtPath,
    Operations.expectCausalBranchByCausalHash,
    getShallowCausalAtPathFromRootHash,
    getShallowProjectBranchRoot,
    expectShallowProjectBranchRoot,
    getShallowBranchAtProjectPath,
    getMaybeShallowBranchAtProjectPath,
    getShallowProjectRootByNames,
    expectProjectBranchRoot,
    getBranchAtProjectPath,
    preloadProjectBranch,

    -- * Root branch
    SqliteCodebase.Operations.namesAtPath,

    -- * Patches
    SqliteCodebase.Operations.patchExists,
    SqliteCodebase.Operations.getPatch,
    SqliteCodebase.Operations.putPatch,

    -- * Watches
    getWatch,
    lookupWatchCache,
    SqliteCodebase.Operations.watches,
    SqliteCodebase.Operations.putWatch,
    Queries.clearWatches,

    -- * Reflog
    Operations.getDeprecatedRootReflog,
    Operations.getProjectBranchReflog,
    Operations.getProjectReflog,
    Operations.getGlobalReflog,

    -- * Unambiguous hash length
    SqliteCodebase.Operations.hashLength,
    SqliteCodebase.Operations.branchHashLength,

    -- * Dependents
    dependents,
    dependentsOfComponent,

    -- * Sync

    -- * Codebase path
    getCodebaseDir,
    CodebasePath,

    -- * Direct codebase access
    runTransaction,
    runTransactionWithRollback,
    withConnection,
    withConnectionIO,

    -- * Misc (organize these better)
    addDefsToCodebase,
    componentReferencesForReference,
    installUcmDependencies,
    typeLookupForDependencies,
    unsafeGetComponentLength,
    SqliteCodebase.Operations.emptyCausalHash,
  )
where

import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.DbId qualified as Db
import U.Codebase.Sqlite.Operations qualified as Operations
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.Queries qualified as Q
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Builtin qualified as Builtin
import Unison.Builtin.Terms qualified as Builtin
import Unison.Codebase.Branch (Branch)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation (builtinAnnotation))
import Unison.Codebase.Path
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.Codebase.SqliteCodebase.Operations qualified as SqliteCodebase.Operations
import Unison.Codebase.Type (Codebase (..))
import Unison.CodebasePath (CodebasePath, getCodebaseDir)
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.Core.Project (ProjectAndBranch)
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DD
import Unison.Hash (Hash)
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Parser
import Unison.Prelude
import Unison.Project (ProjectAndBranch (ProjectAndBranch), ProjectBranchName, ProjectName)
import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker.TypeLookup (TypeLookup (TypeLookup))
import Unison.Typechecker.TypeLookup qualified as TL
import Unison.UnisonFile qualified as UF
import Unison.Util.Defns (Defns (..), DefnsF)
import Unison.Util.Relation qualified as Rel
import Unison.Var (Var)
import Unison.WatchKind qualified as WK

-- | Run a transaction on a codebase.
runTransaction :: (MonadIO m) => Codebase m v a -> Sqlite.Transaction b -> m b
runTransaction :: forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
runTransaction Codebase {forall x. (Connection -> m x) -> m x
$sel:withConnection:Codebase :: forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> m x) -> m x
withConnection :: forall x. (Connection -> m x) -> m x
withConnection} Transaction b
action =
  (Connection -> m b) -> m b
forall x. (Connection -> m x) -> m x
withConnection \Connection
conn -> Connection -> Transaction b -> m b
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection -> Transaction a -> m a
Sqlite.runTransaction Connection
conn Transaction b
action

runTransactionWithRollback ::
  (MonadIO m) =>
  Codebase m v a ->
  ((forall void. b -> Sqlite.Transaction void) -> Sqlite.Transaction b) ->
  m b
runTransactionWithRollback :: forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a
-> ((forall void. b -> Transaction void) -> Transaction b) -> m b
runTransactionWithRollback Codebase {forall x. (Connection -> m x) -> m x
$sel:withConnection:Codebase :: forall (m :: * -> *) v a.
Codebase m v a -> forall x. (Connection -> m x) -> m x
withConnection :: forall x. (Connection -> m x) -> m x
withConnection} (forall void. b -> Transaction void) -> Transaction b
action =
  (Connection -> m b) -> m b
forall x. (Connection -> m x) -> m x
withConnection \Connection
conn -> Connection
-> ((forall void. b -> Transaction void) -> Transaction b) -> m b
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
Connection
-> ((forall void. a -> Transaction void) -> Transaction a) -> m a
Sqlite.runTransactionWithRollback Connection
conn (forall void. b -> Transaction void) -> Transaction b
action

getShallowCausalAtPathFromRootHash ::
  -- Causal to start at, if Nothing use the codebase's root branch.
  CausalHash ->
  Path.Path ->
  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
getShallowCausalAtPathFromRootHash :: CausalHash -> Path -> Transaction (CausalBranch Transaction)
getShallowCausalAtPathFromRootHash CausalHash
rootCausalHash Path
p = do
  CausalBranch Transaction
rootCausal <- CausalHash -> Transaction (CausalBranch Transaction)
Operations.expectCausalBranchByCausalHash CausalHash
rootCausalHash
  Path
-> CausalBranch Transaction
-> Transaction (CausalBranch Transaction)
getShallowCausalAtPath Path
p CausalBranch Transaction
rootCausal

-- | Recursively descend into causals following the given path,
-- Use the root causal if none is provided.
getShallowCausalAtPath ::
  Path ->
  (V2Branch.CausalBranch Sqlite.Transaction) ->
  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
getShallowCausalAtPath :: Path
-> CausalBranch Transaction
-> Transaction (CausalBranch Transaction)
getShallowCausalAtPath Path
path CausalBranch Transaction
causal = do
  case Path
path of
    Path
Path.Empty -> CausalBranch Transaction -> Transaction (CausalBranch Transaction)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalBranch Transaction
causal
    NameSegment
ns Path.:< Path
p -> do
      Branch Transaction
b <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value CausalBranch Transaction
causal
      case NameSegment
-> Branch Transaction -> Maybe (CausalBranch Transaction)
forall (m :: * -> *).
NameSegment -> Branch m -> Maybe (CausalBranch m)
V2Branch.childAt NameSegment
ns Branch Transaction
b of
        Maybe (CausalBranch Transaction)
Nothing -> CausalBranch Transaction -> Transaction (CausalBranch Transaction)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch Transaction -> CausalBranch Transaction
forall (m :: * -> *). Monad m => Branch m -> CausalBranch m
Cv.causalbranch1to2 Branch Transaction
forall (m :: * -> *). Branch m
Branch.empty)
        Just CausalBranch Transaction
childCausal -> Path
-> CausalBranch Transaction
-> Transaction (CausalBranch Transaction)
getShallowCausalAtPath Path
p CausalBranch Transaction
childCausal

-- | Recursively descend into causals following the given path,
-- Use the root causal if none is provided.
getShallowBranchAtPath ::
  Path ->
  V2Branch.Branch Sqlite.Transaction ->
  Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
getShallowBranchAtPath :: Path -> Branch Transaction -> Transaction (Branch Transaction)
getShallowBranchAtPath Path
path Branch Transaction
branch = Branch Transaction
-> Maybe (Branch Transaction) -> Branch Transaction
forall a. a -> Maybe a -> a
fromMaybe Branch Transaction
forall (m :: * -> *). Branch m
V2Branch.empty (Maybe (Branch Transaction) -> Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
-> Transaction (Branch Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path
-> Branch Transaction -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtPath Path
path Branch Transaction
branch

-- | Recursively descend into causals following the given path,
-- Use the root causal if none is provided.
getMaybeShallowBranchAtPath ::
  Path ->
  V2Branch.Branch Sqlite.Transaction ->
  Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction))
getMaybeShallowBranchAtPath :: Path
-> Branch Transaction -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtPath Path
path Branch Transaction
branch = do
  case Path
path of
    Path
Path.Empty -> Maybe (Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Branch Transaction)
 -> Transaction (Maybe (Branch Transaction)))
-> Maybe (Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
forall a b. (a -> b) -> a -> b
$ Branch Transaction -> Maybe (Branch Transaction)
forall a. a -> Maybe a
Just Branch Transaction
branch
    NameSegment
ns Path.:< Path
p -> do
      case NameSegment
-> Branch Transaction -> Maybe (CausalBranch Transaction)
forall (m :: * -> *).
NameSegment -> Branch m -> Maybe (CausalBranch m)
V2Branch.childAt NameSegment
ns Branch Transaction
branch of
        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
childCausal -> do
          Branch Transaction
childBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value CausalBranch Transaction
childCausal
          Path
-> Branch Transaction -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtPath Path
p Branch Transaction
childBranch

-- | Recursively descend into causals following the given path,
-- Use the root causal if none is provided.
getShallowBranchAtProjectPath ::
  PP.ProjectPath ->
  Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
getShallowBranchAtProjectPath :: ProjectPath -> Transaction (Branch Transaction)
getShallowBranchAtProjectPath ProjectPath
pp = Branch Transaction
-> Maybe (Branch Transaction) -> Branch Transaction
forall a. a -> Maybe a -> a
fromMaybe Branch Transaction
forall (m :: * -> *). Branch m
V2Branch.empty (Maybe (Branch Transaction) -> Branch Transaction)
-> Transaction (Maybe (Branch Transaction))
-> Transaction (Branch Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPath -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtProjectPath ProjectPath
pp

-- | Recursively descend into causals following the given path,
-- Use the root causal if none is provided.
getMaybeShallowBranchAtProjectPath ::
  PP.ProjectPath ->
  Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction))
getMaybeShallowBranchAtProjectPath :: ProjectPath -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtProjectPath (PP.ProjectPath Project
_project ProjectBranch
projectBranch Absolute
path) = do
  ProjectBranch -> Transaction (Maybe (Branch Transaction))
getShallowProjectBranchRoot ProjectBranch
projectBranch Transaction (Maybe (Branch Transaction))
-> (Maybe (Branch 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 (Branch 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 Branch Transaction
projectRootBranch -> Path
-> Branch Transaction -> Transaction (Maybe (Branch Transaction))
getMaybeShallowBranchAtPath (Absolute -> Path
Path.unabsolute Absolute
path) Branch Transaction
projectRootBranch

getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe (V2Branch.CausalBranch Sqlite.Transaction))
getShallowProjectRootByNames :: ProjectAndBranch ProjectName ProjectBranchName
-> Transaction (Maybe (CausalBranch Transaction))
getShallowProjectRootByNames (ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) = MaybeT Transaction (CausalBranch Transaction)
-> Transaction (Maybe (CausalBranch Transaction))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  ProjectBranch {ProjectId
projectId :: ProjectId
$sel:projectId:ProjectBranch :: ProjectBranch -> ProjectId
projectId, ProjectBranchId
branchId :: ProjectBranchId
$sel:branchId:ProjectBranch :: ProjectBranch -> ProjectBranchId
branchId} <- Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction (Maybe ProjectBranch)
 -> MaybeT Transaction ProjectBranch)
-> Transaction (Maybe ProjectBranch)
-> MaybeT Transaction ProjectBranch
forall a b. (a -> b) -> a -> b
$ ProjectName
-> ProjectBranchName -> Transaction (Maybe ProjectBranch)
Q.loadProjectBranchByNames ProjectName
projectName ProjectBranchName
branchName
  CausalHashId
causalHashId <- Transaction CausalHashId -> MaybeT Transaction 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 (Transaction CausalHashId -> MaybeT Transaction CausalHashId)
-> Transaction CausalHashId -> MaybeT Transaction CausalHashId
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
  CausalHash
causalHash <- 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 (Transaction CausalHash -> MaybeT Transaction CausalHash)
-> Transaction CausalHash -> MaybeT Transaction CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId
  Transaction (CausalBranch Transaction)
-> MaybeT Transaction (CausalBranch Transaction)
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 (CausalBranch Transaction)
 -> MaybeT Transaction (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> MaybeT Transaction (CausalBranch Transaction)
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (CausalBranch Transaction)
Operations.expectCausalBranchByCausalHash CausalHash
causalHash

expectProjectBranchRoot :: (MonadIO m) => Codebase m v a -> Db.ProjectId -> Db.ProjectBranchId -> m (Branch m)
expectProjectBranchRoot :: forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectId -> ProjectBranchId -> m (Branch m)
expectProjectBranchRoot Codebase m v a
codebase ProjectId
projectId ProjectBranchId
branchId = do
  CausalHash
causalHash <- Codebase m v a -> Transaction CausalHash -> m CausalHash
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
runTransaction Codebase m v a
codebase (Transaction CausalHash -> m CausalHash)
-> Transaction CausalHash -> m CausalHash
forall a b. (a -> b) -> a -> b
$ do
    CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
    CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId
  Codebase m v a -> CausalHash -> m (Branch m)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
expectBranchForHash Codebase m v a
codebase CausalHash
causalHash

expectShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
expectShallowProjectBranchRoot :: ProjectBranch -> Transaction (Branch Transaction)
expectShallowProjectBranchRoot ProjectBranch {ProjectId
$sel:projectId:ProjectBranch :: ProjectBranch -> ProjectId
projectId :: ProjectId
projectId, ProjectBranchId
$sel:branchId:ProjectBranch :: ProjectBranch -> ProjectBranchId
branchId :: ProjectBranchId
branchId} = do
  CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
  CausalHash
causalHash <- CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId
  CausalHash -> Transaction (CausalBranch Transaction)
Operations.expectCausalBranchByCausalHash CausalHash
causalHash Transaction (CausalBranch Transaction)
-> (CausalBranch Transaction -> 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
>>= CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value

getShallowProjectBranchRoot :: ProjectBranch -> Sqlite.Transaction (Maybe (V2Branch.Branch Sqlite.Transaction))
getShallowProjectBranchRoot :: ProjectBranch -> Transaction (Maybe (Branch Transaction))
getShallowProjectBranchRoot ProjectBranch {ProjectId
$sel:projectId:ProjectBranch :: ProjectBranch -> ProjectId
projectId :: ProjectId
projectId, ProjectBranchId
$sel:branchId:ProjectBranch :: ProjectBranch -> ProjectBranchId
branchId :: ProjectBranchId
branchId} = do
  CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
  CausalHash
causalHash <- CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId
  CausalHash -> Transaction (Maybe (CausalBranch Transaction))
Operations.loadCausalBranchByCausalHash CausalHash
causalHash 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
>>= (CausalBranch Transaction -> Transaction (Branch Transaction))
-> Maybe (CausalBranch Transaction)
-> Transaction (Maybe (Branch 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) -> Maybe a -> f (Maybe b)
traverse CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value

getBranchAtProjectPath ::
  (MonadIO m) =>
  Codebase m v a ->
  PP.ProjectPath ->
  m (Maybe (Branch m))
getBranchAtProjectPath :: forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectPath -> m (Maybe (Branch m))
getBranchAtProjectPath Codebase m v a
codebase ProjectPath
pp = MaybeT m (Branch m) -> m (Maybe (Branch m))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  Branch m
rootBranch <- m (Branch m) -> MaybeT m (Branch m)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Branch m) -> MaybeT m (Branch m))
-> m (Branch m) -> MaybeT m (Branch m)
forall a b. (a -> b) -> a -> b
$ Codebase m v a -> ProjectId -> ProjectBranchId -> m (Branch m)
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectId -> ProjectBranchId -> m (Branch m)
expectProjectBranchRoot Codebase m v a
codebase ProjectPath
pp.branch.projectId ProjectPath
pp.branch.branchId
  Maybe (Branch m) -> MaybeT m (Branch m)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (Branch m) -> MaybeT m (Branch m))
-> Maybe (Branch m) -> MaybeT m (Branch m)
forall a b. (a -> b) -> a -> b
$ Path -> Branch m -> Maybe (Branch m)
forall (m :: * -> *). Path -> Branch m -> Maybe (Branch m)
Branch.getAt (ProjectPath
pp ProjectPath -> Getting Path ProjectPath Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path ProjectPath Path
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_) Branch m
rootBranch

-- | Like 'getBranchForHash', but for when the hash is known to be in the codebase.
expectBranchForHash :: (Monad m) => Codebase m v a -> CausalHash -> m (Branch m)
expectBranchForHash :: forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
expectBranchForHash Codebase m v a
codebase CausalHash
hash =
  Codebase m v a -> CausalHash -> m (Maybe (Branch m))
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> m (Maybe (Branch m))
getBranchForHash Codebase m v a
codebase CausalHash
hash m (Maybe (Branch m))
-> (Maybe (Branch m) -> m (Branch m)) -> m (Branch m)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Branch m
branch -> Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
branch
    Maybe (Branch m)
Nothing -> [Char] -> m (Branch m)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Branch m)) -> [Char] -> m (Branch m)
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
reportBug [Char]
"E412939" ([Char]
"expectBranchForHash: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CausalHash -> [Char]
forall a. Show a => a -> [Char]
show CausalHash
hash [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found in codebase")

-- | Get the lowest common ancestor of two branches, i.e. the most recent branch that is an ancestor of both branches.
lca :: (MonadIO m) => Codebase m v a -> Branch m -> Branch m -> m (Maybe (Branch m))
lca :: forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> Branch m -> Branch m -> m (Maybe (Branch m))
lca Codebase m v a
code b1 :: Branch m
b1@(Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash -> CausalHash
h1) b2 :: Branch m
b2@(Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash -> CausalHash
h2) = do
  m (Maybe (Branch m))
action <-
    Codebase m v a
-> Transaction (m (Maybe (Branch m))) -> m (m (Maybe (Branch m)))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
runTransaction Codebase m v a
code do
      Bool
eb1 <- CausalHash -> Transaction Bool
SqliteCodebase.Operations.branchExists CausalHash
h1
      Bool
eb2 <- CausalHash -> Transaction Bool
SqliteCodebase.Operations.branchExists CausalHash
h2
      if Bool
eb1 Bool -> Bool -> Bool
&& Bool
eb2
        then do
          CausalHash -> CausalHash -> Transaction (Maybe CausalHash)
Operations.lca CausalHash
h1 CausalHash
h2 Transaction (Maybe CausalHash)
-> (Maybe CausalHash -> Transaction (m (Maybe (Branch m))))
-> Transaction (m (Maybe (Branch m)))
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 CausalHash
h -> m (Maybe (Branch m)) -> Transaction (m (Maybe (Branch m)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Codebase m v a -> CausalHash -> m (Maybe (Branch m))
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> m (Maybe (Branch m))
getBranchForHash Codebase m v a
code CausalHash
h)
            Maybe CausalHash
Nothing -> m (Maybe (Branch m)) -> Transaction (m (Maybe (Branch m)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Branch m) -> m (Maybe (Branch m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Branch m)
forall a. Maybe a
Nothing) -- no common ancestor
        else m (Maybe (Branch m)) -> Transaction (m (Maybe (Branch m)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch m -> Branch m -> m (Maybe (Branch m))
forall (m :: * -> *).
Monad m =>
Branch m -> Branch m -> m (Maybe (Branch m))
Branch.lca Branch m
b1 Branch m
b2)
  m (Maybe (Branch m))
action

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

-- | Write all of UCM's dependencies (builtins types and an empty namespace) into the codebase
installUcmDependencies :: Codebase m Symbol Parser.Ann -> Sqlite.Transaction ()
installUcmDependencies :: forall (m :: * -> *). Codebase m Symbol Ann -> Transaction ()
installUcmDependencies Codebase m Symbol Ann
c = do
  let uf :: TypecheckedUnisonFile Symbol Ann
uf =
        ( Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [([Char], [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [([Char], [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
            ([(Symbol, (Id, DataDeclaration Symbol Ann))]
-> Map Symbol (Id, DataDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, DataDeclaration Symbol Ann))]
Builtin.builtinDataDecls)
            ([(Symbol, (Id, EffectDeclaration Symbol Ann))]
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, EffectDeclaration Symbol Ann))]
Builtin.builtinEffectDecls)
            [Ann -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. a -> [(Symbol, a, Term Symbol a, Type Symbol a)]
Builtin.builtinTermsSrc Ann
Parser.Intrinsic]
            [([Char], [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a. Monoid a => a
mempty
        )
  Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
(Var v, Show a) =>
Codebase m v a -> TypecheckedUnisonFile v a -> Transaction ()
addDefsToCodebase Codebase m Symbol Ann
c TypecheckedUnisonFile Symbol Ann
uf

-- Feel free to refactor this to use some other type than TypecheckedUnisonFile
-- if it makes sense to later.
addDefsToCodebase ::
  forall m v a.
  (Var v, Show a) =>
  Codebase m v a ->
  UF.TypecheckedUnisonFile v a ->
  Sqlite.Transaction ()
addDefsToCodebase :: forall (m :: * -> *) v a.
(Var v, Show a) =>
Codebase m v a -> TypecheckedUnisonFile v a -> Transaction ()
addDefsToCodebase Codebase m v a
c TypecheckedUnisonFile v a
uf = do
  ((Id, DataDeclaration v a) -> Transaction ())
-> Map v (Id, DataDeclaration v a) -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((DataDeclaration v a -> Decl v a)
-> (Id, DataDeclaration v a) -> Transaction ()
forall t. Show t => (t -> Decl v a) -> (Id, t) -> Transaction ()
goType DataDeclaration v a -> Decl v a
forall a b. b -> Either a b
Right) (TypecheckedUnisonFile v a -> Map v (Id, DataDeclaration v a)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile v a
uf)
  ((Id, EffectDeclaration v a) -> Transaction ())
-> Map v (Id, EffectDeclaration v a) -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((EffectDeclaration v a -> Decl v a)
-> (Id, EffectDeclaration v a) -> Transaction ()
forall t. Show t => (t -> Decl v a) -> (Id, t) -> Transaction ()
goType EffectDeclaration v a -> Decl v a
forall a b. a -> Either a b
Left) (TypecheckedUnisonFile v a -> Map v (Id, EffectDeclaration v a)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile v a
uf)
  -- put terms
  ((a, Id, Maybe [Char], Term v a, Type v a) -> Transaction ())
-> Map v (a, Id, Maybe [Char], Term v a, Type v a)
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (a, Id, Maybe [Char], Term v a, Type v a) -> Transaction ()
goTerm (TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe [Char], Term v a, Type v a)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe [Char], Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile v a
uf)
  where
    goTerm :: (a, Id, Maybe [Char], Term v a, Type v a) -> Transaction ()
goTerm (a, Id, Maybe [Char], Term v a, Type v a)
t | Bool
debug Bool -> Bool -> Bool
&& [Char] -> Bool -> Bool
forall a. [Char] -> a -> a
trace ([Char]
"Codebase.addDefsToCodebase.goTerm " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (a, Id, Maybe [Char], Term v a, Type v a) -> [Char]
forall a. Show a => a -> [Char]
show (a, Id, Maybe [Char], Term v a, Type v a)
t) Bool
False = Transaction ()
forall a. HasCallStack => a
undefined
    goTerm (a
_, Id
r, Maybe [Char]
wk, Term v a
tm, Type v a
tp) = Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [Char] -> Bool
WK.watchKindShouldBeStoredInDatabase Maybe [Char]
wk) (Codebase m v a -> Id -> Term v a -> Type v a -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Term v a -> Type v a -> Transaction ()
putTerm Codebase m v a
c Id
r Term v a
tm Type v a
tp)
    goType :: (Show t) => (t -> Decl v a) -> (Reference.Id, t) -> Sqlite.Transaction ()
    goType :: forall t. Show t => (t -> Decl v a) -> (Id, t) -> Transaction ()
goType t -> Decl v a
_f (Id, t)
pair | Bool
debug Bool -> Bool -> Bool
&& [Char] -> Bool -> Bool
forall a. [Char] -> a -> a
trace ([Char]
"Codebase.addDefsToCodebase.goType " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Id, t) -> [Char]
forall a. Show a => a -> [Char]
show (Id, t)
pair) Bool
False = Transaction ()
forall a. HasCallStack => a
undefined
    goType t -> Decl v a
f (Id
ref, t
decl) = Codebase m v a -> Id -> Decl v a -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Decl v a -> Transaction ()
putTypeDeclaration Codebase m v a
c Id
ref (t -> Decl v a
f t
decl)

getTypeOfConstructor :: (Ord v) => Codebase m v a -> ConstructorReference -> Sqlite.Transaction (Maybe (Type v a))
getTypeOfConstructor :: forall v (m :: * -> *) a.
Ord v =>
Codebase m v a
-> ConstructorReference -> Transaction (Maybe (Type v a))
getTypeOfConstructor Codebase m v a
codebase (ConstructorReference Reference
r0 ConstructorId
cid) =
  case Reference
r0 of
    Reference.DerivedId Id
r -> do
      Maybe (Decl v a)
maybeDecl <- Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
getTypeDeclaration Codebase m v a
codebase Id
r
      pure $ case Maybe (Decl v a)
maybeDecl of
        Maybe (Decl v a)
Nothing -> Maybe (Type v a)
forall a. Maybe a
Nothing
        Just Decl v a
decl -> DataDeclaration v a -> ConstructorId -> Maybe (Type v a)
forall v a.
DataDeclaration v a -> ConstructorId -> Maybe (Type v a)
DD.typeOfConstructor ((EffectDeclaration v a -> DataDeclaration v a)
-> (DataDeclaration v a -> DataDeclaration v a)
-> Decl v a
-> DataDeclaration v a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration v a -> DataDeclaration v a
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl DataDeclaration v a -> DataDeclaration v a
forall a. a -> a
id Decl v a
decl) ConstructorId
cid
    Reference.Builtin Text
_ -> [Char] -> Transaction (Maybe (Type v a))
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"924628772" [Char]
"Attempt to load a type declaration which is a builtin!")

-- | Like 'getWatch', but first looks up the given reference as a regular watch, then as a test watch.
--
-- @
-- lookupWatchCache codebase ref =
--   runMaybeT do
--     MaybeT (getWatch codebase RegularWatch ref)
--       <|> MaybeT (getWatch codebase TestWatch ref))
-- @
lookupWatchCache :: Codebase m v a -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a))
lookupWatchCache :: forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
lookupWatchCache Codebase m v a
codebase Id
h = do
  Maybe (Term v a)
m1 <- Codebase m v a -> [Char] -> Id -> Transaction (Maybe (Term v a))
forall (m :: * -> *) v a.
Codebase m v a -> [Char] -> Id -> Transaction (Maybe (Term v a))
getWatch Codebase m v a
codebase [Char]
forall a. (Eq a, IsString a) => a
WK.RegularWatch Id
h
  Transaction (Maybe (Term v a))
-> (Term v a -> Transaction (Maybe (Term v a)))
-> Maybe (Term v a)
-> Transaction (Maybe (Term v a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Codebase m v a -> [Char] -> Id -> Transaction (Maybe (Term v a))
forall (m :: * -> *) v a.
Codebase m v a -> [Char] -> Id -> Transaction (Maybe (Term v a))
getWatch Codebase m v a
codebase [Char]
forall a. (Eq a, IsString a) => a
WK.TestWatch Id
h) (Maybe (Term v a) -> Transaction (Maybe (Term v a))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Term v a) -> Transaction (Maybe (Term v a)))
-> (Term v a -> Maybe (Term v a))
-> Term v a
-> Transaction (Maybe (Term v a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Maybe (Term v a)
forall a. a -> Maybe a
Just) Maybe (Term v a)
m1

-- | Make a @TypeLookup@ that is suitable for looking up information about all of the given type-or-term references,
-- and all of their type dependencies, including builtins.
typeLookupForDependencies ::
  Codebase IO Symbol Ann ->
  DefnsF Set TermReference TypeReference ->
  Sqlite.Transaction (TL.TypeLookup Symbol Ann)
typeLookupForDependencies :: Codebase IO Symbol Ann
-> DefnsF Set Reference Reference
-> Transaction (TypeLookup Symbol Ann)
typeLookupForDependencies Codebase IO Symbol Ann
codebase DefnsF Set Reference Reference
s = 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]
"typeLookupForDependencies " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DefnsF Set Reference Reference -> [Char]
forall a. Show a => a -> [Char]
show DefnsF Set Reference Reference
s
  (TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> TypeLookup Symbol Ann
Builtin.typeLookup) (TypeLookup Symbol Ann -> TypeLookup Symbol Ann)
-> Transaction (TypeLookup Symbol Ann)
-> Transaction (TypeLookup Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DefnsF Set Reference Reference
-> Transaction (TypeLookup Symbol Ann)
depthFirstAccum DefnsF Set Reference Reference
s
  where
    depthFirstAccum ::
      DefnsF Set TermReference TypeReference ->
      Sqlite.Transaction (TL.TypeLookup Symbol Ann)
    depthFirstAccum :: DefnsF Set Reference Reference
-> Transaction (TypeLookup Symbol Ann)
depthFirstAccum DefnsF Set Reference Reference
refs = do
      TypeLookup Symbol Ann
tl <- TypeLookup Symbol Ann
-> Set Reference -> Transaction (TypeLookup Symbol Ann)
depthFirstAccumTypes TypeLookup Symbol Ann
forall a. Monoid a => a
mempty DefnsF Set Reference Reference
refs.types
      (TypeLookup Symbol Ann
 -> Reference -> Transaction (TypeLookup Symbol Ann))
-> TypeLookup Symbol Ann
-> Set Reference
-> Transaction (TypeLookup Symbol Ann)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM TypeLookup Symbol Ann
-> Reference -> Transaction (TypeLookup Symbol Ann)
goTerm TypeLookup Symbol Ann
tl ((Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (TypeLookup Symbol Ann -> Reference -> Bool
forall a. TypeLookup Symbol a -> Reference -> Bool
unseen TypeLookup Symbol Ann
tl) DefnsF Set Reference Reference
refs.terms)

    depthFirstAccumTypes ::
      TL.TypeLookup Symbol Ann ->
      Set TypeReference ->
      Sqlite.Transaction (TL.TypeLookup Symbol Ann)
    depthFirstAccumTypes :: TypeLookup Symbol Ann
-> Set Reference -> Transaction (TypeLookup Symbol Ann)
depthFirstAccumTypes TypeLookup Symbol Ann
tl Set Reference
refs =
      (TypeLookup Symbol Ann
 -> Reference -> Transaction (TypeLookup Symbol Ann))
-> TypeLookup Symbol Ann
-> Set Reference
-> Transaction (TypeLookup Symbol Ann)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM TypeLookup Symbol Ann
-> Reference -> Transaction (TypeLookup Symbol Ann)
goType TypeLookup Symbol Ann
tl ((Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (TypeLookup Symbol Ann -> Reference -> Bool
forall a. TypeLookup Symbol a -> Reference -> Bool
unseen TypeLookup Symbol Ann
tl) Set Reference
refs)

    -- We need the transitive dependencies of data decls
    -- that are scrutinized in a match expression for
    -- pattern match coverage checking (specifically for
    -- the inhabitation check). We ensure these are found
    -- by collecting all transitive type dependencies.
    goTerm :: TypeLookup Symbol Ann -> TermReference -> Sqlite.Transaction (TypeLookup Symbol Ann)
    goTerm :: TypeLookup Symbol Ann
-> Reference -> Transaction (TypeLookup Symbol Ann)
goTerm TypeLookup Symbol Ann
tl Reference
ref =
      Codebase IO Symbol Ann
-> Reference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
getTypeOfTerm Codebase IO Symbol Ann
codebase Reference
ref Transaction (Maybe (Type Symbol Ann))
-> (Maybe (Type Symbol Ann) -> Transaction (TypeLookup Symbol Ann))
-> Transaction (TypeLookup Symbol Ann)
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 Type Symbol Ann
typ ->
          let z :: TypeLookup Symbol Ann
z = TypeLookup Symbol Ann
tl TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> Map Reference (Type Symbol Ann)
-> Map Reference (DataDeclaration Symbol Ann)
-> Map Reference (EffectDeclaration Symbol Ann)
-> TypeLookup Symbol Ann
forall v a.
Map Reference (Type v a)
-> Map Reference (DataDeclaration v a)
-> Map Reference (EffectDeclaration v a)
-> TypeLookup v a
TypeLookup (Reference -> Type Symbol Ann -> Map Reference (Type Symbol Ann)
forall k a. k -> a -> Map k a
Map.singleton Reference
ref Type Symbol Ann
typ) Map Reference (DataDeclaration Symbol Ann)
forall a. Monoid a => a
mempty Map Reference (EffectDeclaration Symbol Ann)
forall a. Monoid a => a
mempty
           in TypeLookup Symbol Ann
-> Set Reference -> Transaction (TypeLookup Symbol Ann)
depthFirstAccumTypes TypeLookup Symbol Ann
z (Type Symbol Ann -> Set Reference
forall v a. Ord v => Type v a -> Set Reference
Type.dependencies Type Symbol Ann
typ)
        Maybe (Type Symbol Ann)
Nothing -> TypeLookup Symbol Ann -> Transaction (TypeLookup Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLookup Symbol Ann
tl

    goType :: TypeLookup Symbol Ann -> TypeReference -> Sqlite.Transaction (TypeLookup Symbol Ann)
    goType :: TypeLookup Symbol Ann
-> Reference -> Transaction (TypeLookup Symbol Ann)
goType TypeLookup Symbol Ann
tl ref :: Reference
ref@(Reference.DerivedId Id
id) =
      Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
getTypeDeclaration Codebase IO Symbol Ann
codebase Id
id Transaction (Maybe (Decl Symbol Ann))
-> (Maybe (Decl Symbol Ann) -> Transaction (TypeLookup Symbol Ann))
-> Transaction (TypeLookup Symbol Ann)
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 (Left EffectDeclaration Symbol Ann
ed) ->
          let z :: TypeLookup Symbol Ann
z = TypeLookup Symbol Ann
tl TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> Map Reference (Type Symbol Ann)
-> Map Reference (DataDeclaration Symbol Ann)
-> Map Reference (EffectDeclaration Symbol Ann)
-> TypeLookup Symbol Ann
forall v a.
Map Reference (Type v a)
-> Map Reference (DataDeclaration v a)
-> Map Reference (EffectDeclaration v a)
-> TypeLookup v a
TypeLookup Map Reference (Type Symbol Ann)
forall a. Monoid a => a
mempty Map Reference (DataDeclaration Symbol Ann)
forall a. Monoid a => a
mempty (Reference
-> EffectDeclaration Symbol Ann
-> Map Reference (EffectDeclaration Symbol Ann)
forall k a. k -> a -> Map k a
Map.singleton Reference
ref EffectDeclaration Symbol Ann
ed)
           in TypeLookup Symbol Ann
-> Set Reference -> Transaction (TypeLookup Symbol Ann)
depthFirstAccumTypes TypeLookup Symbol Ann
z (DataDeclaration Symbol Ann -> Set Reference
forall v a. Ord v => DataDeclaration v a -> Set Reference
DD.typeDependencies (DataDeclaration Symbol Ann -> Set Reference)
-> DataDeclaration Symbol Ann -> Set Reference
forall a b. (a -> b) -> a -> b
$ EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl EffectDeclaration Symbol Ann
ed)
        Just (Right DataDeclaration Symbol Ann
dd) ->
          let z :: TypeLookup Symbol Ann
z = TypeLookup Symbol Ann
tl TypeLookup Symbol Ann
-> TypeLookup Symbol Ann -> TypeLookup Symbol Ann
forall a. Semigroup a => a -> a -> a
<> Map Reference (Type Symbol Ann)
-> Map Reference (DataDeclaration Symbol Ann)
-> Map Reference (EffectDeclaration Symbol Ann)
-> TypeLookup Symbol Ann
forall v a.
Map Reference (Type v a)
-> Map Reference (DataDeclaration v a)
-> Map Reference (EffectDeclaration v a)
-> TypeLookup v a
TypeLookup Map Reference (Type Symbol Ann)
forall a. Monoid a => a
mempty (Reference
-> DataDeclaration Symbol Ann
-> Map Reference (DataDeclaration Symbol Ann)
forall k a. k -> a -> Map k a
Map.singleton Reference
ref DataDeclaration Symbol Ann
dd) Map Reference (EffectDeclaration Symbol Ann)
forall a. Monoid a => a
mempty
           in TypeLookup Symbol Ann
-> Set Reference -> Transaction (TypeLookup Symbol Ann)
depthFirstAccumTypes TypeLookup Symbol Ann
z (DataDeclaration Symbol Ann -> Set Reference
forall v a. Ord v => DataDeclaration v a -> Set Reference
DD.typeDependencies DataDeclaration Symbol Ann
dd)
        Maybe (Decl Symbol Ann)
Nothing -> TypeLookup Symbol Ann -> Transaction (TypeLookup Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLookup Symbol Ann
tl
    goType TypeLookup Symbol Ann
tl Reference.Builtin {} = TypeLookup Symbol Ann -> Transaction (TypeLookup Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeLookup Symbol Ann
tl -- codebase isn't consulted for builtins
    unseen :: TL.TypeLookup Symbol a -> Reference -> Bool
    unseen :: forall a. TypeLookup Symbol a -> Reference -> Bool
unseen TypeLookup Symbol a
tl Reference
r =
      Maybe () -> Bool
forall a. Maybe a -> Bool
isNothing
        ( Reference
-> Map Reference (DataDeclaration Symbol a)
-> Maybe (DataDeclaration Symbol a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r (TypeLookup Symbol a -> Map Reference (DataDeclaration Symbol a)
forall v a. TypeLookup v a -> Map Reference (DataDeclaration v a)
TL.dataDecls TypeLookup Symbol a
tl) Maybe (DataDeclaration Symbol a) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
            Maybe () -> Maybe () -> Maybe ()
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Reference -> Map Reference (Type Symbol a) -> Maybe (Type Symbol a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r (TypeLookup Symbol a -> Map Reference (Type Symbol a)
forall v a. TypeLookup v a -> Map Reference (Type v a)
TL.typeOfTerms TypeLookup Symbol a
tl) Maybe (Type Symbol a) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
            Maybe () -> Maybe () -> Maybe ()
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Reference
-> Map Reference (EffectDeclaration Symbol a)
-> Maybe (EffectDeclaration Symbol a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r (TypeLookup Symbol a -> Map Reference (EffectDeclaration Symbol a)
forall v a. TypeLookup v a -> Map Reference (EffectDeclaration v a)
TL.effectDecls TypeLookup Symbol a
tl) Maybe (EffectDeclaration Symbol a) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
        )

-- | Get the type of a term.
--
-- Note that it is possible to call 'putTerm', then 'getTypeOfTerm', and receive @Nothing@, per the semantics of
-- 'putTerm'.
getTypeOfTerm ::
  (BuiltinAnnotation a) =>
  Codebase m Symbol a ->
  Reference ->
  Sqlite.Transaction (Maybe (Type Symbol a))
getTypeOfTerm :: forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
getTypeOfTerm Codebase m Symbol a
_c Reference
r | Bool
debug Bool -> Bool -> Bool
&& [Char] -> Bool -> Bool
forall a. [Char] -> a -> a
trace ([Char]
"Codebase.getTypeOfTerm " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Reference -> [Char]
forall a. Show a => a -> [Char]
show Reference
r) Bool
False = Transaction (Maybe (Type Symbol a))
forall a. HasCallStack => a
undefined
getTypeOfTerm Codebase m Symbol a
c Reference
r = case Reference
r of
  Reference.DerivedId Id
h -> Codebase m Symbol a -> Id -> Transaction (Maybe (Type Symbol a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Type v a))
getTypeOfTermImpl Codebase m Symbol a
c Id
h
  r :: Reference
r@Reference.Builtin {} ->
    Maybe (Type Symbol a) -> Transaction (Maybe (Type Symbol a))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Type Symbol a) -> Transaction (Maybe (Type Symbol a)))
-> Maybe (Type Symbol a) -> Transaction (Maybe (Type Symbol a))
forall a b. (a -> b) -> a -> b
$
      (() -> a) -> Term F Symbol () -> Type Symbol a
forall a b. (a -> b) -> Term F Symbol a -> Term F Symbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> () -> a
forall a b. a -> b -> a
const a
forall a. BuiltinAnnotation a => a
builtinAnnotation)
        (Term F Symbol () -> Type Symbol a)
-> Maybe (Term F Symbol ()) -> Maybe (Type Symbol a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference
-> Map Reference (Term F Symbol ()) -> Maybe (Term F Symbol ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference (Term F Symbol ())
Builtin.termRefTypes

-- | Get the type of a referent.
getTypeOfReferent ::
  (BuiltinAnnotation a) =>
  Codebase m Symbol a ->
  Referent.Referent ->
  Sqlite.Transaction (Maybe (Type Symbol a))
getTypeOfReferent :: forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Referent -> Transaction (Maybe (Type Symbol a))
getTypeOfReferent Codebase m Symbol a
c = \case
  Referent.Ref Reference
r -> Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
getTypeOfTerm Codebase m Symbol a
c Reference
r
  Referent.Con ConstructorReference
r ConstructorType
_ -> Codebase m Symbol a
-> ConstructorReference -> Transaction (Maybe (Type Symbol a))
forall v (m :: * -> *) a.
Ord v =>
Codebase m v a
-> ConstructorReference -> Transaction (Maybe (Type v a))
getTypeOfConstructor Codebase m Symbol a
c ConstructorReference
r

componentReferencesForReference :: Reference -> Sqlite.Transaction (Set Reference)
componentReferencesForReference :: Reference -> Transaction (Set Reference)
componentReferencesForReference = \case
  r :: Reference
r@Reference.Builtin {} -> Set Reference -> Transaction (Set Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Set Reference
forall a. a -> Set a
Set.singleton Reference
r)
  Reference.Derived Hash
h ConstructorId
_i ->
    (Id -> Reference) -> Set Id -> Set Reference
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId (Set Id -> Set Reference)
-> (ConstructorId -> Set Id) -> ConstructorId -> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ConstructorId -> Set Id
Reference.componentFromLength Hash
h (ConstructorId -> Set Reference)
-> Transaction ConstructorId -> Transaction (Set Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Hash -> Transaction ConstructorId
Hash -> Transaction ConstructorId
unsafeGetComponentLength Hash
h

-- | Get the set of terms, type declarations, and builtin types that depend on the given term, type declaration, or
-- builtin type.
dependents :: Queries.DependentsSelector -> Reference -> Sqlite.Transaction (Set Reference)
dependents :: DependentsSelector -> Reference -> Transaction (Set Reference)
dependents DependentsSelector
selector Reference
r =
  Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Reference -> Set Reference
Builtin.builtinTypeDependents Reference
r)
    (Set Reference -> Set Reference)
-> (Set Id -> Set Reference) -> Set Id -> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> Reference) -> Set Id -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId
    (Set Id -> Set Reference)
-> Transaction (Set Id) -> Transaction (Set Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DependentsSelector -> Reference -> Transaction (Set Id)
SqliteCodebase.Operations.dependentsImpl DependentsSelector
selector Reference
r

dependentsOfComponent :: Hash -> Sqlite.Transaction (Set Reference)
dependentsOfComponent :: Hash -> Transaction (Set Reference)
dependentsOfComponent Hash
h =
  Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Hash -> Set Reference
Builtin.builtinTypeDependentsOfComponent Hash
h)
    (Set Reference -> Set Reference)
-> (Set Id -> Set Reference) -> Set Id -> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> Reference) -> Set Id -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId
    (Set Id -> Set Reference)
-> Transaction (Set Id) -> Transaction (Set Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash -> Transaction (Set Id)
SqliteCodebase.Operations.dependentsOfComponentImpl Hash
h

-- | Get the set of terms-or-constructors that have the given type.
termsOfType :: (Var v) => Codebase m v a -> Type v a -> Sqlite.Transaction (Set Referent.Referent)
termsOfType :: forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Transaction (Set Referent)
termsOfType Codebase m v a
c Type v a
ty = Codebase m v a -> Reference -> Transaction (Set Referent)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Reference -> Transaction (Set Referent)
termsOfTypeByReference Codebase m v a
c (Reference -> Transaction (Set Referent))
-> Reference -> Transaction (Set Referent)
forall a b. (a -> b) -> a -> b
$ Type v a -> Reference
forall v a. Var v => Type v a -> Reference
Hashing.typeToReference Type v a
ty

-- | Get all terms which match the exact type the provided reference points to.
termsOfTypeByReference :: (Var v) => Codebase m v a -> Reference -> Sqlite.Transaction (Set Referent.Referent)
termsOfTypeByReference :: forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Reference -> Transaction (Set Referent)
termsOfTypeByReference Codebase m v a
c Reference
r =
  Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Reference -> Relation Reference Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
Rel.lookupDom Reference
r Relation Reference Referent
Builtin.builtinTermsByType)
    (Set Referent -> Set Referent)
-> (Set (Referent' Id) -> Set Referent)
-> Set (Referent' Id)
-> Set Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent' Id -> Referent) -> Set (Referent' Id) -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((Id -> Reference) -> Referent' Id -> Referent
forall a b. (a -> b) -> Referent' a -> Referent' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId)
    (Set (Referent' Id) -> Set Referent)
-> Transaction (Set (Referent' Id)) -> Transaction (Set Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v a -> Reference -> Transaction (Set (Referent' Id))
forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Transaction (Set (Referent' Id))
termsOfTypeImpl Codebase m v a
c Reference
r

filterTermsByReferentHavingType ::
  (Var v) =>
  Codebase m v a ->
  Type v a ->
  Set Referent.Referent ->
  Sqlite.Transaction (Set Referent.Referent)
filterTermsByReferentHavingType :: forall v (m :: * -> *) a.
Var v =>
Codebase m v a
-> Type v a -> Set Referent -> Transaction (Set Referent)
filterTermsByReferentHavingType Codebase m v a
c Type v a
ty = Codebase m v a
-> Reference -> Set Referent -> Transaction (Set Referent)
forall (m :: * -> *) v a.
Codebase m v a
-> Reference -> Set Referent -> Transaction (Set Referent)
filterTermsByReferentHavingTypeByReference Codebase m v a
c (Reference -> Set Referent -> Transaction (Set Referent))
-> Reference -> Set Referent -> Transaction (Set Referent)
forall a b. (a -> b) -> a -> b
$ Type v a -> Reference
forall v a. Var v => Type v a -> Reference
Hashing.typeToReference Type v a
ty

filterTermsByReferenceIdHavingType ::
  (Var v) =>
  Codebase m v a ->
  Type v a ->
  Set TermReferenceId ->
  Sqlite.Transaction (Set TermReferenceId)
filterTermsByReferenceIdHavingType :: forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Set Id -> Transaction (Set Id)
filterTermsByReferenceIdHavingType Codebase m v a
c Type v a
ty = Codebase m v a -> Reference -> Set Id -> Transaction (Set Id)
forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Set Id -> Transaction (Set Id)
filterTermsByReferenceIdHavingTypeImpl Codebase m v a
c (Type v a -> Reference
forall v a. Var v => Type v a -> Reference
Hashing.typeToReference Type v a
ty)

-- | Find the subset of `tms` which match the exact type `r` points to.
filterTermsByReferentHavingTypeByReference ::
  Codebase m v a ->
  TypeReference ->
  Set Referent.Referent ->
  Sqlite.Transaction (Set Referent.Referent)
filterTermsByReferentHavingTypeByReference :: forall (m :: * -> *) v a.
Codebase m v a
-> Reference -> Set Referent -> Transaction (Set Referent)
filterTermsByReferentHavingTypeByReference Codebase m v a
c Reference
r Set Referent
tms = do
  let ([Referent]
builtins, [Referent' Id]
derived) = [Either Referent (Referent' Id)] -> ([Referent], [Referent' Id])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Referent (Referent' Id)] -> ([Referent], [Referent' Id]))
-> ([Referent] -> [Either Referent (Referent' Id)])
-> [Referent]
-> ([Referent], [Referent' Id])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent -> Either Referent (Referent' Id))
-> [Referent] -> [Either Referent (Referent' Id)]
forall a b. (a -> b) -> [a] -> [b]
map Referent -> Either Referent (Referent' Id)
p ([Referent] -> ([Referent], [Referent' Id]))
-> [Referent] -> ([Referent], [Referent' Id])
forall a b. (a -> b) -> a -> b
$ Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
tms
  let builtins' :: Set Referent
builtins' =
        Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
          ([Referent] -> Set Referent
forall a. Ord a => [a] -> Set a
Set.fromList [Referent]
builtins)
          (Reference -> Relation Reference Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
Rel.lookupDom Reference
r Relation Reference Referent
Builtin.builtinTermsByType)
  Set (Referent' Id)
derived' <- Codebase m v a
-> Reference
-> Set (Referent' Id)
-> Transaction (Set (Referent' Id))
forall (m :: * -> *) v a.
Codebase m v a
-> Reference
-> Set (Referent' Id)
-> Transaction (Set (Referent' Id))
filterTermsByReferentIdHavingTypeImpl Codebase m v a
c Reference
r ([Referent' Id] -> Set (Referent' Id)
forall a. Ord a => [a] -> Set a
Set.fromList [Referent' Id]
derived)
  pure $ Set Referent
builtins' Set Referent -> Set Referent -> Set Referent
forall a. Semigroup a => a -> a -> a
<> (Referent' Id -> Referent) -> Set (Referent' Id) -> Set Referent
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic Referent' Id -> Referent
Referent.fromId Set (Referent' Id)
derived'
  where
    p :: Referent.Referent -> Either Referent.Referent Referent.Id
    p :: Referent -> Either Referent (Referent' Id)
p Referent
r = case Referent -> Maybe (Referent' Id)
Referent.toId Referent
r of
      Just Referent' Id
rId -> Referent' Id -> Either Referent (Referent' Id)
forall a b. b -> Either a b
Right Referent' Id
rId
      Maybe (Referent' Id)
Nothing -> Referent -> Either Referent (Referent' Id)
forall a b. a -> Either a b
Left Referent
r

-- | Get the set of terms-or-constructors mention the given type anywhere in their signature.
termsMentioningType :: (Var v) => Codebase m v a -> Type v a -> Sqlite.Transaction (Set Referent.Referent)
termsMentioningType :: forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Transaction (Set Referent)
termsMentioningType Codebase m v a
c Type v a
ty =
  Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Reference -> Relation Reference Referent -> Set Referent
forall a b. Ord a => a -> Relation a b -> Set b
Rel.lookupDom Reference
r Relation Reference Referent
Builtin.builtinTermsByTypeMention)
    (Set Referent -> Set Referent)
-> (Set (Referent' Id) -> Set Referent)
-> Set (Referent' Id)
-> Set Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent' Id -> Referent) -> Set (Referent' Id) -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((Id -> Reference) -> Referent' Id -> Referent
forall a b. (a -> b) -> Referent' a -> Referent' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId)
    (Set (Referent' Id) -> Set Referent)
-> Transaction (Set (Referent' Id)) -> Transaction (Set Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v a -> Reference -> Transaction (Set (Referent' Id))
forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Transaction (Set (Referent' Id))
termsMentioningTypeImpl Codebase m v a
c Reference
r
  where
    r :: Reference
r = Type v a -> Reference
forall v a. Var v => Type v a -> Reference
Hashing.typeToReference Type v a
ty

-- | Check whether a reference is a term.
isTerm ::
  (BuiltinAnnotation a) =>
  Codebase m Symbol a ->
  Reference ->
  Sqlite.Transaction Bool
isTerm :: forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> Reference -> Transaction Bool
isTerm Codebase m Symbol a
code = (Maybe (Type Symbol a) -> Bool)
-> Transaction (Maybe (Type Symbol a)) -> Transaction Bool
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Type Symbol a) -> Bool
forall a. Maybe a -> Bool
isJust (Transaction (Maybe (Type Symbol a)) -> Transaction Bool)
-> (Reference -> Transaction (Maybe (Type Symbol a)))
-> Reference
-> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Reference -> Transaction (Maybe (Type Symbol a))
getTypeOfTerm Codebase m Symbol a
code

isType :: Codebase m v a -> Reference -> Sqlite.Transaction Bool
isType :: forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Transaction Bool
isType Codebase m v a
c Reference
r = case Reference
r of
  Reference.Builtin {} -> Bool -> Transaction Bool
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Transaction Bool) -> Bool -> Transaction Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Bool
Builtin.isBuiltinType Reference
r
  Reference.DerivedId Id
r -> Maybe (Decl v a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Decl v a) -> Bool)
-> Transaction (Maybe (Decl v a)) -> Transaction Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
getTypeDeclaration Codebase m v a
c Id
r

unsafeGetComponentLength :: (HasCallStack) => Hash -> Sqlite.Transaction Reference.CycleSize
unsafeGetComponentLength :: HasCallStack => Hash -> Transaction ConstructorId
unsafeGetComponentLength Hash
h =
  Hash -> Transaction (Maybe ConstructorId)
Operations.getCycleLen Hash
h Transaction (Maybe ConstructorId)
-> (Maybe ConstructorId -> Transaction ConstructorId)
-> Transaction ConstructorId
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 ConstructorId
Nothing -> [Char] -> Transaction ConstructorId
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E713350" ([Char]
"component with hash " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
forall a. Show a => a -> [Char]
show Hash
h [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"))
    Just ConstructorId
size -> ConstructorId -> Transaction ConstructorId
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstructorId
size

-- | Like 'getTerm', for when the term is known to exist in the codebase.
unsafeGetTerm :: (HasCallStack) => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Term v a)
unsafeGetTerm :: forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Term v a)
unsafeGetTerm Codebase m v a
codebase Id
rid =
  Codebase m v a -> Id -> Transaction (Maybe (Term v a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
getTerm Codebase m v a
codebase Id
rid Transaction (Maybe (Term v a))
-> (Maybe (Term v a) -> Transaction (Term v a))
-> Transaction (Term v a)
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 (Term v a)
Nothing -> [Char] -> Transaction (Term v a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E520818" ([Char]
"term " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
rid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"))
    Just Term v a
term -> Term v a -> Transaction (Term v a)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term v a
term

-- | Like 'getTypeDeclaration', for when the type declaration is known to exist in the codebase.
unsafeGetTypeDeclaration :: (HasCallStack) => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Decl v a)
unsafeGetTypeDeclaration :: forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Decl v a)
unsafeGetTypeDeclaration Codebase m v a
codebase Id
rid =
  Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
getTypeDeclaration Codebase m v a
codebase Id
rid Transaction (Maybe (Decl v a))
-> (Maybe (Decl v a) -> Transaction (Decl v a))
-> Transaction (Decl v a)
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 (Decl v a)
Nothing -> [Char] -> Transaction (Decl v a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E129043" ([Char]
"type decl " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
rid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"))
    Just Decl v a
decl -> Decl v a -> Transaction (Decl v a)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Decl v a
decl

-- | Like 'getTypeOfTerm', but for when the term is known to exist in the codebase.
unsafeGetTypeOfTermById :: (HasCallStack) => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Type v a)
unsafeGetTypeOfTermById :: forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Type v a)
unsafeGetTypeOfTermById Codebase m v a
codebase Id
rid =
  Codebase m v a -> Id -> Transaction (Maybe (Type v a))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Type v a))
getTypeOfTermImpl Codebase m v a
codebase Id
rid Transaction (Maybe (Type v a))
-> (Maybe (Type v a) -> Transaction (Type v a))
-> Transaction (Type v a)
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 (Type v a)
Nothing -> [Char] -> Transaction (Type v a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E377910" ([Char]
"type of term " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Id -> [Char]
forall a. Show a => a -> [Char]
show Id
rid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"))
    Just Type v a
ty -> Type v a -> Transaction (Type v a)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v a
ty

-- | Like 'unsafeGetTerm', but returns the type of the term, too.
unsafeGetTermWithType :: (HasCallStack) => Codebase m v a -> Reference.Id -> Sqlite.Transaction (Term v a, Type v a)
unsafeGetTermWithType :: forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Term v a, Type v a)
unsafeGetTermWithType Codebase m v a
codebase Id
rid = do
  Term v a
term <- Codebase m v a -> Id -> Transaction (Term v a)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Term v a)
unsafeGetTerm Codebase m v a
codebase Id
rid
  Type v a
ty <-
    -- A term is sometimes stored with a type annotation (specifically, when the annotation is different from the
    -- inferred type). In this case, we can avoid looking up the type separately.
    case Term v a
term of
      Term.Ann' Term v a
_ Type v a
ty -> Type v a -> Transaction (Type v a)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type v a
ty
      Term v a
_ -> Codebase m v a -> Id -> Transaction (Type v a)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Type v a)
unsafeGetTypeOfTermById Codebase m v a
codebase Id
rid
  pure (Term v a
term, Type v a
ty)

-- | Like 'getTermComponentWithTypes', for when the term component is known to exist in the codebase.
unsafeGetTermComponent ::
  (HasCallStack) =>
  Codebase m v a ->
  Hash ->
  Sqlite.Transaction [(Term v a, Type v a)]
unsafeGetTermComponent :: forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Hash -> Transaction [(Term v a, Type v a)]
unsafeGetTermComponent Codebase m v a
codebase Hash
hash =
  Codebase m v a
-> Hash -> Transaction (Maybe [(Term v a, Type v a)])
forall (m :: * -> *) v a.
Codebase m v a
-> Hash -> Transaction (Maybe [(Term v a, Type v a)])
getTermComponentWithTypes Codebase m v a
codebase Hash
hash Transaction (Maybe [(Term v a, Type v a)])
-> (Maybe [(Term v a, Type v a)] -> [(Term v a, Type v a)])
-> Transaction [(Term v a, Type v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe [(Term v a, Type v a)]
Nothing -> [Char] -> [(Term v a, Type v a)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E769004" ([Char]
"term component " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
forall a. Show a => a -> [Char]
show Hash
hash [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"))
    Just [(Term v a, Type v a)]
terms -> [(Term v a, Type v a)]
terms

expectCurrentProjectPath :: (HasCallStack) => Sqlite.Transaction PP.ProjectPath
expectCurrentProjectPath :: HasCallStack => Transaction ProjectPath
expectCurrentProjectPath = do
  (ProjectId
projectId, ProjectBranchId
projectBranchId, [NameSegment]
path) <- Transaction (ProjectId, ProjectBranchId, [NameSegment])
HasCallStack =>
Transaction (ProjectId, ProjectBranchId, [NameSegment])
Q.expectCurrentProjectPath
  Project
proj <- ProjectId -> Transaction Project
Q.expectProject ProjectId
projectId
  ProjectBranch
projBranch <- ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Q.expectProjectBranch ProjectId
projectId ProjectBranchId
projectBranchId
  let absPath :: Absolute
absPath = Path -> Absolute
Path.Absolute ([NameSegment] -> Path
Path.fromList [NameSegment]
path)
  pure $ Project -> ProjectBranch -> Absolute -> ProjectPath
forall proj branch.
proj -> branch -> Absolute -> ProjectPathG proj branch
PP.ProjectPath Project
proj ProjectBranch
projBranch Absolute
absPath

setCurrentProjectPath :: PP.ProjectPathIds -> Sqlite.Transaction ()
setCurrentProjectPath :: ProjectPathIds -> Transaction ()
setCurrentProjectPath (PP.ProjectPath ProjectId
projectId ProjectBranchId
projectBranchId Absolute
path) =
  ProjectId -> ProjectBranchId -> [NameSegment] -> Transaction ()
Q.setCurrentProjectPath ProjectId
projectId ProjectBranchId
projectBranchId (Path -> [NameSegment]
Path.toList (Absolute -> Path
Path.unabsolute Absolute
path))

-- | Hydrate the project and branch from IDs.
resolveProjectPathIds :: PP.ProjectPathIds -> Sqlite.Transaction PP.ProjectPath
resolveProjectPathIds :: ProjectPathIds -> Transaction ProjectPath
resolveProjectPathIds (PP.ProjectPath ProjectId
projectId ProjectBranchId
projectBranchId Absolute
path) = do
  Project
proj <- ProjectId -> Transaction Project
Q.expectProject ProjectId
projectId
  ProjectBranch
projBranch <- ProjectId -> ProjectBranchId -> Transaction ProjectBranch
Q.expectProjectBranch ProjectId
projectId ProjectBranchId
projectBranchId
  pure $ Project -> ProjectBranch -> Absolute -> ProjectPath
forall proj branch.
proj -> branch -> Absolute -> ProjectPathG proj branch
PP.ProjectPath Project
proj ProjectBranch
projBranch Absolute
path

-- | Starts loading the given project branch into cache in a background thread without blocking.
preloadProjectBranch :: (MonadUnliftIO m) => Codebase m v a -> ProjectAndBranch Db.ProjectId Db.ProjectBranchId -> m ()
preloadProjectBranch :: forall (m :: * -> *) v a.
MonadUnliftIO m =>
Codebase m v a
-> ProjectAndBranch ProjectId ProjectBranchId -> m ()
preloadProjectBranch Codebase m v a
codebase (ProjectAndBranch ProjectId
projectId ProjectBranchId
branchId) = do
  CausalHash
ch <- Codebase m v a -> Transaction CausalHash -> m CausalHash
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
runTransaction Codebase m v a
codebase (Transaction CausalHash -> m CausalHash)
-> Transaction CausalHash -> m CausalHash
forall a b. (a -> b) -> a -> b
$ do
    CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Q.expectProjectBranchHead ProjectId
projectId ProjectBranchId
branchId
    CausalHashId -> Transaction CausalHash
Q.expectCausalHash CausalHashId
causalHashId
  Codebase m v a -> CausalHash -> m ()
forall (m :: * -> *) v a. Codebase m v a -> CausalHash -> m ()
preloadBranch Codebase m v a
codebase CausalHash
ch