unison-codebase-sqlite-0.0.0
Safe HaskellSafe-Inferred
LanguageHaskell2010

U.Codebase.Sqlite.Queries

Description

Some naming conventions used in this module:

  • 32: the base32 representation of a hash
  • expect: retrieve something that's known to exist
  • load: retrieve something that's not known to exist (so the return type is a Maybe, or another container that could be empty)
  • save: idempotent (on conflict do nothing) insert, and return the id of the thing (usually)
Synopsis

text table

name segments

hash table

hash_object table

expectObjectIdForPrimaryHashId :: HashId -> Transaction ObjectId Source #

Not all hashes have corresponding objects; e.g., hashes of term types

recordObjectRehash :: ObjectId -> ObjectId -> Transaction () Source #

recordObjectRehash old new records that object old was rehashed and inserted as a new object, new.

This function rewrites old's hash_object rows in place to point at the new object.

object table

isObjectHash :: HashId -> Transaction Bool Source #

Does a hash correspond to an object?

expectPrimaryHashByObjectId :: ObjectId -> Transaction Hash Source #

All objects have corresponding hashes.

expectDeclObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a Source #

Expect a decl component object.

loadDeclObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a) Source #

Load a decl component object.

expectNamespaceObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a Source #

Expect a namespace object.

loadNamespaceObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a) Source #

Load a namespace object.

expectPatchObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a Source #

Expect a patch object.

loadTermObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction (Maybe a) Source #

Load a term component object.

expectTermObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a Source #

Expect a term component object.

namespace_statistics table

saveNamespaceStats :: BranchHashId -> NamespaceStats -> Transaction () Source #

Save statistics about a given branch.

loadNamespaceStatsByHashId :: BranchHashId -> Transaction (Maybe NamespaceStats) Source #

Looks up statistics for a given branch, there's no guarantee that we have computed and saved stats for any given branch.

causals

causal table

saveCausal :: HashHandle -> CausalHashId -> BranchHashId -> [CausalHashId] -> Transaction () Source #

Maybe we would generalize this to something other than NamespaceHash if we end up wanting to store other kinds of Causals here too.

causalExistsByHash32 :: Hash32 -> Transaction Bool Source #

Return whether or not a causal exists with the given hash32.

tryGetSquashResult :: BranchHashId -> Transaction (Maybe CausalHashId) Source #

Get the causal hash result from squashing the provided branch hash if we've squashed it at some point in the past.

saveSquashResult :: BranchHashId -> CausalHashId -> Transaction () Source #

Save the result of running a squash on the provided branch hash id.

causal_parent table

loadCausalParentsByHash :: Hash32 -> Transaction [Hash32] Source #

Like loadCausalParents, but the input and outputs are hashes, not hash ids.

before :: CausalHashId -> CausalHashId -> Transaction Bool Source #

before x y returns whether or not x occurred before y, i.e. x is an ancestor of y.

watch table

clearWatches :: Transaction () Source #

Delete all watches that were put by putWatch.

projects

projectExists :: ProjectId -> Transaction Bool Source #

Does a project exist with this id?

doProjectsExist :: Transaction Bool Source #

Check if any projects exist

projectExistsByName :: ProjectName -> Transaction Bool Source #

Does a project exist by this name?

loadAllProjects :: Transaction [Project] Source #

Load all projects.

loadAllProjectsBeginningWith :: Maybe Text -> Transaction [Project] Source #

Load all projects whose name matches a prefix.

renameProject :: ProjectId -> ProjectName -> Transaction () Source #

Rename a project row.

Precondition: the new name is available.

project branches

projectBranchExistsByName :: ProjectId -> ProjectBranchName -> Transaction Bool Source #

Does a project branch exist by this name?

loadAllProjectBranchesBeginningWith :: ProjectId -> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)] Source #

Load all branch id/name pairs in a project whose name matches an optional prefix.

loadAllProjectBranchInfo :: ProjectId -> Transaction (Map ProjectBranchName (Map URI (ProjectName, ProjectBranchName))) Source #

Load info about all branches in a project, for display by the branches command.

Each branch name maps to a possibly-empty collection of associated remote branches.

loadAllProjectBranchNamePairs :: Transaction [(ProjectAndBranch ProjectName ProjectBranchName, ProjectAndBranch ProjectId ProjectBranchId)] Source #

Load ALL project/branch name pairs Useful for autocomplete/fuzzy-finding

renameProjectBranch :: ProjectId -> ProjectBranchId -> ProjectBranchName -> Transaction () Source #

Rename a project branch.

Precondition: the new name is available.

deleteProjectBranch :: HasCallStack => ProjectId -> ProjectBranchId -> Transaction () Source #

Delete a project branch.

Re-parenting happens in the obvious way:

Before:

main <- topic <- topic2

After deleting topic:

main <- topic2

remote projects

loadRemoteProjectBranch :: ProjectId -> URI -> ProjectBranchId -> Transaction (Maybe (RemoteProjectId, Maybe RemoteProjectBranchId)) Source #

Determine the remote mapping for a local project/branch by looking at the mapping for the given pair, then falling back to the project of the nearest ancestor.

loadDefaultMergeTargetForLocalProjectBranch :: ProjectId -> URI -> ProjectBranchId -> Transaction (Maybe (RemoteProjectId, RemoteProjectBranchId)) Source #

Load the default merge target for a local branch (i.e. The nearest ancestor's remote mapping)

remote project branches

indexes

dependents index

data DependentsSelector Source #

Which dependents should be returned?

  • IncludeAllDependents. Include all dependents, including references from one's own component-mates, and references from oneself (e.g. those in recursive functions)
  • ExcludeSelf. Include all dependents, including references from one's own component-mates, but excluding actual self references (e.g. those in recursive functions).
  • ExcludeOwnComponent. Include all dependents outside of one's own component.

getDependenciesForDependent :: Id -> Transaction [Reference] Source #

Get non-self dependencies of a user-defined dependent.

getDependencyIdsForDependent :: Id -> Transaction [Id] Source #

Get non-self, user-defined dependencies of a user-defined dependent.

getDependenciesBetweenTerms :: ObjectId -> ObjectId -> Transaction (Set ObjectId) Source #

Given two term (components) A and B, return the set of all terms that are along any "dependency path" from A to B, not including A nor B; i.e., the transitive dependencies of A that are transitive dependents of B.

For example, if A depends on X and Y, X depends on Q, Y depends on Z, and X and Z depend on B...

  • -X-----Q / A B / Y---Z

...then `getDependenciesBetweenTerms A B` would return the set {X Y Z}

getDirectDependentsWithinScope :: Set Id -> Set Reference -> Transaction (DefnsF Set TermReferenceId TypeReferenceId) Source #

`getDirectDependentsWithinScope scope query` returns all direct dependents of query that are in scope (not including query itself).

getTransitiveDependentsWithinScope :: Set Id -> Set Reference -> Transaction (DefnsF Set TermReferenceId TypeReferenceId) Source #

`getTransitiveDependentsWithinScope scope query` returns all transitive dependents of query that are in scope (not including query itself).

type index

type mentions index

hash prefix lookup

Name Lookup

copyScopedNameLookup :: BranchHashId -> BranchHashId -> Transaction () Source #

Copies existing name lookup rows but replaces their branch hash id; This is a low-level operation used as part of deriving a new name lookup index from an existing one as performantly as possible.

insertScopedTermNames :: BranchHashId -> [NamedRef (TextReferent, Maybe ConstructorType)] -> Transaction () Source #

Insert the given set of term names into the name lookup table

insertScopedTypeNames :: BranchHashId -> [NamedRef TextReference] -> Transaction () Source #

Insert the given set of type names into the name lookup table

removeScopedTermNames :: BranchHashId -> [NamedRef TextReferent] -> Transaction () Source #

Remove the given set of term names into the name lookup table

removeScopedTypeNames :: BranchHashId -> [NamedRef TextReference] -> Transaction () Source #

Remove the given set of term names into the name lookup table

termNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef (TextReferent, Maybe ConstructorType)] Source #

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 term names in the provided name lookup and relative namespace. Includes dependencies, but not transitive dependencies.

typeNamesWithinNamespace :: BranchHashId -> PathSegments -> Transaction [NamedRef TextReference] Source #

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 type names in the provided name lookup and relative namespace. Includes dependencies, but not transitive dependencies.

termNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> TextReferent -> Maybe ReversedName -> Transaction [ReversedName] Source #

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 term names for a given Referent within a given namespace. Considers one level of dependencies, but not transitive dependencies.

typeNamesForRefWithinNamespace :: BranchHashId -> PathSegments -> TextReference -> Maybe ReversedName -> Transaction [ReversedName] Source #

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 type names for a given Reference within a given namespace. Considers one level of dependencies, but not transitive dependencies.

recursiveTermNameSearch :: BranchHashId -> TextReferent -> Transaction (Maybe ReversedName) Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

Searches all dependencies transitively looking for the provided referent. Prefer termNamesForRefWithinNamespace 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 :: BranchHashId -> TextReference -> Transaction (Maybe ReversedName) Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

Searches all dependencies transitively looking for the provided referent. 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.

termRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef (TextReferent, Maybe ConstructorType)] Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

Get the set of refs for an exact name. This will only return results which are within the name lookup for the provided branch hash id. It's the caller's job to select the correct name lookup for your exact name.

See termRefsForExactName in U.Codebase.Sqlite.Operations

typeRefsForExactName :: BranchHashId -> ReversedName -> Transaction [NamedRef TextReference] Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

Get the set of refs for an exact name. This will only return results which are within the name lookup for the provided branch hash id. It's the caller's job to select the correct name lookup for your exact name.

See termRefsForExactName in U.Codebase.Sqlite.Operations

checkBranchHashNameLookupExists :: BranchHashId -> Transaction Bool Source #

Check if we've already got an index for the desired root branch hash.

trackNewBranchHashNameLookup :: BranchHashId -> Transaction () Source #

Inserts a new record into the name_lookups table

deleteNameLookup :: BranchHashId -> Transaction () Source #

Delete the specified name lookup. This should only be used if you're sure it's unused, or if you're going to re-create it in the same transaction.

termNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef (TextReferent, Maybe ConstructorType)] Source #

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 term names within a given namespace which have the given suffix.

typeNamesBySuffix :: BranchHashId -> PathSegments -> ReversedName -> Transaction [NamedRef TextReference] Source #

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 type names within a given namespace which have the given suffix.

longestMatchingTermNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef TextReferent -> Transaction (Maybe (NamedRef (TextReferent, Maybe ConstructorType))) Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

The goal of this query is to search the codebase for the single name which has a different hash from the provided name, but shares longest matching suffix for for that name.

Including this name in the pretty-printer object causes it to suffixify the name so that it is unambiguous from other names in scope.

Sqlite doesn't provide enough functionality to do this query in a single query, so we do it iteratively, querying for longer and longer suffixes we no longer find matches. Then we return the name with longest matching suffix.

This is still relatively efficient because we can use an index and LIMIT 1 to make each individual query fast, and in the common case we'll only need two or three queries to find the longest matching suffix.

Considers one level of dependencies, but not transitive dependencies.

longestMatchingTypeNameForSuffixification :: BranchHashId -> PathSegments -> NamedRef TextReference -> Transaction (Maybe (NamedRef TextReference)) Source #

NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this is only true on Share.

The goal of this query is to search the codebase for the single name which has a different hash from the provided name, but shares longest matching suffix for for that name.

Including this name in the pretty-printer object causes it to suffixify the name so that it is unambiguous from other names in scope.

Sqlite doesn't provide enough functionality to do this query in a single query, so we do it iteratively, querying for longer and longer suffixes we no longer find matches. Then we return the name with longest matching suffix.

This is still relatively efficient because we can use an index and LIMIT 1 to make each individual query fast, and in the common case we'll only need two or three queries to find the longest matching suffix.

Considers one level of dependencies, but not transitive dependencies.

associateNameLookupMounts :: BranchHashId -> [(PathSegments, BranchHashId)] -> Transaction () Source #

Associate name lookup indexes for dependencies to specific mounting points within another name lookup.

listNameLookupMounts :: BranchHashId -> Transaction [(PathSegments, BranchHashId)] Source #

Fetch the name lookup mounts for a given name lookup index.

deleteNameLookupsExceptFor :: [BranchHashId] -> Transaction () Source #

Delete any name lookup that's not in the provided list.

This can be used to garbage collect unreachable name lookups.

fuzzySearchTerms :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [NamedRef (TextReferent, Maybe ConstructorType)] Source #

Searches for all names within the given name lookup which contain the provided list of segments in order. Search is case insensitive.

fuzzySearchTypes :: Bool -> BranchHashId -> Int -> PathSegments -> [Text] -> Transaction [NamedRef TextReference] Source #

Searches for all names within the given name lookup which contain the provided list of segments in order.

Search is case insensitive.

Reflog

getProjectReflog :: Int -> ProjectId -> Transaction [Entry ProjectId ProjectBranchId CausalHashId] Source #

Get x number of entries from the project reflog for the provided project

getProjectBranchReflog :: Int -> ProjectBranchId -> Transaction [Entry ProjectId ProjectBranchId CausalHashId] Source #

Get x number of entries from the project reflog for the provided branch.

getGlobalReflog :: Int -> Transaction [Entry ProjectId ProjectBranchId CausalHashId] Source #

Get x number of entries from the global reflog spanning all projects

garbage collection

garbageCollectObjectsWithoutHashes :: Transaction () Source #

Delete objects without hashes. An object typically *would* have a hash, but (for example) during a migration in which an object's hash may change, its corresponding hash_object row may be updated to point at a new version of that object. This procedure clears out all references to objects that do not have any corresponding hash_object rows.

sync temp entities

entityExists :: Hash32 -> Transaction Bool Source #

Does this entity already exist in the database, i.e. in the object or causal table?

entityLocation :: Hash32 -> Transaction (Maybe EntityLocation) Source #

Where is an entity stored?

expectEntity :: Hash32 -> Transaction SyncEntity Source #

Read an entity out of main storage.

syncToTempEntity :: SyncEntity -> Transaction TempEntity Source #

looking up all of the text and hashes is the first step of converting a SyncEntity to a Share.Entity

insertTempEntity :: Hash32 -> TempEntity -> NEMap Hash32 Text -> Transaction () Source #

Insert a new temp_entity row, and its associated 1+ temp_entity_missing_dependency rows.

Preconditions: 1. The entity does not already exist in "main" storage (object / causal) 2. The entity does not already exist in temp_entity.

saveTempEntityInMain :: HashHandle -> Hash32 -> TempEntity -> Transaction (Either CausalHashId ObjectId) Source #

Save a temp entity in main storage.

Precondition: all of its dependencies are already in main storage.

expectTempEntity :: Hash32 -> Transaction TempEntity Source #

Read an entity out of temp storage.

deleteTempEntity :: Hash32 -> Transaction () Source #

Delete a row from the temp_entity table, if it exists.

clearTempEntityTables :: Transaction () Source #

Clears the temp_entity and temp_entity_missing_dependency tables. The hashjwts stored in temp entity tables can sometimes go stale, so we clear them out. This is safe because temp entities are generally considered ephemeral except during an active pull.

elaborate hashes

elaborateHashes :: NonEmpty Hash32 -> Transaction [Text] Source #

Elaborate a set of temp_entity hashes.

Given a set of temp_entity hashes, returns the (known) set of transitive dependencies that haven't already been downloaded (i.e. aren't in the temp_entity table)

For example, if we have temp entities A and B, where A depends on B and B depends on C...

| temp_entity | | temp_entity_missing_dependency | |=============| |================================| | hash | | dependent | dependency | |-------------| |--------------|-----------------| | A | | A | B | | B | | B | C |

... then `elaborateHashes {A}` would return the singleton set {C} (because we take the set of transitive dependencies {A,B,C} and subtract the set we already have, {A,B}).

current project path

expectCurrentProjectPath :: HasCallStack => Transaction (ProjectId, ProjectBranchId, [NameSegment]) Source #

Get the most recent namespace the user has visited.

setCurrentProjectPath :: ProjectId -> ProjectBranchId -> [NameSegment] -> Transaction () Source #

Set the most recent namespace the user has visited.

migrations

addReflogTable :: Transaction () Source #

Deprecated in favour of project-branch reflog

addSquashResultTableIfNotExists :: Transaction () Source #

Added as a fix because addSquashResultTable was missed in the createSchema action for a portion of time.

addProjectBranchReflogTable :: Transaction () Source #

Deprecated in favour of project-branch reflog

schema version

expectSchemaVersion :: SchemaVersion -> Transaction () Source #

Expect the given schema version.

helpers for various migrations

getCausalsWithoutBranchObjects :: Transaction [CausalHashId] Source #

Finds all causals that refer to a branch for which we don't have an object stored. Although there are plans to support this in the future, currently all such cases are the result of database inconsistencies and are unexpected.

removeHashObjectsByHashingVersion :: HashVersion -> Transaction () Source #

Delete all hash objects of a given hash version. Leaves the corresponding hashes in the hash table alone.

db misc

c2xTerm :: forall m t d. Monad m => (Text -> m t) -> (Hash -> m d) -> Term Symbol -> Maybe (Type Symbol) -> m (LocalIds' t d, Term, Maybe Type) Source #

implementation detail of c2{s,w}Term The Type is optional, because we don't store them for watch expression results.

localIdsToLookups :: Monad m => (t -> m Text) -> (d -> m Hash) -> LocalIds' t d -> m (LocalTextId -> Text, LocalDefnId -> Hash) Source #

implementation detail of {s,w}2c*Term* & s2cDecl

s2cDecl :: LocalIds -> Decl Symbol -> Transaction (Decl Symbol) Source #

Unlocalize a decl.

saveReferenceH :: Reference -> Transaction ReferenceH Source #

Save the text and hash parts of a Reference to the database and substitute their ids.

saveTermComponent Source #

Arguments

:: HashHandle 
-> Maybe ByteString

The serialized term component if we already have it e.g. via sync

-> Hash

term component hash

-> [(Term Symbol, Type Symbol)]

term component

-> Transaction ObjectId 

x2cTType :: (LocalTextId -> Text) -> (LocalDefnId -> Hash) -> Type -> Type Symbol Source #

implementation detail of {s,w}2c*Term*

x2cTerm :: (LocalTextId -> Text) -> (LocalDefnId -> Hash) -> Term -> Term Symbol Source #

implementation detail of {s,w}2c*Term*

x2cDecl :: (r -> r1) -> DeclR r Symbol -> DeclR r1 Symbol Source #

checkBranchExistsForCausalHash :: CausalHash -> Transaction Bool Source #

Checks whether the codebase contains the actual branch value for a given causal hash.

Types

type NamespaceText = Text Source #

A namespace rendered as a path, no leading . E.g. "base.data"