module Unison.Server.NameSearch.Sqlite
  ( resolveShortHash,
    typeReferencesByShortHash,
    termReferentsByShortHash,
    NameSearch (..),
    nameSearchForPerspective,
  )
where

import Control.Lens
import Data.Set qualified as Set
import U.Codebase.Sqlite.NameLookups (PathSegments (..), ReversedName (..))
import U.Codebase.Sqlite.NamedRef qualified as NamedRef
import U.Codebase.Sqlite.Operations qualified as Ops
import Unison.Builtin qualified as Builtin
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.NamesWithHistory (SearchType (ExactName, IncludeSuffixes))
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Server.NameSearch (NameSearch (..), Search (..))
import Unison.Server.SearchResult qualified as SR
import Unison.ShortHash qualified as SH
import Unison.Sqlite qualified as Sqlite
import Unison.Util.Set qualified as Set

nameSearchForPerspective :: Codebase m v a -> Ops.NamesPerspective -> (NameSearch Sqlite.Transaction)
nameSearchForPerspective :: forall (m :: * -> *) v a.
Codebase m v a -> NamesPerspective -> NameSearch Transaction
nameSearchForPerspective Codebase m v a
codebase namesPerspective :: NamesPerspective
namesPerspective@Ops.NamesPerspective {PathSegments
pathToMountedNameLookup :: PathSegments
$sel:pathToMountedNameLookup:NamesPerspective :: NamesPerspective -> PathSegments
pathToMountedNameLookup} = do
  NameSearch {Search Transaction Reference
typeSearch :: Search Transaction Reference
$sel:typeSearch:NameSearch :: Search Transaction Reference
typeSearch, Search Transaction Referent
termSearch :: Search Transaction Referent
$sel:termSearch:NameSearch :: Search Transaction Referent
termSearch}
  where
    -- Some searches will provide a fully-qualified name, so we need to strip off the
    -- mount-path before we search or it will fail to find anything.
    stripMountPathPrefix :: Name -> Name
    stripMountPathPrefix :: Name -> Name
stripMountPathPrefix Name
name = Name -> [NameSegment] -> Name
Name.tryStripReversedPrefix Name
name ([NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse ([NameSegment] -> [NameSegment]) -> [NameSegment] -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ PathSegments -> [NameSegment]
forall a b. Coercible a b => a -> b
coerce PathSegments
pathToMountedNameLookup)
    typeSearch :: Search Transaction Reference
typeSearch =
      Search
        { $sel:lookupNames:Search :: Reference -> Transaction (Set (HashQualified Name))
lookupNames = Reference -> Transaction (Set (HashQualified Name))
lookupNamesForTypes,
          $sel:lookupRelativeHQRefs':Search :: SearchType -> HashQualified Name -> Transaction (Set Reference)
lookupRelativeHQRefs' = \SearchType
searchType HashQualified Name
n -> SearchType -> HashQualified Name -> Transaction (Set Reference)
hqTypeSearch SearchType
searchType (HashQualified Name -> Transaction (Set Reference))
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Transaction (Set Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Name
stripMountPathPrefix (HashQualified Name -> Transaction (Set Reference))
-> HashQualified Name -> Transaction (Set Reference)
forall a b. (a -> b) -> a -> b
$ HashQualified Name
n,
          $sel:makeResult:Search :: HashQualified Name
-> Reference
-> Set (HashQualified Name)
-> Transaction SearchResult
makeResult = \HashQualified Name
hqname Reference
r Set (HashQualified Name)
names -> SearchResult -> Transaction SearchResult
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchResult -> Transaction SearchResult)
-> SearchResult -> Transaction SearchResult
forall a b. (a -> b) -> a -> b
$ HashQualified Name
-> Reference -> Set (HashQualified Name) -> SearchResult
SR.typeResult HashQualified Name
hqname Reference
r Set (HashQualified Name)
names,
          $sel:matchesNamedRef:Search :: Name -> Reference -> HashQualified Name -> Bool
matchesNamedRef = Name -> Reference -> HashQualified Name -> Bool
forall n. Eq n => n -> Reference -> HashQualified n -> Bool
HQ'.matchesNamedReference
        }
    termSearch :: Search Transaction Referent
termSearch =
      Search
        { $sel:lookupNames:Search :: Referent -> Transaction (Set (HashQualified Name))
lookupNames = Referent -> Transaction (Set (HashQualified Name))
lookupNamesForTerms,
          $sel:lookupRelativeHQRefs':Search :: SearchType -> HashQualified Name -> Transaction (Set Referent)
lookupRelativeHQRefs' = \SearchType
searchType HashQualified Name
n -> SearchType -> HashQualified Name -> Transaction (Set Referent)
hqTermSearch SearchType
searchType (HashQualified Name -> Transaction (Set Referent))
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Transaction (Set Referent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Name
stripMountPathPrefix (HashQualified Name -> Transaction (Set Referent))
-> HashQualified Name -> Transaction (Set Referent)
forall a b. (a -> b) -> a -> b
$ HashQualified Name
n,
          $sel:makeResult:Search :: HashQualified Name
-> Referent -> Set (HashQualified Name) -> Transaction SearchResult
makeResult = \HashQualified Name
hqname Referent
r Set (HashQualified Name)
names -> SearchResult -> Transaction SearchResult
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchResult -> Transaction SearchResult)
-> SearchResult -> Transaction SearchResult
forall a b. (a -> b) -> a -> b
$ HashQualified Name
-> Referent -> Set (HashQualified Name) -> SearchResult
SR.termResult HashQualified Name
hqname Referent
r Set (HashQualified Name)
names,
          $sel:matchesNamedRef:Search :: Name -> Referent -> HashQualified Name -> Bool
matchesNamedRef = Name -> Referent -> HashQualified Name -> Bool
forall n. Eq n => n -> Referent -> HashQualified n -> Bool
HQ'.matchesNamedReferent
        }

    lookupNamesForTypes :: Reference -> Sqlite.Transaction (Set (HQ'.HashQualified Name))
    lookupNamesForTypes :: Reference -> Transaction (Set (HashQualified Name))
lookupNamesForTypes Reference
ref = do
      [ReversedName]
names <- NamesPerspective
-> Reference -> Maybe ReversedName -> Transaction [ReversedName]
Ops.typeNamesForRefWithinNamespace NamesPerspective
namesPerspective (Reference -> Reference
Cv.reference1to2 Reference
ref) Maybe ReversedName
forall a. Maybe a
Nothing
      [ReversedName]
names
        [ReversedName]
-> ([ReversedName] -> [HashQualified Name]) -> [HashQualified Name]
forall a b. a -> (a -> b) -> b
& (ReversedName -> HashQualified Name)
-> [ReversedName] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReversedName
segments -> Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified (ReversedName -> Name
reversedSegmentsToName ReversedName
segments) (Reference -> ShortHash
Reference.toShortHash Reference
ref))
        [HashQualified Name]
-> ([HashQualified Name] -> Set (HashQualified Name))
-> Set (HashQualified Name)
forall a b. a -> (a -> b) -> b
& [HashQualified Name] -> Set (HashQualified Name)
forall a. Ord a => [a] -> Set a
Set.fromList
        Set (HashQualified Name)
-> (Set (HashQualified Name)
    -> Transaction (Set (HashQualified Name)))
-> Transaction (Set (HashQualified Name))
forall a b. a -> (a -> b) -> b
& Set (HashQualified Name) -> Transaction (Set (HashQualified Name))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    lookupNamesForTerms :: Referent -> Sqlite.Transaction (Set (HQ'.HashQualified Name))
    lookupNamesForTerms :: Referent -> Transaction (Set (HashQualified Name))
lookupNamesForTerms Referent
ref = do
      [ReversedName]
names <- NamesPerspective
-> Referent -> Maybe ReversedName -> Transaction [ReversedName]
Ops.termNamesForRefWithinNamespace NamesPerspective
namesPerspective (Referent -> Referent
Cv.referent1to2 Referent
ref) Maybe ReversedName
forall a. Maybe a
Nothing
      [ReversedName]
names
        [ReversedName]
-> ([ReversedName] -> [HashQualified Name]) -> [HashQualified Name]
forall a b. a -> (a -> b) -> b
& (ReversedName -> HashQualified Name)
-> [ReversedName] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReversedName
segments -> Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified (ReversedName -> Name
reversedSegmentsToName ReversedName
segments) (Referent -> ShortHash
Referent.toShortHash Referent
ref))
        [HashQualified Name]
-> ([HashQualified Name] -> Set (HashQualified Name))
-> Set (HashQualified Name)
forall a b. a -> (a -> b) -> b
& [HashQualified Name] -> Set (HashQualified Name)
forall a. Ord a => [a] -> Set a
Set.fromList
        Set (HashQualified Name)
-> (Set (HashQualified Name)
    -> Transaction (Set (HashQualified Name)))
-> Transaction (Set (HashQualified Name))
forall a b. a -> (a -> b) -> b
& Set (HashQualified Name) -> Transaction (Set (HashQualified Name))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    -- Search the codebase for matches to the given hq name.
    -- Supports either an exact match or a suffix match.
    hqTermSearch :: SearchType -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Referent)
    hqTermSearch :: SearchType -> HashQualified Name -> Transaction (Set Referent)
hqTermSearch SearchType
searchStrat HashQualified Name
hqName = do
      case HashQualified Name
hqName of
        HQ'.NameOnly Name
name -> do
          [NamedRef (Referent, Maybe ConstructorType)]
namedRefs <-
            case SearchType
searchStrat of
              SearchType
ExactName -> NamesPerspective
-> ReversedName
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
Ops.termRefsForExactName NamesPerspective
namesPerspective (NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name)
              SearchType
IncludeSuffixes -> NamesPerspective
-> ReversedName
-> Transaction [NamedRef (Referent, Maybe ConstructorType)]
Ops.termNamesBySuffix NamesPerspective
namesPerspective (NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name)
          [NamedRef (Referent, Maybe ConstructorType)]
namedRefs
            [NamedRef (Referent, Maybe ConstructorType)]
-> ([NamedRef (Referent, Maybe ConstructorType)] -> [Referent])
-> [Referent]
forall a b. a -> (a -> b) -> b
& (NamedRef (Referent, Maybe ConstructorType) -> Referent)
-> [NamedRef (Referent, Maybe ConstructorType)] -> [Referent]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \(NamedRef (Referent, Maybe ConstructorType)
-> (Referent, Maybe ConstructorType)
forall ref. NamedRef ref -> ref
NamedRef.ref -> (Referent
ref, Maybe ConstructorType
mayCT)) ->
                  ConstructorType -> Referent -> Referent
Cv.referent2to1UsingCT (ConstructorType -> Maybe ConstructorType -> ConstructorType
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ConstructorType
forall a. HasCallStack => [Char] -> a
error [Char]
"Required constructor type for constructor but it was null") Maybe ConstructorType
mayCT) Referent
ref
              )
            [Referent] -> ([Referent] -> Set Referent) -> Set Referent
forall a b. a -> (a -> b) -> b
& [Referent] -> Set Referent
forall a. Ord a => [a] -> Set a
Set.fromList
            Set Referent
-> (Set Referent -> Transaction (Set Referent))
-> Transaction (Set Referent)
forall a b. a -> (a -> b) -> b
& Set Referent -> Transaction (Set Referent)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        HQ'.HashQualified Name
name ShortHash
sh -> do
          let fqn :: Name
fqn = Name -> Name
fullyQualifyName Name
name
          Set Referent
termRefs <- Codebase m v a -> ShortHash -> Transaction (Set Referent)
forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Referent)
termReferentsByShortHash Codebase m v a
codebase ShortHash
sh
          Set Referent
-> (Referent -> Transaction (Maybe Referent))
-> Transaction (Set Referent)
forall b (f :: * -> *) a.
(Ord b, Applicative f) =>
Set a -> (a -> f (Maybe b)) -> f (Set b)
Set.forMaybe Set Referent
termRefs \Referent
termRef -> do
            [ReversedName]
matches <- NamesPerspective
-> Referent -> Maybe ReversedName -> Transaction [ReversedName]
Ops.termNamesForRefWithinNamespace NamesPerspective
namesPerspective (Referent -> Referent
Cv.referent1to2 Referent
termRef) (ReversedName -> Maybe ReversedName
forall a. a -> Maybe a
Just (ReversedName -> Maybe ReversedName)
-> (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment
-> Maybe ReversedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> Maybe ReversedName)
-> NonEmpty NameSegment -> Maybe ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name)
            -- Return a valid ref if at least one match was found. Require that it be an exact
            -- match if specified.
            if (ReversedName -> Bool) -> [ReversedName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ReversedName
n -> NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (Name -> NonEmpty NameSegment
Name.reverseSegments Name
fqn) ReversedName -> ReversedName -> Bool
forall a. Eq a => a -> a -> Bool
== ReversedName
n Bool -> Bool -> Bool
|| SearchType
searchStrat SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
/= SearchType
ExactName) [ReversedName]
matches
              then Maybe Referent -> Transaction (Maybe Referent)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Referent -> Maybe Referent
forall a. a -> Maybe a
Just Referent
termRef)
              else Maybe Referent -> Transaction (Maybe Referent)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Referent
forall a. Maybe a
Nothing

    -- Search the codebase for matches to the given hq name.
    -- Supports either an exact match or a suffix match.
    hqTypeSearch :: SearchType -> HQ'.HashQualified Name -> Sqlite.Transaction (Set Reference)
    hqTypeSearch :: SearchType -> HashQualified Name -> Transaction (Set Reference)
hqTypeSearch SearchType
searchStrat HashQualified Name
hqName = do
      case HashQualified Name
hqName of
        HQ'.NameOnly Name
name -> do
          let fqn :: Name
fqn = Name -> Name
fullyQualifyName Name
name
          [NamedRef Reference]
namedRefs <-
            case SearchType
searchStrat of
              SearchType
ExactName -> NamesPerspective
-> ReversedName -> Transaction [NamedRef Reference]
Ops.typeRefsForExactName NamesPerspective
namesPerspective (NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
fqn)
              SearchType
IncludeSuffixes -> NamesPerspective
-> ReversedName -> Transaction [NamedRef Reference]
Ops.typeNamesBySuffix NamesPerspective
namesPerspective (NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment -> ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name)
          [NamedRef Reference]
namedRefs
            [NamedRef Reference]
-> ([NamedRef Reference] -> [Reference]) -> [Reference]
forall a b. a -> (a -> b) -> b
& (NamedRef Reference -> Reference)
-> [NamedRef Reference] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference -> Reference
Cv.reference2to1 (Reference -> Reference)
-> (NamedRef Reference -> Reference)
-> NamedRef Reference
-> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedRef Reference -> Reference
forall ref. NamedRef ref -> ref
NamedRef.ref)
            [Reference] -> ([Reference] -> Set Reference) -> Set Reference
forall a b. a -> (a -> b) -> b
& [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList
            Set Reference
-> (Set Reference -> Transaction (Set Reference))
-> Transaction (Set Reference)
forall a b. a -> (a -> b) -> b
& Set Reference -> Transaction (Set Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        HQ'.HashQualified Name
name ShortHash
sh -> do
          let fqn :: Name
fqn = Name -> Name
fullyQualifyName Name
name
          Set Reference
typeRefs <- ShortHash -> Transaction (Set Reference)
typeReferencesByShortHash ShortHash
sh
          Set Reference
-> (Reference -> Transaction (Maybe Reference))
-> Transaction (Set Reference)
forall b (f :: * -> *) a.
(Ord b, Applicative f) =>
Set a -> (a -> f (Maybe b)) -> f (Set b)
Set.forMaybe Set Reference
typeRefs \Reference
typeRef -> do
            [ReversedName]
matches <- NamesPerspective
-> Reference -> Maybe ReversedName -> Transaction [ReversedName]
Ops.typeNamesForRefWithinNamespace NamesPerspective
namesPerspective (Reference -> Reference
Cv.reference1to2 Reference
typeRef) (ReversedName -> Maybe ReversedName
forall a. a -> Maybe a
Just (ReversedName -> Maybe ReversedName)
-> (NonEmpty NameSegment -> ReversedName)
-> NonEmpty NameSegment
-> Maybe ReversedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (NonEmpty NameSegment -> Maybe ReversedName)
-> NonEmpty NameSegment -> Maybe ReversedName
forall a b. (a -> b) -> a -> b
$ Name -> NonEmpty NameSegment
Name.reverseSegments Name
name)
            -- Return a valid ref if at least one match was found. Require that it be an exact
            -- match if specified.
            if (ReversedName -> Bool) -> [ReversedName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ReversedName
n -> NonEmpty NameSegment -> ReversedName
forall a b. Coercible a b => a -> b
coerce (Name -> NonEmpty NameSegment
Name.reverseSegments Name
fqn) ReversedName -> ReversedName -> Bool
forall a. Eq a => a -> a -> Bool
== ReversedName
n Bool -> Bool -> Bool
|| SearchType
searchStrat SearchType -> SearchType -> Bool
forall a. Eq a => a -> a -> Bool
/= SearchType
ExactName) [ReversedName]
matches
              then Maybe Reference -> Transaction (Maybe Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
typeRef)
              else Maybe Reference -> Transaction (Maybe Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Reference
forall a. Maybe a
Nothing

    reversedSegmentsToName :: ReversedName -> Name
    reversedSegmentsToName :: ReversedName -> Name
reversedSegmentsToName = NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (ReversedName -> NonEmpty NameSegment) -> ReversedName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReversedName -> NonEmpty NameSegment
forall a b. Coercible a b => a -> b
coerce

    -- Fully qualify a name by prepending the current namespace perspective's path
    fullyQualifyName :: Name -> Name
    fullyQualifyName :: Name -> Name
fullyQualifyName =
      Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' (Absolute -> Path')
-> ([NameSegment] -> Absolute) -> [NameSegment] -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Absolute
Path.Absolute (Path -> Absolute)
-> ([NameSegment] -> Path) -> [NameSegment] -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Path
Path.fromList ([NameSegment] -> Path') -> [NameSegment] -> Path'
forall a b. (a -> b) -> a -> b
$ PathSegments -> [NameSegment]
forall a b. Coercible a b => a -> b
coerce PathSegments
pathToMountedNameLookup)

-- | Look up types in the codebase by short hash, and include builtins.
typeReferencesByShortHash :: SH.ShortHash -> Sqlite.Transaction (Set Reference)
typeReferencesByShortHash :: ShortHash -> Transaction (Set Reference)
typeReferencesByShortHash ShortHash
sh = do
  Set Id
fromCodebase <- ShortHash -> Transaction (Set Id)
Codebase.typeReferencesByPrefix ShortHash
sh
  let fromBuiltins :: Set Reference
fromBuiltins =
        (Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
          (\Reference
r -> ShortHash
sh ShortHash -> ShortHash -> Bool
forall a. Eq a => a -> a -> Bool
== Reference -> ShortHash
Reference.toShortHash Reference
r)
          Set Reference
Builtin.intrinsicTypeReferences
  Set Reference -> Transaction (Set Reference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Reference
fromBuiltins Set Reference -> Set Reference -> Set Reference
forall a. Semigroup a => a -> a -> a
<> (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
fromCodebase)

-- | Look up terms in the codebase by short hash, and include builtins.
termReferentsByShortHash :: Codebase m v a -> SH.ShortHash -> Sqlite.Transaction (Set Referent)
termReferentsByShortHash :: forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Referent)
termReferentsByShortHash Codebase m v a
codebase ShortHash
sh = do
  Set Id
fromCodebase <- Codebase m v a -> ShortHash -> Transaction (Set Id)
forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Id)
Codebase.termReferentsByPrefix Codebase m v a
codebase ShortHash
sh
  let fromBuiltins :: Set Referent
fromBuiltins =
        (Reference -> Referent) -> Set Reference -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Referent
Referent.Ref (Set Reference -> Set Referent) -> Set Reference -> Set Referent
forall a b. (a -> b) -> a -> b
$
          (Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
            (\Reference
r -> ShortHash
sh ShortHash -> ShortHash -> Bool
forall a. Eq a => a -> a -> Bool
== Reference -> ShortHash
Reference.toShortHash Reference
r)
            Set Reference
Builtin.intrinsicTermReferences
  Set Referent -> Transaction (Set Referent)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Referent
fromBuiltins Set Referent -> Set Referent -> Set Referent
forall a. Semigroup a => a -> a -> a
<> (Id -> Referent) -> Set Id -> Set Referent
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (ASetter Id Referent Id Reference
-> (Id -> Reference) -> Id -> Referent
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Id Referent Id Reference
forall r r' (f :: * -> *).
Functor f =>
(r -> f r') -> Referent' r -> f (Referent' r')
Referent.reference_ Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId) Set Id
fromCodebase)

-- | Resolves a shorthash into any possible matches.
resolveShortHash :: Codebase m v a -> SH.ShortHash -> Sqlite.Transaction (Set LD.LabeledDependency)
resolveShortHash :: forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set LabeledDependency)
resolveShortHash Codebase m v a
codebase ShortHash
sh = do
  Set LabeledDependency
terms <- (Referent -> LabeledDependency)
-> Set Referent -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Referent -> LabeledDependency
LD.TermReferent (Set Referent -> Set LabeledDependency)
-> Transaction (Set Referent)
-> Transaction (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v a -> ShortHash -> Transaction (Set Referent)
forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Referent)
termReferentsByShortHash Codebase m v a
codebase ShortHash
sh
  Set LabeledDependency
types <- (Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LD.TypeReference (Set Reference -> Set LabeledDependency)
-> Transaction (Set Reference)
-> Transaction (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortHash -> Transaction (Set Reference)
typeReferencesByShortHash ShortHash
sh
  Set LabeledDependency -> Transaction (Set LabeledDependency)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set LabeledDependency -> Transaction (Set LabeledDependency))
-> Set LabeledDependency -> Transaction (Set LabeledDependency)
forall a b. (a -> b) -> a -> b
$ Set LabeledDependency
terms Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Set LabeledDependency
types