{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE MultiWayIf #-}

module Unison.Server.Backend
  ( -- * Types
    BackendError (..),
    Backend (..),
    ShallowListEntry (..),
    listEntryName,
    BackendEnv (..),
    TermEntry (..),
    TypeEntry (..),
    FoundRef (..),
    IncludeCycles (..),
    DefinitionResults (..),
    SyntaxText,

    -- * Endpoints
    fuzzyFind,

    -- * Utilities
    bestNameForTerm,
    bestNameForType,
    definitionsByName,
    displayType,
    docsInBranchToHtmlFiles,
    expandShortCausalHash,
    findDocInBranch,
    formatSuffixedType,
    getShallowCausalAtPathFromRootHash,
    getTermTag,
    getTypeTag,
    hoistBackend,
    hqNameQuery,
    loadReferentType,
    loadSearchResults,
    lsAtPath,
    lsBranch,
    mungeSyntaxText,
    Codebase.expectCausalBranchByCausalHash,
    resolveRootBranchHashV2,
    namesAtPathFromRootBranchHash,
    termEntryDisplayName,
    termEntryHQName,
    termEntryToNamedTerm,
    termEntryLabeledDependencies,
    termListEntry,
    termReferentsByShortHash,
    typeDeclHeader,
    typeEntryDisplayName,
    typeEntryHQName,
    typeEntryToNamedType,
    typeEntryLabeledDependencies,
    typeListEntry,
    typeReferencesByShortHash,
    typeToSyntaxHeader,
    renderDocRefs,
    docsForDefinitionName,
    normaliseRootCausalHash,

    -- * Unused, could remove?
    resolveRootBranchHash,
    isTestResultList,
    fixupNamesRelative,

    -- * Re-exported for Share Server
    termsToSyntax,
    termsToSyntaxOf,
    typesToSyntax,
    typesToSyntaxOf,
    definitionResultsDependencies,
    evalDocRef,
    mkTermDefinition,
    mkTypeDefinition,
    displayTerm,
    formatTypeName,
  )
where

import Control.Error.Util (hush)
import Control.Lens hiding ((??))
import Control.Lens.Cons qualified as Cons
import Control.Monad.Except
import Control.Monad.Reader
import Data.Containers.ListUtils (nubOrdOn)
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Text.Encoding qualified as TextE
import Data.Text.Lazy (toStrict)
import Data.Yaml qualified as Yaml
import Lucid qualified
import System.Directory
import System.FilePath
import Text.FuzzyFind qualified as FZF
import U.Codebase.Branch (NamespaceStats (..))
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.HashTags (BranchHash, CausalHash (..))
import U.Codebase.Referent qualified as V2Referent
import U.Codebase.Sqlite.Operations qualified as Ops
import Unison.ABT qualified as ABT
import Unison.Builtin qualified as B
import Unison.Builtin.Decls qualified as Decls
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.DisplayObject
import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject
import Unison.Codebase.Execute qualified as Codebase
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime qualified as Rt
import Unison.Codebase.ShortCausalHash
  ( ShortCausalHash,
  )
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorReference qualified as ConstructorReference
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.Dependencies qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment (docSegment, libSegment)
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnv.Util qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Project (ProjectBranchName, ProjectName)
import Unison.Reference (Reference, TermReference, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Runtime.IOSource qualified as DD
import Unison.Server.Doc qualified as Doc
import Unison.Server.Doc.AsHtml qualified as DocHtml
import Unison.Server.NameSearch (NameSearch (..), Search (..), applySearch)
import Unison.Server.NameSearch.Sqlite (termReferentsByShortHash, typeReferencesByShortHash)
import Unison.Server.QueryResult
import Unison.Server.SearchResult qualified as SR
import Unison.Server.SearchResultPrime qualified as SR'
import Unison.Server.Syntax qualified as Syntax
import Unison.Server.Types
import Unison.Server.Types qualified as ServerTypes
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as SH
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText)
import Unison.Syntax.Name as Name (toText, unsafeParseText)
import Unison.Syntax.NamePrinter qualified as NP
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
import Unison.Syntax.TermPrinter qualified as TermPrinter
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker qualified as Typechecker
import Unison.Util.AnnotatedText (AnnotatedText)
import Unison.Util.List (uniqueBy)
import Unison.Util.Map qualified as Map
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty (Width)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as R
import Unison.Util.SyntaxText qualified as UST
import Unison.Var (Var)
import Unison.WatchKind qualified as WK
import UnliftIO qualified
import UnliftIO.Environment qualified as Env

type SyntaxText = UST.SyntaxText' Reference

data ShallowListEntry v a
  = ShallowTermEntry (TermEntry v a)
  | ShallowTypeEntry TypeEntry
  | ShallowBranchEntry NameSegment CausalHash NamespaceStats
  | ShallowPatchEntry NameSegment
  deriving (ShallowListEntry v a -> ShallowListEntry v a -> Bool
(ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> (ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> Eq (ShallowListEntry v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
$c== :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
== :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
$c/= :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
/= :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
Eq, Eq (ShallowListEntry v a)
Eq (ShallowListEntry v a) =>
(ShallowListEntry v a -> ShallowListEntry v a -> Ordering)
-> (ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> (ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> (ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> (ShallowListEntry v a -> ShallowListEntry v a -> Bool)
-> (ShallowListEntry v a
    -> ShallowListEntry v a -> ShallowListEntry v a)
-> (ShallowListEntry v a
    -> ShallowListEntry v a -> ShallowListEntry v a)
-> Ord (ShallowListEntry v a)
ShallowListEntry v a -> ShallowListEntry v a -> Bool
ShallowListEntry v a -> ShallowListEntry v a -> Ordering
ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v a. Var v => Eq (ShallowListEntry v a)
forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Ordering
forall v a.
Var v =>
ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
$ccompare :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Ordering
compare :: ShallowListEntry v a -> ShallowListEntry v a -> Ordering
$c< :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
< :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
$c<= :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
<= :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
$c> :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
> :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
$c>= :: forall v a.
Var v =>
ShallowListEntry v a -> ShallowListEntry v a -> Bool
>= :: ShallowListEntry v a -> ShallowListEntry v a -> Bool
$cmax :: forall v a.
Var v =>
ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
max :: ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
$cmin :: forall v a.
Var v =>
ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
min :: ShallowListEntry v a
-> ShallowListEntry v a -> ShallowListEntry v a
Ord, Int -> ShallowListEntry v a -> ShowS
[ShallowListEntry v a] -> ShowS
ShallowListEntry v a -> WatchKind
(Int -> ShallowListEntry v a -> ShowS)
-> (ShallowListEntry v a -> WatchKind)
-> ([ShallowListEntry v a] -> ShowS)
-> Show (ShallowListEntry v a)
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
forall v a. Show v => Int -> ShallowListEntry v a -> ShowS
forall v a. Show v => [ShallowListEntry v a] -> ShowS
forall v a. Show v => ShallowListEntry v a -> WatchKind
$cshowsPrec :: forall v a. Show v => Int -> ShallowListEntry v a -> ShowS
showsPrec :: Int -> ShallowListEntry v a -> ShowS
$cshow :: forall v a. Show v => ShallowListEntry v a -> WatchKind
show :: ShallowListEntry v a -> WatchKind
$cshowList :: forall v a. Show v => [ShallowListEntry v a] -> ShowS
showList :: [ShallowListEntry v a] -> ShowS
Show, (forall x. ShallowListEntry v a -> Rep (ShallowListEntry v a) x)
-> (forall x. Rep (ShallowListEntry v a) x -> ShallowListEntry v a)
-> Generic (ShallowListEntry v a)
forall x. Rep (ShallowListEntry v a) x -> ShallowListEntry v a
forall x. ShallowListEntry v a -> Rep (ShallowListEntry v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (ShallowListEntry v a) x -> ShallowListEntry v a
forall v a x. ShallowListEntry v a -> Rep (ShallowListEntry v a) x
$cfrom :: forall v a x. ShallowListEntry v a -> Rep (ShallowListEntry v a) x
from :: forall x. ShallowListEntry v a -> Rep (ShallowListEntry v a) x
$cto :: forall v a x. Rep (ShallowListEntry v a) x -> ShallowListEntry v a
to :: forall x. Rep (ShallowListEntry v a) x -> ShallowListEntry v a
Generic)

-- __TODO__: This is only used for sorting, and it seems like it might be better
--           to avoid `Text` and instead
--        1. compare as `Name` (using `Name.fromSegment`) and
--        2. make that the `Ord` instance.
listEntryName :: ShallowListEntry v a -> Text
listEntryName :: forall v a. ShallowListEntry v a -> Text
listEntryName = \case
  ShallowTermEntry TermEntry v a
te -> TermEntry v a -> Text
forall v a. TermEntry v a -> Text
termEntryDisplayName TermEntry v a
te
  ShallowTypeEntry TypeEntry
te -> TypeEntry -> Text
typeEntryDisplayName TypeEntry
te
  ShallowBranchEntry NameSegment
n CausalHash
_ NamespaceStats
_ -> NameSegment -> Text
NameSegment.toEscapedText NameSegment
n
  ShallowPatchEntry NameSegment
n -> NameSegment -> Text
NameSegment.toEscapedText NameSegment
n

data BackendError
  = NoSuchNamespace Path.Absolute
  | -- Failed to parse path
    BadNamespace
      -- | error message
      String
      -- | namespace
      String
  | CouldntExpandBranchHash ShortCausalHash
  | AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash)
  | AmbiguousHashForDefinition ShortHash
  | NoBranchForHash CausalHash
  | CouldntLoadBranch CausalHash
  | MissingSignatureForTerm Reference
  | NoSuchDefinition (HQ.HashQualified Name)
  | -- We needed a name lookup index we didn't have.
    ExpectedNameLookup BranchHash
  | -- The inferred project root for a given perspective is neither a parent nor child
    -- of the perspective. This shouldn't happen and indicates a bug.
    -- (perspective, project root)
    DisjointProjectAndPerspective Path Path
  | ProjectBranchNameNotFound ProjectName ProjectBranchName
  deriving stock (Int -> BackendError -> ShowS
[BackendError] -> ShowS
BackendError -> WatchKind
(Int -> BackendError -> ShowS)
-> (BackendError -> WatchKind)
-> ([BackendError] -> ShowS)
-> Show BackendError
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackendError -> ShowS
showsPrec :: Int -> BackendError -> ShowS
$cshow :: BackendError -> WatchKind
show :: BackendError -> WatchKind
$cshowList :: [BackendError] -> ShowS
showList :: [BackendError] -> ShowS
Show)

newtype BackendEnv = BackendEnv
  { -- | Whether to use the sqlite name-lookup table to generate Names objects rather than building Names from the root branch.
    BackendEnv -> Bool
useNamesIndex :: Bool
  }

newtype Backend m a = Backend {forall (m :: * -> *) a.
Backend m a -> ReaderT BackendEnv (ExceptT BackendError m) a
runBackend :: ReaderT BackendEnv (ExceptT BackendError m) a}
  deriving newtype ((forall a b. (a -> b) -> Backend m a -> Backend m b)
-> (forall a b. a -> Backend m b -> Backend m a)
-> Functor (Backend m)
forall a b. a -> Backend m b -> Backend m a
forall a b. (a -> b) -> Backend m a -> Backend m b
forall (m :: * -> *) a b.
Functor m =>
a -> Backend m b -> Backend m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Backend m a -> Backend m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Backend m a -> Backend m b
fmap :: forall a b. (a -> b) -> Backend m a -> Backend m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Backend m b -> Backend m a
<$ :: forall a b. a -> Backend m b -> Backend m a
Functor, Functor (Backend m)
Functor (Backend m) =>
(forall a. a -> Backend m a)
-> (forall a b. Backend m (a -> b) -> Backend m a -> Backend m b)
-> (forall a b c.
    (a -> b -> c) -> Backend m a -> Backend m b -> Backend m c)
-> (forall a b. Backend m a -> Backend m b -> Backend m b)
-> (forall a b. Backend m a -> Backend m b -> Backend m a)
-> Applicative (Backend m)
forall a. a -> Backend m a
forall a b. Backend m a -> Backend m b -> Backend m a
forall a b. Backend m a -> Backend m b -> Backend m b
forall a b. Backend m (a -> b) -> Backend m a -> Backend m b
forall a b c.
(a -> b -> c) -> Backend m a -> Backend m b -> Backend m c
forall (m :: * -> *). Monad m => Functor (Backend m)
forall (m :: * -> *) a. Monad m => a -> Backend m a
forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m a
forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m b
forall (m :: * -> *) a b.
Monad m =>
Backend m (a -> b) -> Backend m a -> Backend m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Backend m a -> Backend m b -> Backend m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> Backend m a
pure :: forall a. a -> Backend m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
Backend m (a -> b) -> Backend m a -> Backend m b
<*> :: forall a b. Backend m (a -> b) -> Backend m a -> Backend m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Backend m a -> Backend m b -> Backend m c
liftA2 :: forall a b c.
(a -> b -> c) -> Backend m a -> Backend m b -> Backend m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m b
*> :: forall a b. Backend m a -> Backend m b -> Backend m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m a
<* :: forall a b. Backend m a -> Backend m b -> Backend m a
Applicative, Applicative (Backend m)
Applicative (Backend m) =>
(forall a b. Backend m a -> (a -> Backend m b) -> Backend m b)
-> (forall a b. Backend m a -> Backend m b -> Backend m b)
-> (forall a. a -> Backend m a)
-> Monad (Backend m)
forall a. a -> Backend m a
forall a b. Backend m a -> Backend m b -> Backend m b
forall a b. Backend m a -> (a -> Backend m b) -> Backend m b
forall (m :: * -> *). Monad m => Applicative (Backend m)
forall (m :: * -> *) a. Monad m => a -> Backend m a
forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m b
forall (m :: * -> *) a b.
Monad m =>
Backend m a -> (a -> Backend m b) -> Backend m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Backend m a -> (a -> Backend m b) -> Backend m b
>>= :: forall a b. Backend m a -> (a -> Backend m b) -> Backend m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Backend m a -> Backend m b -> Backend m b
>> :: forall a b. Backend m a -> Backend m b -> Backend m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> Backend m a
return :: forall a. a -> Backend m a
Monad, Monad (Backend m)
Monad (Backend m) =>
(forall a. IO a -> Backend m a) -> MonadIO (Backend m)
forall a. IO a -> Backend m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (Backend m)
forall (m :: * -> *) a. MonadIO m => IO a -> Backend m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Backend m a
liftIO :: forall a. IO a -> Backend m a
MonadIO, MonadReader BackendEnv, MonadError BackendError)

instance MonadTrans Backend where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Backend m a
lift m a
m = ReaderT BackendEnv (ExceptT BackendError m) a -> Backend m a
forall (m :: * -> *) a.
ReaderT BackendEnv (ExceptT BackendError m) a -> Backend m a
Backend (ExceptT BackendError m a
-> ReaderT BackendEnv (ExceptT BackendError m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT BackendEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT BackendError m a
 -> ReaderT BackendEnv (ExceptT BackendError m) a)
-> (m a -> ExceptT BackendError m a)
-> m a
-> ReaderT BackendEnv (ExceptT BackendError m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT BackendError m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT BackendError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT BackendEnv (ExceptT BackendError m) a)
-> m a -> ReaderT BackendEnv (ExceptT BackendError m) a
forall a b. (a -> b) -> a -> b
$ m a
m)

hoistBackend :: (forall x. m x -> n x) -> Backend m a -> Backend n a
hoistBackend :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
hoistBackend forall x. m x -> n x
f (Backend ReaderT BackendEnv (ExceptT BackendError m) a
m) =
  ReaderT BackendEnv (ExceptT BackendError n) a -> Backend n a
forall (m :: * -> *) a.
ReaderT BackendEnv (ExceptT BackendError m) a -> Backend m a
Backend ((ExceptT BackendError m a -> ExceptT BackendError n a)
-> ReaderT BackendEnv (ExceptT BackendError m) a
-> ReaderT BackendEnv (ExceptT BackendError n) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((m (Either BackendError a) -> n (Either BackendError a))
-> ExceptT BackendError m a -> ExceptT BackendError n a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either BackendError a) -> n (Either BackendError a)
forall x. m x -> n x
f) ReaderT BackendEnv (ExceptT BackendError m) a
m)

loadReferentType ::
  Codebase m Symbol Ann ->
  Referent ->
  Sqlite.Transaction (Maybe (Type Symbol Ann))
loadReferentType :: forall (m :: * -> *).
Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
loadReferentType Codebase m Symbol Ann
codebase = \case
  Referent.Ref TypeReference
r -> Codebase m Symbol Ann
-> TypeReference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> TypeReference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase m Symbol Ann
codebase TypeReference
r
  Referent.Con GConstructorReference TypeReference
r ConstructorType
_ -> GConstructorReference TypeReference
-> Transaction (Maybe (Type Symbol Ann))
getTypeOfConstructor GConstructorReference TypeReference
r
  where
    -- Mitchell wonders: why was this definition copied from Unison.Codebase?
    getTypeOfConstructor :: GConstructorReference TypeReference
-> Transaction (Maybe (Type Symbol Ann))
getTypeOfConstructor (ConstructorReference (Reference.DerivedId Id' Hash
r) ConstructorId
cid) = do
      Maybe (Decl Symbol Ann)
maybeDecl <- Codebase m Symbol Ann
-> Id' Hash -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase m Symbol Ann
codebase Id' Hash
r
      pure $ case Maybe (Decl Symbol Ann)
maybeDecl of
        Maybe (Decl Symbol Ann)
Nothing -> Maybe (Type Symbol Ann)
forall a. Maybe a
Nothing
        Just Decl Symbol Ann
decl -> DataDeclaration Symbol Ann
-> ConstructorId -> Maybe (Type Symbol Ann)
forall v a.
DataDeclaration v a -> ConstructorId -> Maybe (Type v a)
DD.typeOfConstructor ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> Decl Symbol Ann
-> DataDeclaration Symbol Ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
DD.toDataDecl DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall a. a -> a
id Decl Symbol Ann
decl) ConstructorId
cid
    getTypeOfConstructor GConstructorReference TypeReference
r =
      WatchKind -> Transaction (Maybe (Type Symbol Ann))
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> Transaction (Maybe (Type Symbol Ann)))
-> WatchKind -> Transaction (Maybe (Type Symbol Ann))
forall a b. (a -> b) -> a -> b
$
        WatchKind
"Don't know how to getTypeOfConstructor "
          WatchKind -> ShowS
forall a. [a] -> [a] -> [a]
++ GConstructorReference TypeReference -> WatchKind
forall a. Show a => a -> WatchKind
show GConstructorReference TypeReference
r

data TermEntry v a = TermEntry
  { forall v a. TermEntry v a -> Referent
termEntryReferent :: V2Referent.Referent,
    forall v a. TermEntry v a -> ShortHash
termEntryHash :: ShortHash,
    forall v a. TermEntry v a -> Name
termEntryName :: Name,
    forall v a. TermEntry v a -> Bool
termEntryConflicted :: Bool,
    forall v a. TermEntry v a -> Maybe (Type v a)
termEntryType :: Maybe (Type v a),
    forall v a. TermEntry v a -> TermTag
termEntryTag :: TermTag
  }
  deriving (TermEntry v a -> TermEntry v a -> Bool
(TermEntry v a -> TermEntry v a -> Bool)
-> (TermEntry v a -> TermEntry v a -> Bool) -> Eq (TermEntry v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
$c== :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
== :: TermEntry v a -> TermEntry v a -> Bool
$c/= :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
/= :: TermEntry v a -> TermEntry v a -> Bool
Eq, Eq (TermEntry v a)
Eq (TermEntry v a) =>
(TermEntry v a -> TermEntry v a -> Ordering)
-> (TermEntry v a -> TermEntry v a -> Bool)
-> (TermEntry v a -> TermEntry v a -> Bool)
-> (TermEntry v a -> TermEntry v a -> Bool)
-> (TermEntry v a -> TermEntry v a -> Bool)
-> (TermEntry v a -> TermEntry v a -> TermEntry v a)
-> (TermEntry v a -> TermEntry v a -> TermEntry v a)
-> Ord (TermEntry v a)
TermEntry v a -> TermEntry v a -> Bool
TermEntry v a -> TermEntry v a -> Ordering
TermEntry v a -> TermEntry v a -> TermEntry v a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v a. Var v => Eq (TermEntry v a)
forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
forall v a. Var v => TermEntry v a -> TermEntry v a -> Ordering
forall v a.
Var v =>
TermEntry v a -> TermEntry v a -> TermEntry v a
$ccompare :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Ordering
compare :: TermEntry v a -> TermEntry v a -> Ordering
$c< :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
< :: TermEntry v a -> TermEntry v a -> Bool
$c<= :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
<= :: TermEntry v a -> TermEntry v a -> Bool
$c> :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
> :: TermEntry v a -> TermEntry v a -> Bool
$c>= :: forall v a. Var v => TermEntry v a -> TermEntry v a -> Bool
>= :: TermEntry v a -> TermEntry v a -> Bool
$cmax :: forall v a.
Var v =>
TermEntry v a -> TermEntry v a -> TermEntry v a
max :: TermEntry v a -> TermEntry v a -> TermEntry v a
$cmin :: forall v a.
Var v =>
TermEntry v a -> TermEntry v a -> TermEntry v a
min :: TermEntry v a -> TermEntry v a -> TermEntry v a
Ord, Int -> TermEntry v a -> ShowS
[TermEntry v a] -> ShowS
TermEntry v a -> WatchKind
(Int -> TermEntry v a -> ShowS)
-> (TermEntry v a -> WatchKind)
-> ([TermEntry v a] -> ShowS)
-> Show (TermEntry v a)
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
forall v a. Show v => Int -> TermEntry v a -> ShowS
forall v a. Show v => [TermEntry v a] -> ShowS
forall v a. Show v => TermEntry v a -> WatchKind
$cshowsPrec :: forall v a. Show v => Int -> TermEntry v a -> ShowS
showsPrec :: Int -> TermEntry v a -> ShowS
$cshow :: forall v a. Show v => TermEntry v a -> WatchKind
show :: TermEntry v a -> WatchKind
$cshowList :: forall v a. Show v => [TermEntry v a] -> ShowS
showList :: [TermEntry v a] -> ShowS
Show, (forall x. TermEntry v a -> Rep (TermEntry v a) x)
-> (forall x. Rep (TermEntry v a) x -> TermEntry v a)
-> Generic (TermEntry v a)
forall x. Rep (TermEntry v a) x -> TermEntry v a
forall x. TermEntry v a -> Rep (TermEntry v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (TermEntry v a) x -> TermEntry v a
forall v a x. TermEntry v a -> Rep (TermEntry v a) x
$cfrom :: forall v a x. TermEntry v a -> Rep (TermEntry v a) x
from :: forall x. TermEntry v a -> Rep (TermEntry v a) x
$cto :: forall v a x. Rep (TermEntry v a) x -> TermEntry v a
to :: forall x. Rep (TermEntry v a) x -> TermEntry v a
Generic)

termEntryLabeledDependencies :: (Ord v) => TermEntry v a -> Set LD.LabeledDependency
termEntryLabeledDependencies :: forall v a. Ord v => TermEntry v a -> Set LabeledDependency
termEntryLabeledDependencies TermEntry {Maybe (Type v a)
$sel:termEntryType:TermEntry :: forall v a. TermEntry v a -> Maybe (Type v a)
termEntryType :: Maybe (Type v a)
termEntryType, Referent
$sel:termEntryReferent:TermEntry :: forall v a. TermEntry v a -> Referent
termEntryReferent :: Referent
termEntryReferent, TermTag
$sel:termEntryTag:TermEntry :: forall v a. TermEntry v a -> TermTag
termEntryTag :: TermTag
termEntryTag, Name
$sel:termEntryName:TermEntry :: forall v a. TermEntry v a -> Name
termEntryName :: Name
termEntryName} =
  (Type v a -> Set LabeledDependency)
-> Maybe (Type v a) -> Set LabeledDependency
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type v a -> Set LabeledDependency
forall v a. Ord v => Type v a -> Set LabeledDependency
Type.labeledDependencies Maybe (Type v a)
termEntryType
    Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> LabeledDependency -> Set LabeledDependency
forall a. a -> Set a
Set.singleton (Referent -> LabeledDependency
LD.TermReferent (ConstructorType -> Referent -> Referent
Cv.referent2to1UsingCT ConstructorType
ct Referent
termEntryReferent))
  where
    ct :: V2Referent.ConstructorType
    ct :: ConstructorType
ct = case TermTag
termEntryTag of
      ServerTypes.Constructor TypeTag
ServerTypes.Ability -> ConstructorType
V2Referent.EffectConstructor
      ServerTypes.Constructor TypeTag
ServerTypes.Data -> ConstructorType
V2Referent.DataConstructor
      TermTag
ServerTypes.Doc -> ConstructorType
V2Referent.DataConstructor
      TermTag
_ -> WatchKind -> ConstructorType
forall a. HasCallStack => WatchKind -> a
error (WatchKind -> ConstructorType) -> WatchKind -> ConstructorType
forall a b. (a -> b) -> a -> b
$ WatchKind
"termEntryLabeledDependencies: Term is not a constructor, but the referent was a constructor. Tag: " WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> TermTag -> WatchKind
forall a. Show a => a -> WatchKind
show TermTag
termEntryTag WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> WatchKind
" Name: " WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> WatchKind
forall a. Show a => a -> WatchKind
show Name
termEntryName WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> WatchKind
" Referent: " WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> Referent -> WatchKind
forall a. Show a => a -> WatchKind
show Referent
termEntryReferent

termEntryDisplayName :: TermEntry v a -> Text
termEntryDisplayName :: forall v a. TermEntry v a -> Text
termEntryDisplayName = (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith Name -> Text
Name.toText (HashQualified Name -> Text)
-> (TermEntry v a -> HashQualified Name) -> TermEntry v a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermEntry v a -> HashQualified Name
forall v a. TermEntry v a -> HashQualified Name
termEntryHQName

termEntryHQName :: TermEntry v a -> HQ'.HashQualified Name
termEntryHQName :: forall v a. TermEntry v a -> HashQualified Name
termEntryHQName TermEntry {Name
$sel:termEntryName:TermEntry :: forall v a. TermEntry v a -> Name
termEntryName :: Name
termEntryName, Bool
$sel:termEntryConflicted:TermEntry :: forall v a. TermEntry v a -> Bool
termEntryConflicted :: Bool
termEntryConflicted, ShortHash
$sel:termEntryHash:TermEntry :: forall v a. TermEntry v a -> ShortHash
termEntryHash :: ShortHash
termEntryHash} =
  if Bool
termEntryConflicted
    then Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified Name
termEntryName ShortHash
termEntryHash
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
termEntryName

data TypeEntry = TypeEntry
  { TypeEntry -> TypeReference
typeEntryReference :: Reference,
    TypeEntry -> ShortHash
typeEntryHash :: ShortHash,
    TypeEntry -> Name
typeEntryName :: Name,
    TypeEntry -> Bool
typeEntryConflicted :: Bool,
    TypeEntry -> TypeTag
typeEntryTag :: TypeTag
  }
  deriving (TypeEntry -> TypeEntry -> Bool
(TypeEntry -> TypeEntry -> Bool)
-> (TypeEntry -> TypeEntry -> Bool) -> Eq TypeEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeEntry -> TypeEntry -> Bool
== :: TypeEntry -> TypeEntry -> Bool
$c/= :: TypeEntry -> TypeEntry -> Bool
/= :: TypeEntry -> TypeEntry -> Bool
Eq, Eq TypeEntry
Eq TypeEntry =>
(TypeEntry -> TypeEntry -> Ordering)
-> (TypeEntry -> TypeEntry -> Bool)
-> (TypeEntry -> TypeEntry -> Bool)
-> (TypeEntry -> TypeEntry -> Bool)
-> (TypeEntry -> TypeEntry -> Bool)
-> (TypeEntry -> TypeEntry -> TypeEntry)
-> (TypeEntry -> TypeEntry -> TypeEntry)
-> Ord TypeEntry
TypeEntry -> TypeEntry -> Bool
TypeEntry -> TypeEntry -> Ordering
TypeEntry -> TypeEntry -> TypeEntry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeEntry -> TypeEntry -> Ordering
compare :: TypeEntry -> TypeEntry -> Ordering
$c< :: TypeEntry -> TypeEntry -> Bool
< :: TypeEntry -> TypeEntry -> Bool
$c<= :: TypeEntry -> TypeEntry -> Bool
<= :: TypeEntry -> TypeEntry -> Bool
$c> :: TypeEntry -> TypeEntry -> Bool
> :: TypeEntry -> TypeEntry -> Bool
$c>= :: TypeEntry -> TypeEntry -> Bool
>= :: TypeEntry -> TypeEntry -> Bool
$cmax :: TypeEntry -> TypeEntry -> TypeEntry
max :: TypeEntry -> TypeEntry -> TypeEntry
$cmin :: TypeEntry -> TypeEntry -> TypeEntry
min :: TypeEntry -> TypeEntry -> TypeEntry
Ord, Int -> TypeEntry -> ShowS
[TypeEntry] -> ShowS
TypeEntry -> WatchKind
(Int -> TypeEntry -> ShowS)
-> (TypeEntry -> WatchKind)
-> ([TypeEntry] -> ShowS)
-> Show TypeEntry
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeEntry -> ShowS
showsPrec :: Int -> TypeEntry -> ShowS
$cshow :: TypeEntry -> WatchKind
show :: TypeEntry -> WatchKind
$cshowList :: [TypeEntry] -> ShowS
showList :: [TypeEntry] -> ShowS
Show, (forall x. TypeEntry -> Rep TypeEntry x)
-> (forall x. Rep TypeEntry x -> TypeEntry) -> Generic TypeEntry
forall x. Rep TypeEntry x -> TypeEntry
forall x. TypeEntry -> Rep TypeEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeEntry -> Rep TypeEntry x
from :: forall x. TypeEntry -> Rep TypeEntry x
$cto :: forall x. Rep TypeEntry x -> TypeEntry
to :: forall x. Rep TypeEntry x -> TypeEntry
Generic)

typeEntryLabeledDependencies :: TypeEntry -> Set LD.LabeledDependency
typeEntryLabeledDependencies :: TypeEntry -> Set LabeledDependency
typeEntryLabeledDependencies TypeEntry {TypeReference
$sel:typeEntryReference:TypeEntry :: TypeEntry -> TypeReference
typeEntryReference :: TypeReference
typeEntryReference} =
  LabeledDependency -> Set LabeledDependency
forall a. a -> Set a
Set.singleton (TypeReference -> LabeledDependency
LD.TypeReference TypeReference
typeEntryReference)

typeEntryDisplayName :: TypeEntry -> Text
typeEntryDisplayName :: TypeEntry -> Text
typeEntryDisplayName = (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith Name -> Text
Name.toText (HashQualified Name -> Text)
-> (TypeEntry -> HashQualified Name) -> TypeEntry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeEntry -> HashQualified Name
typeEntryHQName

typeEntryHQName :: TypeEntry -> HQ'.HashQualified Name
typeEntryHQName :: TypeEntry -> HashQualified Name
typeEntryHQName TypeEntry {Name
$sel:typeEntryName:TypeEntry :: TypeEntry -> Name
typeEntryName :: Name
typeEntryName, Bool
$sel:typeEntryConflicted:TypeEntry :: TypeEntry -> Bool
typeEntryConflicted :: Bool
typeEntryConflicted, TypeReference
$sel:typeEntryReference:TypeEntry :: TypeEntry -> TypeReference
typeEntryReference :: TypeReference
typeEntryReference} =
  if Bool
typeEntryConflicted
    then Name -> ShortHash -> HashQualified Name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified Name
typeEntryName (TypeReference -> ShortHash
Reference.toShortHash TypeReference
typeEntryReference)
    else Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
typeEntryName

data FoundRef
  = FoundTermRef Referent
  | FoundTypeRef Reference
  deriving (FoundRef -> FoundRef -> Bool
(FoundRef -> FoundRef -> Bool)
-> (FoundRef -> FoundRef -> Bool) -> Eq FoundRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FoundRef -> FoundRef -> Bool
== :: FoundRef -> FoundRef -> Bool
$c/= :: FoundRef -> FoundRef -> Bool
/= :: FoundRef -> FoundRef -> Bool
Eq, Eq FoundRef
Eq FoundRef =>
(FoundRef -> FoundRef -> Ordering)
-> (FoundRef -> FoundRef -> Bool)
-> (FoundRef -> FoundRef -> Bool)
-> (FoundRef -> FoundRef -> Bool)
-> (FoundRef -> FoundRef -> Bool)
-> (FoundRef -> FoundRef -> FoundRef)
-> (FoundRef -> FoundRef -> FoundRef)
-> Ord FoundRef
FoundRef -> FoundRef -> Bool
FoundRef -> FoundRef -> Ordering
FoundRef -> FoundRef -> FoundRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FoundRef -> FoundRef -> Ordering
compare :: FoundRef -> FoundRef -> Ordering
$c< :: FoundRef -> FoundRef -> Bool
< :: FoundRef -> FoundRef -> Bool
$c<= :: FoundRef -> FoundRef -> Bool
<= :: FoundRef -> FoundRef -> Bool
$c> :: FoundRef -> FoundRef -> Bool
> :: FoundRef -> FoundRef -> Bool
$c>= :: FoundRef -> FoundRef -> Bool
>= :: FoundRef -> FoundRef -> Bool
$cmax :: FoundRef -> FoundRef -> FoundRef
max :: FoundRef -> FoundRef -> FoundRef
$cmin :: FoundRef -> FoundRef -> FoundRef
min :: FoundRef -> FoundRef -> FoundRef
Ord, Int -> FoundRef -> ShowS
[FoundRef] -> ShowS
FoundRef -> WatchKind
(Int -> FoundRef -> ShowS)
-> (FoundRef -> WatchKind)
-> ([FoundRef] -> ShowS)
-> Show FoundRef
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FoundRef -> ShowS
showsPrec :: Int -> FoundRef -> ShowS
$cshow :: FoundRef -> WatchKind
show :: FoundRef -> WatchKind
$cshowList :: [FoundRef] -> ShowS
showList :: [FoundRef] -> ShowS
Show, (forall x. FoundRef -> Rep FoundRef x)
-> (forall x. Rep FoundRef x -> FoundRef) -> Generic FoundRef
forall x. Rep FoundRef x -> FoundRef
forall x. FoundRef -> Rep FoundRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FoundRef -> Rep FoundRef x
from :: forall x. FoundRef -> Rep FoundRef x
$cto :: forall x. Rep FoundRef x -> FoundRef
to :: forall x. Rep FoundRef x -> FoundRef
Generic)

-- After finding a search results with fuzzy find we do some post processing to
-- refine the result:
--  * Sort:
--      we sort both on the FZF score and the number of segments in the FQN
--      preferring shorter FQNs over longer. This helps with things like forks
--      of base.
--  * Dedupe:
--      we dedupe on the found refs to avoid having several rows of a
--      definition with different names in the result set.
fuzzyFind ::
  Names ->
  String ->
  [(FZF.Alignment, UnisonName, [FoundRef])]
fuzzyFind :: Names -> WatchKind -> [(Alignment, Text, [FoundRef])]
fuzzyFind Names
printNames WatchKind
query =
  let fzfNames :: [(Alignment, Name, Set (Either Referent TypeReference))]
fzfNames =
        (Name -> Text)
-> [WatchKind]
-> Names
-> [(Alignment, Name, Set (Either Referent TypeReference))]
Names.fuzzyFind Name -> Text
Name.toText (WatchKind -> [WatchKind]
words WatchKind
query) Names
printNames

      toFoundRef :: (Alignment, Text, Set (Either Referent TypeReference))
-> (Alignment, Text, [FoundRef])
toFoundRef =
        (Set (Either Referent TypeReference) -> [FoundRef])
-> (Alignment, Text, Set (Either Referent TypeReference))
-> (Alignment, Text, [FoundRef])
forall a b.
(a -> b) -> (Alignment, Text, a) -> (Alignment, Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either Referent TypeReference -> FoundRef)
-> [Either Referent TypeReference] -> [FoundRef]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Referent -> FoundRef)
-> (TypeReference -> FoundRef)
-> Either Referent TypeReference
-> FoundRef
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Referent -> FoundRef
FoundTermRef TypeReference -> FoundRef
FoundTypeRef) ([Either Referent TypeReference] -> [FoundRef])
-> (Set (Either Referent TypeReference)
    -> [Either Referent TypeReference])
-> Set (Either Referent TypeReference)
-> [FoundRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Referent TypeReference)
-> [Either Referent TypeReference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)

      -- Remove dupes based on refs
      dedupe :: [(a, b, [FoundRef])] -> [(a, b, [FoundRef])]
dedupe =
        ((a, b, [FoundRef]) -> [FoundRef])
-> [(a, b, [FoundRef])] -> [(a, b, [FoundRef])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (\(a
_, b
_, [FoundRef]
refs) -> [FoundRef]
refs)

      -- Prefer shorter FQNs
      rank :: (Alignment, Text, c) -> (Int, Int)
rank (Alignment
alignment, Text
name, c
_) =
        ( Name -> Int
Name.countSegments (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
name),
          Int -> Int
forall a. Num a => a -> a
negate (Alignment -> Int
FZF.score Alignment
alignment)
        )

      refine :: [(Alignment, Text, [FoundRef])] -> [(Alignment, Text, [FoundRef])]
refine =
        [(Alignment, Text, [FoundRef])] -> [(Alignment, Text, [FoundRef])]
forall {a} {b}. [(a, b, [FoundRef])] -> [(a, b, [FoundRef])]
dedupe ([(Alignment, Text, [FoundRef])]
 -> [(Alignment, Text, [FoundRef])])
-> ([(Alignment, Text, [FoundRef])]
    -> [(Alignment, Text, [FoundRef])])
-> [(Alignment, Text, [FoundRef])]
-> [(Alignment, Text, [FoundRef])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Alignment, Text, [FoundRef]) -> (Int, Int))
-> [(Alignment, Text, [FoundRef])]
-> [(Alignment, Text, [FoundRef])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Alignment, Text, [FoundRef]) -> (Int, Int)
forall {c}. (Alignment, Text, c) -> (Int, Int)
rank
   in [(Alignment, Text, [FoundRef])] -> [(Alignment, Text, [FoundRef])]
refine ([(Alignment, Text, [FoundRef])]
 -> [(Alignment, Text, [FoundRef])])
-> [(Alignment, Text, [FoundRef])]
-> [(Alignment, Text, [FoundRef])]
forall a b. (a -> b) -> a -> b
$ (Alignment, Text, Set (Either Referent TypeReference))
-> (Alignment, Text, [FoundRef])
toFoundRef ((Alignment, Text, Set (Either Referent TypeReference))
 -> (Alignment, Text, [FoundRef]))
-> ((Alignment, Name, Set (Either Referent TypeReference))
    -> (Alignment, Text, Set (Either Referent TypeReference)))
-> (Alignment, Name, Set (Either Referent TypeReference))
-> (Alignment, Text, [FoundRef])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Alignment, Name, Set (Either Referent TypeReference))
  (Alignment, Text, Set (Either Referent TypeReference))
  Name
  Text
-> (Name -> Text)
-> (Alignment, Name, Set (Either Referent TypeReference))
-> (Alignment, Text, Set (Either Referent TypeReference))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Alignment, Name, Set (Either Referent TypeReference))
  (Alignment, Text, Set (Either Referent TypeReference))
  Name
  Text
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Alignment, Name, Set (Either Referent TypeReference))
  (Alignment, Text, Set (Either Referent TypeReference))
  Name
  Text
_2 Name -> Text
Name.toText ((Alignment, Name, Set (Either Referent TypeReference))
 -> (Alignment, Text, [FoundRef]))
-> [(Alignment, Name, Set (Either Referent TypeReference))]
-> [(Alignment, Text, [FoundRef])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Alignment, Name, Set (Either Referent TypeReference))]
fzfNames

-- List the immediate children of a namespace
lsAtPath ::
  (MonadIO m) =>
  Codebase m Symbol Ann ->
  -- The root to follow the path from.
  V2Branch.Branch Sqlite.Transaction ->
  -- Path from the root to the branch to 'ls'
  Path.Absolute ->
  m [ShallowListEntry Symbol Ann]
lsAtPath :: forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> Branch Transaction
-> Absolute
-> m [ShallowListEntry Symbol Ann]
lsAtPath Codebase m Symbol Ann
codebase Branch Transaction
rootBranch Absolute
absPath = do
  Branch Transaction
b <- Codebase m Symbol Ann
-> Transaction (Branch Transaction) -> m (Branch Transaction)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m Symbol Ann
codebase (Path -> Branch Transaction -> Transaction (Branch Transaction)
Codebase.getShallowBranchAtPath (Absolute -> Path
Path.unabsolute Absolute
absPath) Branch Transaction
rootBranch)
  Codebase m Symbol Ann
-> Branch Transaction -> m [ShallowListEntry Symbol Ann]
forall (m :: * -> *) (n :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> Branch n -> m [ShallowListEntry Symbol Ann]
lsBranch Codebase m Symbol Ann
codebase Branch Transaction
b

findDocInBranch ::
  Set NameSegment ->
  V2Branch.Branch m ->
  Maybe TermReference
findDocInBranch :: forall (m :: * -> *).
Set NameSegment -> Branch m -> Maybe TypeReference
findDocInBranch Set NameSegment
names Branch m
namespaceBranch =
  let -- choose the first term (among conflicted terms) matching any of these names, in this order.
      -- we might later want to return all of them to let the front end decide
      toCheck :: [NameSegment]
toCheck = Set NameSegment -> [NameSegment]
forall a. Set a -> [a]
Set.toList Set NameSegment
names
      readmeRef :: Maybe Reference
      readmeRef :: Maybe TypeReference
readmeRef = [TypeReference] -> Maybe TypeReference
forall a. [a] -> Maybe a
listToMaybe ([TypeReference] -> Maybe TypeReference)
-> [TypeReference] -> Maybe TypeReference
forall a b. (a -> b) -> a -> b
$ do
        NameSegment
name <- [NameSegment]
toCheck
        Map Referent (m MdValues)
term <- Maybe (Map Referent (m MdValues)) -> [Map Referent (m MdValues)]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe (Map Referent (m MdValues)) -> [Map Referent (m MdValues)])
-> Maybe (Map Referent (m MdValues)) -> [Map Referent (m MdValues)]
forall a b. (a -> b) -> a -> b
$ NameSegment
-> Map NameSegment (Map Referent (m MdValues))
-> Maybe (Map Referent (m MdValues))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
name Map NameSegment (Map Referent (m MdValues))
termsMap
        Referent
k <- Map Referent (m MdValues) -> [Referent]
forall k a. Map k a -> [k]
Map.keys Map Referent (m MdValues)
term
        case Referent
k of
          -- This shouldn't ever happen unless someone puts a non-doc as their readme.
          V2Referent.Con {} -> [TypeReference]
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty
          V2Referent.Ref TypeReference
ref -> TypeReference -> [TypeReference]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeReference -> [TypeReference])
-> TypeReference -> [TypeReference]
forall a b. (a -> b) -> a -> b
$ TypeReference -> TypeReference
Cv.reference2to1 TypeReference
ref
        where
          termsMap :: Map NameSegment (Map Referent (m MdValues))
termsMap = Branch m -> Map NameSegment (Map Referent (m MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
V2Branch.terms Branch m
namespaceBranch
   in Maybe TypeReference
readmeRef

isDoc :: Codebase m Symbol Ann -> Referent.Referent -> Sqlite.Transaction Bool
isDoc :: forall (m :: * -> *).
Codebase m Symbol Ann -> Referent -> Transaction Bool
isDoc Codebase m Symbol Ann
codebase Referent
ref = do
  Maybe (Type Symbol Ann)
ot <- Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
loadReferentType Codebase m Symbol Ann
codebase Referent
ref
  pure $ Maybe (Type Symbol Ann) -> Bool
forall v loc. (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isDoc' Maybe (Type Symbol Ann)
ot

isDoc' :: (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isDoc' :: forall v loc. (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isDoc' Maybe (Type v loc)
typeOfTerm = do
  -- A term is a doc if its type conforms to the `Doc` type.
  case Maybe (Type v loc)
typeOfTerm of
    Just Type v loc
t ->
      Type v loc -> Type v loc -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type v loc
t Type v loc
forall v a. (Ord v, Monoid a) => Type v a
doc1Type
        Bool -> Bool -> Bool
|| Type v loc -> Type v loc -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type v loc
t Type v loc
forall v a. (Ord v, Monoid a) => Type v a
doc2Type
    Maybe (Type v loc)
Nothing -> Bool
False

doc1Type :: (Ord v, Monoid a) => Type v a
doc1Type :: forall v a. (Ord v, Monoid a) => Type v a
doc1Type = a -> TypeReference -> Type v a
forall v a. Ord v => a -> TypeReference -> Type v a
Type.ref a
forall a. Monoid a => a
mempty TypeReference
Decls.docRef

doc2Type :: (Ord v, Monoid a) => Type v a
doc2Type :: forall v a. (Ord v, Monoid a) => Type v a
doc2Type = a -> TypeReference -> Type v a
forall v a. Ord v => a -> TypeReference -> Type v a
Type.ref a
forall a. Monoid a => a
mempty TypeReference
DD.doc2Ref

isTestResultList :: forall v a. (Var v, Monoid a) => Maybe (Type v a) -> Bool
isTestResultList :: forall v loc. (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isTestResultList Maybe (Type v a)
typ = case Maybe (Type v a)
typ of
  Maybe (Type v a)
Nothing -> Bool
False
  Just Type v a
t -> Type v a -> Type v a -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type v a
t Type v a
forall v a. (Ord v, Monoid a) => Type v a
resultListType

resultListType :: (Ord v, Monoid a) => Type v a
resultListType :: forall v a. (Ord v, Monoid a) => Type v a
resultListType = a -> Type v a -> Type v a -> Type v a
forall v a. Ord v => a -> Type v a -> Type v a -> Type v a
Type.app a
forall a. Monoid a => a
mempty (a -> Type v a
forall v a. Ord v => a -> Type v a
Type.list a
forall a. Monoid a => a
mempty) (a -> TypeReference -> Type v a
forall v a. Ord v => a -> TypeReference -> Type v a
Type.ref a
forall a. Monoid a => a
mempty TypeReference
Decls.testResultRef)

termListEntry ::
  (MonadIO m) =>
  Codebase m Symbol Ann ->
  ExactName Name V2Referent.Referent ->
  m (TermEntry Symbol Ann)
termListEntry :: forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> ExactName Name Referent -> m (TermEntry Symbol Ann)
termListEntry Codebase m Symbol Ann
codebase (ExactName Name
name Referent
ref) = do
  Maybe (Type Symbol Ann)
ot <- Codebase m Symbol Ann
-> Transaction (Maybe (Type Symbol Ann))
-> m (Maybe (Type Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m Symbol Ann
codebase (Transaction (Maybe (Type Symbol Ann))
 -> m (Maybe (Type Symbol Ann)))
-> Transaction (Maybe (Type Symbol Ann))
-> m (Maybe (Type Symbol Ann))
forall a b. (a -> b) -> a -> b
$ do
    Referent
v1Referent <- (TypeReference -> Transaction ConstructorType)
-> Referent -> Transaction Referent
forall (m :: * -> *).
Applicative m =>
(TypeReference -> m ConstructorType) -> Referent -> m Referent
Cv.referent2to1 (Codebase m Symbol Ann
-> TypeReference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
Codebase.getDeclType Codebase m Symbol Ann
codebase) Referent
ref
    Maybe (Type Symbol Ann)
ot <- Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
loadReferentType Codebase m Symbol Ann
codebase Referent
v1Referent
    pure (Maybe (Type Symbol Ann)
ot)
  TermTag
tag <- Codebase m Symbol Ann
-> Referent -> Maybe (Type Symbol Ann) -> m TermTag
forall v (m :: * -> *) a.
(Var v, MonadIO m) =>
Codebase m v a -> Referent -> Maybe (Type v Ann) -> m TermTag
getTermTag Codebase m Symbol Ann
codebase Referent
ref Maybe (Type Symbol Ann)
ot
  pure $
    TermEntry
      { $sel:termEntryReferent:TermEntry :: Referent
termEntryReferent = Referent
ref,
        $sel:termEntryName:TermEntry :: Name
termEntryName = Name
name,
        $sel:termEntryType:TermEntry :: Maybe (Type Symbol Ann)
termEntryType = Maybe (Type Symbol Ann)
ot,
        $sel:termEntryTag:TermEntry :: TermTag
termEntryTag = TermTag
tag,
        -- See typeEntryConflicted
        $sel:termEntryConflicted:TermEntry :: Bool
termEntryConflicted = Bool
False,
        $sel:termEntryHash:TermEntry :: ShortHash
termEntryHash = Maybe Int -> Referent -> ShortHash
Cv.referent2toshorthash1 Maybe Int
forall a. Maybe a
Nothing Referent
ref
      }

getTermTag ::
  (Var v, MonadIO m) =>
  Codebase m v a ->
  V2Referent.Referent ->
  Maybe (Type v Ann) ->
  m TermTag
getTermTag :: forall v (m :: * -> *) a.
(Var v, MonadIO m) =>
Codebase m v a -> Referent -> Maybe (Type v Ann) -> m TermTag
getTermTag Codebase m v a
codebase Referent
r Maybe (Type v Ann)
sig = do
  -- A term is a doc if its type conforms to the `Doc` type.
  let isDoc :: Bool
isDoc = Maybe (Type v Ann) -> Bool
forall v loc. (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isDoc' Maybe (Type v Ann)
sig
  -- A term is a test if it has the type [test.Result]
  let isTest :: Bool
isTest = case Maybe (Type v Ann)
sig of
        Just Type v Ann
t ->
          Type v Ann -> Type v Ann -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type v Ann
t (Ann -> Type v Ann
forall v a. Ord v => a -> Type v a
Decls.testResultListType Ann
forall a. Monoid a => a
mempty)
        Maybe (Type v Ann)
Nothing -> Bool
False
  Maybe ConstructorType
constructorType <- case Referent
r of
    V2Referent.Ref {} -> Maybe ConstructorType -> m (Maybe ConstructorType)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConstructorType
forall a. Maybe a
Nothing
    V2Referent.Con TypeReference
ref ConstructorId
_ -> ConstructorType -> Maybe ConstructorType
forall a. a -> Maybe a
Just (ConstructorType -> Maybe ConstructorType)
-> m ConstructorType -> m (Maybe ConstructorType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v a -> Transaction ConstructorType -> m ConstructorType
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase (Codebase m v a -> TypeReference -> Transaction ConstructorType
forall (m :: * -> *) v a.
Codebase m v a -> TypeReference -> Transaction ConstructorType
Codebase.getDeclType Codebase m v a
codebase TypeReference
ref)
  pure $
    if
      | Bool
isDoc -> TermTag
Doc
      | Bool
isTest -> TermTag
Test
      | Just ConstructorType
CT.Effect <- Maybe ConstructorType
constructorType -> TypeTag -> TermTag
Constructor TypeTag
Ability
      | Just ConstructorType
CT.Data <- Maybe ConstructorType
constructorType -> TypeTag -> TermTag
Constructor TypeTag
Data
      | Bool
otherwise -> TermTag
Plain

getTypeTag ::
  (Var v) =>
  Codebase m v Ann ->
  Reference ->
  Sqlite.Transaction TypeTag
getTypeTag :: forall v (m :: * -> *).
Var v =>
Codebase m v Ann -> TypeReference -> Transaction TypeTag
getTypeTag Codebase m v Ann
codebase TypeReference
r = do
  case TypeReference -> Maybe (Id' Hash)
Reference.toId TypeReference
r of
    Just Id' Hash
r -> do
      Maybe (Decl v Ann)
decl <- Codebase m v Ann -> Id' Hash -> Transaction (Maybe (Decl v Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase m v Ann
codebase Id' Hash
r
      pure $ case Maybe (Decl v Ann)
decl of
        Just (Left EffectDeclaration v Ann
_) -> TypeTag
Ability
        Maybe (Decl v Ann)
_ -> TypeTag
Data
    Maybe (Id' Hash)
_ -> TypeTag -> Transaction TypeTag
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if TypeReference -> Set TypeReference -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReference
r Set TypeReference
Type.builtinAbilities then TypeTag
Ability else TypeTag
Data)

typeListEntry ::
  (Var v) =>
  Codebase m v Ann ->
  ExactName Name Reference ->
  Sqlite.Transaction TypeEntry
typeListEntry :: forall v (m :: * -> *).
Var v =>
Codebase m v Ann
-> ExactName Name TypeReference -> Transaction TypeEntry
typeListEntry Codebase m v Ann
codebase (ExactName Name
name TypeReference
ref) = do
  Int
hashLength <- Transaction Int
Codebase.hashLength
  TypeTag
tag <- Codebase m v Ann -> TypeReference -> Transaction TypeTag
forall v (m :: * -> *).
Var v =>
Codebase m v Ann -> TypeReference -> Transaction TypeTag
getTypeTag Codebase m v Ann
codebase TypeReference
ref
  pure $
    TypeEntry
      { $sel:typeEntryReference:TypeEntry :: TypeReference
typeEntryReference = TypeReference
ref,
        $sel:typeEntryName:TypeEntry :: Name
typeEntryName = Name
name,
        -- Mitchell says: at one point this was implemented incorrectly, but fixing it seemed like more trouble than it
        -- was worth, because we don't really care about conflicted things anymore. Ditto for termEntryConflicted.
        $sel:typeEntryConflicted:TypeEntry :: Bool
typeEntryConflicted = Bool
False,
        $sel:typeEntryTag:TypeEntry :: TypeTag
typeEntryTag = TypeTag
tag,
        $sel:typeEntryHash:TypeEntry :: ShortHash
typeEntryHash = Int -> ShortHash -> ShortHash
SH.shortenTo Int
hashLength (ShortHash -> ShortHash) -> ShortHash -> ShortHash
forall a b. (a -> b) -> a -> b
$ TypeReference -> ShortHash
Reference.toShortHash TypeReference
ref
      }

typeDeclHeader ::
  forall v m.
  (Var v) =>
  Codebase m v Ann ->
  PPE.PrettyPrintEnv ->
  Reference ->
  Sqlite.Transaction (DisplayObject Syntax.SyntaxText Syntax.SyntaxText)
typeDeclHeader :: forall v (m :: * -> *).
Var v =>
Codebase m v Ann
-> PrettyPrintEnv
-> TypeReference
-> Transaction (DisplayObject SyntaxText SyntaxText)
typeDeclHeader Codebase m v Ann
code PrettyPrintEnv
ppe TypeReference
r = case TypeReference -> Maybe (Id' Hash)
Reference.toId TypeReference
r of
  Just Id' Hash
rid ->
    Codebase m v Ann -> Id' Hash -> Transaction (Maybe (Decl v Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase m v Ann
code Id' Hash
rid Transaction (Maybe (Decl v Ann))
-> (Maybe (Decl v Ann) -> DisplayObject SyntaxText SyntaxText)
-> Transaction (DisplayObject SyntaxText SyntaxText)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe (Decl v Ann)
Nothing -> ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
DisplayObject.MissingObject (TypeReference -> ShortHash
Reference.toShortHash TypeReference
r)
      Just Decl v Ann
decl ->
        SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. a -> DisplayObject b a
DisplayObject.UserObject (SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> SyntaxText -> DisplayObject SyntaxText SyntaxText
forall a b. (a -> b) -> a -> b
$
          Element TypeReference -> Element
Syntax.convertElement
            (Element TypeReference -> Element) -> SyntaxText -> SyntaxText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
defaultWidth (HashQualified Name -> Decl v Ann -> Pretty SyntaxText
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty SyntaxText
DeclPrinter.prettyDeclHeader HashQualified Name
name Decl v Ann
decl)
  Maybe (Id' Hash)
Nothing ->
    DisplayObject SyntaxText SyntaxText
-> Transaction (DisplayObject SyntaxText SyntaxText)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. b -> DisplayObject b a
DisplayObject.BuiltinObject (PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName PrettyPrintEnv
ppe TypeReference
r))
  where
    name :: HashQualified Name
name = PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe TypeReference
r

formatTypeName :: PPE.PrettyPrintEnv -> Reference -> Syntax.SyntaxText
formatTypeName :: PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName PrettyPrintEnv
ppe =
  (Element TypeReference -> Element) -> SyntaxText -> SyntaxText
forall a b. (a -> b) -> AnnotatedText a -> AnnotatedText b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element TypeReference -> Element
Syntax.convertElement (SyntaxText -> SyntaxText)
-> (TypeReference -> SyntaxText) -> TypeReference -> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName' PrettyPrintEnv
ppe

formatTypeName' :: PPE.PrettyPrintEnv -> Reference -> SyntaxText
formatTypeName' :: PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName' PrettyPrintEnv
ppe TypeReference
r =
  Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Pretty s -> s
Pretty.renderUnbroken
    (Pretty SyntaxText -> SyntaxText)
-> (HashQualified Name -> Pretty SyntaxText)
-> HashQualified Name
-> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty SyntaxText -> Pretty SyntaxText)
-> HashQualified Name -> Pretty SyntaxText
forall s.
IsString s =>
(Pretty s -> Pretty s) -> HashQualified Name -> Pretty s
NP.styleHashQualified Pretty SyntaxText -> Pretty SyntaxText
forall a. a -> a
id
    (HashQualified Name -> SyntaxText)
-> HashQualified Name -> SyntaxText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe TypeReference
r

termEntryToNamedTerm ::
  (Var v) => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
termEntryToNamedTerm :: forall v a.
Var v =>
PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
termEntryToNamedTerm PrettyPrintEnv
ppe Maybe Width
typeWidth te :: TermEntry v a
te@TermEntry {$sel:termEntryType:TermEntry :: forall v a. TermEntry v a -> Maybe (Type v a)
termEntryType = Maybe (Type v a)
mayType, $sel:termEntryTag:TermEntry :: forall v a. TermEntry v a -> TermTag
termEntryTag = TermTag
tag, ShortHash
$sel:termEntryHash:TermEntry :: forall v a. TermEntry v a -> ShortHash
termEntryHash :: ShortHash
termEntryHash} =
  NamedTerm
    { $sel:termName:NamedTerm :: HashQualified Name
termName = TermEntry v a -> HashQualified Name
forall v a. TermEntry v a -> HashQualified Name
termEntryHQName TermEntry v a
te,
      $sel:termHash:NamedTerm :: ShortHash
termHash = ShortHash
termEntryHash,
      $sel:termType:NamedTerm :: Maybe SyntaxText
termType = PrettyPrintEnv -> Width -> Type v a -> SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType PrettyPrintEnv
ppe (Maybe Width -> Width
mayDefaultWidth Maybe Width
typeWidth) (Type v a -> SyntaxText) -> Maybe (Type v a) -> Maybe SyntaxText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Type v a)
mayType,
      $sel:termTag:NamedTerm :: TermTag
termTag = TermTag
tag
    }

typeEntryToNamedType :: TypeEntry -> NamedType
typeEntryToNamedType :: TypeEntry -> NamedType
typeEntryToNamedType te :: TypeEntry
te@TypeEntry {TypeTag
$sel:typeEntryTag:TypeEntry :: TypeEntry -> TypeTag
typeEntryTag :: TypeTag
typeEntryTag, ShortHash
$sel:typeEntryHash:TypeEntry :: TypeEntry -> ShortHash
typeEntryHash :: ShortHash
typeEntryHash} =
  NamedType
    { $sel:typeName:NamedType :: HashQualified Name
typeName = TypeEntry -> HashQualified Name
typeEntryHQName (TypeEntry -> HashQualified Name)
-> TypeEntry -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TypeEntry
te,
      $sel:typeHash:NamedType :: ShortHash
typeHash = ShortHash
typeEntryHash,
      $sel:typeTag:NamedType :: TypeTag
typeTag = TypeTag
typeEntryTag
    }

-- | Find all definitions and children reachable from the given 'V2Branch.Branch',
lsBranch ::
  (MonadIO m) =>
  Codebase m Symbol Ann ->
  V2Branch.Branch n ->
  m [ShallowListEntry Symbol Ann]
lsBranch :: forall (m :: * -> *) (n :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> Branch n -> m [ShallowListEntry Symbol Ann]
lsBranch Codebase m Symbol Ann
codebase Branch n
b0 = do
  let flattenRefs :: Map NameSegment (Map ref v) -> [(ref, NameSegment)]
      flattenRefs :: forall ref v. Map NameSegment (Map ref v) -> [(ref, NameSegment)]
flattenRefs Map NameSegment (Map ref v)
m = do
        (NameSegment
ns, Map ref v
refs) <- Map NameSegment (Map ref v) -> [(NameSegment, Map ref v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment (Map ref v)
m
        ref
r <- Map ref v -> [ref]
forall k a. Map k a -> [k]
Map.keys Map ref v
refs
        pure (ref
r, NameSegment
ns)
  [ShallowListEntry Symbol Ann]
termEntries <- [(Referent, NameSegment)]
-> ((Referent, NameSegment) -> m (ShallowListEntry Symbol Ann))
-> m [ShallowListEntry Symbol Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map NameSegment (Map Referent (n MdValues))
-> [(Referent, NameSegment)]
forall ref v. Map NameSegment (Map ref v) -> [(ref, NameSegment)]
flattenRefs (Map NameSegment (Map Referent (n MdValues))
 -> [(Referent, NameSegment)])
-> Map NameSegment (Map Referent (n MdValues))
-> [(Referent, NameSegment)]
forall a b. (a -> b) -> a -> b
$ Branch n -> Map NameSegment (Map Referent (n MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
V2Branch.terms Branch n
b0) \(Referent
r, NameSegment
ns) -> do
    TermEntry Symbol Ann -> ShallowListEntry Symbol Ann
forall v a. TermEntry v a -> ShallowListEntry v a
ShallowTermEntry (TermEntry Symbol Ann -> ShallowListEntry Symbol Ann)
-> m (TermEntry Symbol Ann) -> m (ShallowListEntry Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> ExactName Name Referent -> m (TermEntry Symbol Ann)
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> ExactName Name Referent -> m (TermEntry Symbol Ann)
termListEntry Codebase m Symbol Ann
codebase (Name -> Referent -> ExactName Name Referent
forall name ref. name -> ref -> ExactName name ref
ExactName (NameSegment -> Name
Name.fromSegment NameSegment
ns) Referent
r)
  [ShallowListEntry Symbol Ann]
typeEntries <-
    Codebase m Symbol Ann
-> Transaction [ShallowListEntry Symbol Ann]
-> m [ShallowListEntry Symbol Ann]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m Symbol Ann
codebase do
      [(TypeReference, NameSegment)]
-> ((TypeReference, NameSegment)
    -> Transaction (ShallowListEntry Symbol Ann))
-> Transaction [ShallowListEntry Symbol Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map NameSegment (Map TypeReference (n MdValues))
-> [(TypeReference, NameSegment)]
forall ref v. Map NameSegment (Map ref v) -> [(ref, NameSegment)]
flattenRefs (Map NameSegment (Map TypeReference (n MdValues))
 -> [(TypeReference, NameSegment)])
-> Map NameSegment (Map TypeReference (n MdValues))
-> [(TypeReference, NameSegment)]
forall a b. (a -> b) -> a -> b
$ Branch n -> Map NameSegment (Map TypeReference (n MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map TypeReference (m MdValues))
V2Branch.types Branch n
b0) \(TypeReference
r, NameSegment
ns) -> do
        let v1Ref :: TypeReference
v1Ref = TypeReference -> TypeReference
Cv.reference2to1 TypeReference
r
        TypeEntry -> ShallowListEntry Symbol Ann
forall v a. TypeEntry -> ShallowListEntry v a
ShallowTypeEntry (TypeEntry -> ShallowListEntry Symbol Ann)
-> Transaction TypeEntry
-> Transaction (ShallowListEntry Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> ExactName Name TypeReference -> Transaction TypeEntry
forall v (m :: * -> *).
Var v =>
Codebase m v Ann
-> ExactName Name TypeReference -> Transaction TypeEntry
typeListEntry Codebase m Symbol Ann
codebase (Name -> TypeReference -> ExactName Name TypeReference
forall name ref. name -> ref -> ExactName name ref
ExactName (NameSegment -> Name
Name.fromSegment NameSegment
ns) TypeReference
v1Ref)
  Map NameSegment (CausalBranch n, NamespaceStats)
childrenWithStats <- Codebase m Symbol Ann
-> Transaction (Map NameSegment (CausalBranch n, NamespaceStats))
-> m (Map NameSegment (CausalBranch n, NamespaceStats))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m Symbol Ann
codebase (Branch n
-> Transaction (Map NameSegment (CausalBranch n, NamespaceStats))
forall (m :: * -> *).
Branch m
-> Transaction (Map NameSegment (CausalBranch m, NamespaceStats))
V2Branch.childStats Branch n
b0)
  let [ShallowListEntry Symbol Ann]
branchEntries :: [ShallowListEntry Symbol Ann] = do
        (NameSegment
ns, (CausalBranch n
h, NamespaceStats
stats)) <- Map NameSegment (CausalBranch n, NamespaceStats)
-> [(NameSegment, (CausalBranch n, NamespaceStats))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map NameSegment (CausalBranch n, NamespaceStats)
 -> [(NameSegment, (CausalBranch n, NamespaceStats))])
-> Map NameSegment (CausalBranch n, NamespaceStats)
-> [(NameSegment, (CausalBranch n, NamespaceStats))]
forall a b. (a -> b) -> a -> b
$ Map NameSegment (CausalBranch n, NamespaceStats)
childrenWithStats
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ NamespaceStats -> Bool
V2Branch.hasDefinitions NamespaceStats
stats
        pure $ NameSegment
-> CausalHash -> NamespaceStats -> ShallowListEntry Symbol Ann
forall v a.
NameSegment -> CausalHash -> NamespaceStats -> ShallowListEntry v a
ShallowBranchEntry NameSegment
ns (CausalBranch n -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2Causal.causalHash CausalBranch n
h) NamespaceStats
stats
  [ShallowListEntry Symbol Ann] -> m [ShallowListEntry Symbol Ann]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ShallowListEntry Symbol Ann] -> m [ShallowListEntry Symbol Ann])
-> ([ShallowListEntry Symbol Ann] -> [ShallowListEntry Symbol Ann])
-> [ShallowListEntry Symbol Ann]
-> m [ShallowListEntry Symbol Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShallowListEntry Symbol Ann -> Text)
-> [ShallowListEntry Symbol Ann] -> [ShallowListEntry Symbol Ann]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ShallowListEntry Symbol Ann -> Text
forall v a. ShallowListEntry v a -> Text
listEntryName ([ShallowListEntry Symbol Ann] -> m [ShallowListEntry Symbol Ann])
-> [ShallowListEntry Symbol Ann] -> m [ShallowListEntry Symbol Ann]
forall a b. (a -> b) -> a -> b
$
    [ShallowListEntry Symbol Ann]
termEntries
      [ShallowListEntry Symbol Ann]
-> [ShallowListEntry Symbol Ann] -> [ShallowListEntry Symbol Ann]
forall a. [a] -> [a] -> [a]
++ [ShallowListEntry Symbol Ann]
typeEntries
      [ShallowListEntry Symbol Ann]
-> [ShallowListEntry Symbol Ann] -> [ShallowListEntry Symbol Ann]
forall a. [a] -> [a] -> [a]
++ [ShallowListEntry Symbol Ann]
branchEntries

-- Any absolute names in the input which have `root` as a prefix
-- are converted to names relative to current path. All other names are
-- converted to absolute names. For example:
--
-- e.g. if currentPath = .foo.bar
--      then name foo.bar.baz becomes baz
--           name cat.dog     becomes .cat.dog
fixupNamesRelative :: Path.Absolute -> Names -> Names
fixupNamesRelative :: Absolute -> Names -> Names
fixupNamesRelative Absolute
root Names
names =
  case Path -> Maybe Name
Path.toName (Path -> Maybe Name) -> Path -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
Path.unabsolute Absolute
root of
    Maybe Name
Nothing -> Names
names
    Just Name
prefix -> (Name -> Name) -> Names -> Names
Names.map (Name -> Name -> Name
fixName Name
prefix) Names
names
  where
    fixName :: Name -> Name -> Name
fixName Name
prefix Name
n =
      if Absolute
root Absolute -> Absolute -> Bool
forall a. Eq a => a -> a -> Bool
== Absolute
Path.absoluteEmpty
        then Name
n
        else Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (Name -> Name
Name.makeAbsolute Name
n) (Name -> Name -> Maybe Name
Name.stripNamePrefix Name
prefix Name
n)

hqNameQuery ::
  Codebase m v Ann ->
  NameSearch Sqlite.Transaction ->
  Names.SearchType ->
  [HQ.HashQualified Name] ->
  Sqlite.Transaction QueryResult
hqNameQuery :: forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
hqNameQuery Codebase m v Ann
codebase NameSearch {Search Transaction TypeReference
typeSearch :: Search Transaction TypeReference
$sel:typeSearch:NameSearch :: forall (m :: * -> *). NameSearch m -> Search m TypeReference
typeSearch, Search Transaction Referent
termSearch :: Search Transaction Referent
$sel:termSearch:NameSearch :: forall (m :: * -> *). NameSearch m -> Search m Referent
termSearch} SearchType
searchType [HashQualified Name]
hqs = do
  -- Split the query into hash-only and hash-qualified-name queries.
  let ([ShortHash]
hashes, [HashQualified Name]
hqnames) = [Either ShortHash (HashQualified Name)]
-> ([ShortHash], [HashQualified Name])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((HashQualified Name -> Either ShortHash (HashQualified Name))
-> [HashQualified Name] -> [Either ShortHash (HashQualified Name)]
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> Either ShortHash (HashQualified Name)
forall n. HashQualified n -> Either ShortHash (HashQualified n)
HQ'.fromHQ2 [HashQualified Name]
hqs)
  -- Find the terms with those hashes.
  [(ShortHash, Set Referent)]
termRefs <-
    ((ShortHash, Set Referent) -> Bool)
-> [(ShortHash, Set Referent)] -> [(ShortHash, Set Referent)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ShortHash, Set Referent) -> Bool)
-> (ShortHash, Set Referent)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> Bool
forall a. Set a -> Bool
Set.null (Set Referent -> Bool)
-> ((ShortHash, Set Referent) -> Set Referent)
-> (ShortHash, Set Referent)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortHash, Set Referent) -> Set Referent
forall a b. (a, b) -> b
snd) ([(ShortHash, Set Referent)] -> [(ShortHash, Set Referent)])
-> ([Set Referent] -> [(ShortHash, Set Referent)])
-> [Set Referent]
-> [(ShortHash, Set Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShortHash] -> [Set Referent] -> [(ShortHash, Set Referent)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ShortHash]
hashes
      ([Set Referent] -> [(ShortHash, Set Referent)])
-> Transaction [Set Referent]
-> Transaction [(ShortHash, Set Referent)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ShortHash -> Transaction (Set Referent))
-> [ShortHash] -> Transaction [Set Referent]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        (Codebase m v Ann -> ShortHash -> Transaction (Set Referent)
forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Referent)
termReferentsByShortHash Codebase m v Ann
codebase)
        [ShortHash]
hashes
  -- Find types with those hashes.
  [(ShortHash, Set TypeReference)]
typeRefs <-
    ((ShortHash, Set TypeReference) -> Bool)
-> [(ShortHash, Set TypeReference)]
-> [(ShortHash, Set TypeReference)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ShortHash, Set TypeReference) -> Bool)
-> (ShortHash, Set TypeReference)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TypeReference -> Bool
forall a. Set a -> Bool
Set.null (Set TypeReference -> Bool)
-> ((ShortHash, Set TypeReference) -> Set TypeReference)
-> (ShortHash, Set TypeReference)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortHash, Set TypeReference) -> Set TypeReference
forall a b. (a, b) -> b
snd) ([(ShortHash, Set TypeReference)]
 -> [(ShortHash, Set TypeReference)])
-> ([Set TypeReference] -> [(ShortHash, Set TypeReference)])
-> [Set TypeReference]
-> [(ShortHash, Set TypeReference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShortHash]
-> [Set TypeReference] -> [(ShortHash, Set TypeReference)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ShortHash]
hashes
      ([Set TypeReference] -> [(ShortHash, Set TypeReference)])
-> Transaction [Set TypeReference]
-> Transaction [(ShortHash, Set TypeReference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ShortHash -> Transaction (Set TypeReference))
-> [ShortHash] -> Transaction [Set TypeReference]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        ShortHash -> Transaction (Set TypeReference)
typeReferencesByShortHash
        [ShortHash]
hashes
  -- Now do the name queries.
  let mkTermResult :: ShortHash -> Referent -> SearchResult
mkTermResult ShortHash
sh Referent
r = HashQualified Name
-> Referent -> Set (HashQualified Name) -> SearchResult
SR.termResult (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly ShortHash
sh) Referent
r Set (HashQualified Name)
forall a. Set a
Set.empty
      mkTypeResult :: ShortHash -> TypeReference -> SearchResult
mkTypeResult ShortHash
sh TypeReference
r = HashQualified Name
-> TypeReference -> Set (HashQualified Name) -> SearchResult
SR.typeResult (ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly ShortHash
sh) TypeReference
r Set (HashQualified Name)
forall a. Set a
Set.empty
      -- Transform the hash results a bit
      termResults :: [[SearchResult]]
termResults =
        (\(ShortHash
sh, Set Referent
tms) -> ShortHash -> Referent -> SearchResult
mkTermResult ShortHash
sh (Referent -> SearchResult) -> [Referent] -> [SearchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Referent
tms) ((ShortHash, Set Referent) -> [SearchResult])
-> [(ShortHash, Set Referent)] -> [[SearchResult]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ShortHash, Set Referent)]
termRefs
      typeResults :: [[SearchResult]]
typeResults =
        (\(ShortHash
sh, Set TypeReference
tps) -> ShortHash -> TypeReference -> SearchResult
mkTypeResult ShortHash
sh (TypeReference -> SearchResult)
-> [TypeReference] -> [SearchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TypeReference
tps) ((ShortHash, Set TypeReference) -> [SearchResult])
-> [(ShortHash, Set TypeReference)] -> [[SearchResult]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ShortHash, Set TypeReference)]
typeRefs

  -- Now do the actual name query
  [[SearchResult]]
resultss <- [HashQualified Name]
-> (HashQualified Name -> Transaction [SearchResult])
-> Transaction [[SearchResult]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [HashQualified Name]
hqnames (\HashQualified Name
name -> ([SearchResult] -> [SearchResult] -> [SearchResult])
-> Transaction [SearchResult]
-> Transaction [SearchResult]
-> Transaction [SearchResult]
forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [SearchResult] -> [SearchResult] -> [SearchResult]
forall a. Semigroup a => a -> a -> a
(<>) (Search Transaction TypeReference
-> SearchType -> HashQualified Name -> Transaction [SearchResult]
forall r (m :: * -> *).
(Show r, Monad m) =>
Search m r -> SearchType -> HashQualified Name -> m [SearchResult]
applySearch Search Transaction TypeReference
typeSearch SearchType
searchType HashQualified Name
name) (Search Transaction Referent
-> SearchType -> HashQualified Name -> Transaction [SearchResult]
forall r (m :: * -> *).
(Show r, Monad m) =>
Search m r -> SearchType -> HashQualified Name -> m [SearchResult]
applySearch Search Transaction Referent
termSearch SearchType
searchType HashQualified Name
name))
  let ([HashQualified Name]
misses, [[SearchResult]]
hits) =
        (HashQualified Name
 -> [SearchResult] -> Either (HashQualified Name) [SearchResult])
-> [HashQualified Name]
-> [[SearchResult]]
-> [Either (HashQualified Name) [SearchResult]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          ( \HashQualified Name
hqname [SearchResult]
results ->
              (if [SearchResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SearchResult]
results then HashQualified Name -> Either (HashQualified Name) [SearchResult]
forall a b. a -> Either a b
Left HashQualified Name
hqname else [SearchResult] -> Either (HashQualified Name) [SearchResult]
forall a b. b -> Either a b
Right [SearchResult]
results)
          )
          [HashQualified Name]
hqnames
          [[SearchResult]]
resultss
          [Either (HashQualified Name) [SearchResult]]
-> ([Either (HashQualified Name) [SearchResult]]
    -> ([HashQualified Name], [[SearchResult]]))
-> ([HashQualified Name], [[SearchResult]])
forall a b. a -> (a -> b) -> b
& [Either (HashQualified Name) [SearchResult]]
-> ([HashQualified Name], [[SearchResult]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
      -- Handle query misses correctly
      missingRefs :: [HashQualified Name]
missingRefs =
        [ ShortHash -> HashQualified Name
forall n. ShortHash -> HashQualified n
HQ.HashOnly ShortHash
x
          | ShortHash
x <- [ShortHash]
hashes,
            Maybe (Set Referent) -> Bool
forall a. Maybe a -> Bool
isNothing (ShortHash -> [(ShortHash, Set Referent)] -> Maybe (Set Referent)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ShortHash
x [(ShortHash, Set Referent)]
termRefs) Bool -> Bool -> Bool
&& Maybe (Set TypeReference) -> Bool
forall a. Maybe a -> Bool
isNothing (ShortHash
-> [(ShortHash, Set TypeReference)] -> Maybe (Set TypeReference)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ShortHash
x [(ShortHash, Set TypeReference)]
typeRefs)
        ]
      -- Gather the results
      results :: [SearchResult]
results =
        [SearchResult] -> [SearchResult]
forall a. Ord a => [a] -> [a]
List.sort
          ([SearchResult] -> [SearchResult])
-> ([[SearchResult]] -> [SearchResult])
-> [[SearchResult]]
-> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SearchResult -> Referent) -> [SearchResult] -> [SearchResult]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
uniqueBy SearchResult -> Referent
SR.toReferent
          ([SearchResult] -> [SearchResult])
-> ([[SearchResult]] -> [SearchResult])
-> [[SearchResult]]
-> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[SearchResult]] -> [SearchResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          ([[SearchResult]] -> [SearchResult])
-> [[SearchResult]] -> [SearchResult]
forall a b. (a -> b) -> a -> b
$ ([[SearchResult]]
hits [[SearchResult]] -> [[SearchResult]] -> [[SearchResult]]
forall a. [a] -> [a] -> [a]
++ [[SearchResult]]
termResults [[SearchResult]] -> [[SearchResult]] -> [[SearchResult]]
forall a. [a] -> [a] -> [a]
++ [[SearchResult]]
typeResults)
  QueryResult -> Transaction QueryResult
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    QueryResult
      { $sel:misses:QueryResult :: [HashQualified Name]
misses = [HashQualified Name]
missingRefs [HashQualified Name]
-> [HashQualified Name] -> [HashQualified Name]
forall a. [a] -> [a] -> [a]
++ (HashQualified Name -> HashQualified Name)
-> [HashQualified Name] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ [HashQualified Name]
misses,
        $sel:hits:QueryResult :: [SearchResult]
hits = [SearchResult]
results
      }

-- TODO: Move this to its own module
data DefinitionResults = DefinitionResults
  { DefinitionResults
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
termResults :: Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
    DefinitionResults
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
typeResults :: Map Reference (DisplayObject () (DD.Decl Symbol Ann)),
    DefinitionResults -> [HashQualified Name]
noResults :: [HQ.HashQualified Name]
  }
  deriving stock (Int -> DefinitionResults -> ShowS
[DefinitionResults] -> ShowS
DefinitionResults -> WatchKind
(Int -> DefinitionResults -> ShowS)
-> (DefinitionResults -> WatchKind)
-> ([DefinitionResults] -> ShowS)
-> Show DefinitionResults
forall a.
(Int -> a -> ShowS) -> (a -> WatchKind) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionResults -> ShowS
showsPrec :: Int -> DefinitionResults -> ShowS
$cshow :: DefinitionResults -> WatchKind
show :: DefinitionResults -> WatchKind
$cshowList :: [DefinitionResults] -> ShowS
showList :: [DefinitionResults] -> ShowS
Show)

-- | Finds ALL direct references contained within a 'DefinitionResults' so we can
-- build a pretty printer for them.
definitionResultsDependencies :: DefinitionResults -> Set LD.LabeledDependency
definitionResultsDependencies :: DefinitionResults -> Set LabeledDependency
definitionResultsDependencies (DefinitionResults {Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
$sel:termResults:DefinitionResults :: DefinitionResults
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
termResults :: Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
termResults, Map TypeReference (DisplayObject () (Decl Symbol Ann))
$sel:typeResults:DefinitionResults :: DefinitionResults
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
typeResults :: Map TypeReference (DisplayObject () (Decl Symbol Ann))
typeResults}) =
  let topLevelTerms :: Set LabeledDependency
topLevelTerms = [LabeledDependency] -> Set LabeledDependency
forall a. Ord a => [a] -> Set a
Set.fromList ([LabeledDependency] -> Set LabeledDependency)
-> ([TypeReference] -> [LabeledDependency])
-> [TypeReference]
-> Set LabeledDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> LabeledDependency)
-> [TypeReference] -> [LabeledDependency]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeReference -> LabeledDependency
LD.TermReference ([TypeReference] -> Set LabeledDependency)
-> [TypeReference] -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> [TypeReference]
forall k a. Map k a -> [k]
Map.keys Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
termResults
      topLevelTypes :: Set LabeledDependency
topLevelTypes = [LabeledDependency] -> Set LabeledDependency
forall a. Ord a => [a] -> Set a
Set.fromList ([LabeledDependency] -> Set LabeledDependency)
-> ([TypeReference] -> [LabeledDependency])
-> [TypeReference]
-> Set LabeledDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference -> LabeledDependency)
-> [TypeReference] -> [LabeledDependency]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeReference -> LabeledDependency
LD.TypeReference ([TypeReference] -> Set LabeledDependency)
-> [TypeReference] -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> [TypeReference]
forall k a. Map k a -> [k]
Map.keys Map TypeReference (DisplayObject () (Decl Symbol Ann))
typeResults
      termDeps :: Set LabeledDependency
termDeps =
        Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
termResults
          Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Map
      TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    -> Set LabeledDependency)
-> Set LabeledDependency
forall a b. a -> (a -> b) -> b
& Getting
  (Set LabeledDependency)
  (Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
  (Set LabeledDependency)
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Set LabeledDependency
forall a s. Getting a s a -> s -> a
foldOf
            ( (DisplayObject (Type Symbol Ann) (Term Symbol Ann)
 -> Const
      (Set LabeledDependency)
      (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Const
     (Set LabeledDependency)
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold
  Int
  (Map
     TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
  (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
folded
                ((DisplayObject (Type Symbol Ann) (Term Symbol Ann)
  -> Const
       (Set LabeledDependency)
       (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
 -> Map
      TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> Const
      (Set LabeledDependency)
      (Map
         TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))))
-> ((Set LabeledDependency
     -> Const (Set LabeledDependency) (Set LabeledDependency))
    -> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
    -> Const
         (Set LabeledDependency)
         (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Getting
     (Set LabeledDependency)
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
     (Set LabeledDependency)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optical
  (->)
  (->)
  (Const (Set LabeledDependency))
  (Type Symbol Ann)
  (Type Symbol Ann)
  (Set LabeledDependency)
  (Set LabeledDependency)
-> Optical
     (->)
     (->)
     (Const (Set LabeledDependency))
     (Term Symbol Ann)
     (Term Symbol Ann)
     (Set LabeledDependency)
     (Set LabeledDependency)
-> (Set LabeledDependency
    -> Const (Set LabeledDependency) (Set LabeledDependency))
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
-> Const
     (Set LabeledDependency)
     (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (q :: * -> * -> *) (f :: * -> *) (r :: * -> * -> *)
       (p :: * -> * -> *) s t a b s' t'.
(Representable q, Applicative (Rep q), Applicative f,
 Bitraversable r) =>
Optical p q f s t a b
-> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
beside
                  ((Type Symbol Ann -> Set LabeledDependency)
-> Optical
     (->)
     (->)
     (Const (Set LabeledDependency))
     (Type Symbol Ann)
     (Type Symbol Ann)
     (Set LabeledDependency)
     (Set LabeledDependency)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Type Symbol Ann -> Set LabeledDependency
forall v a. Ord v => Type v a -> Set LabeledDependency
Type.labeledDependencies)
                  ((Term Symbol Ann -> Set LabeledDependency)
-> Optical
     (->)
     (->)
     (Const (Set LabeledDependency))
     (Term Symbol Ann)
     (Term Symbol Ann)
     (Set LabeledDependency)
     (Set LabeledDependency)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Term Symbol Ann -> Set LabeledDependency
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
Term.labeledDependencies)
            )
      typeDeps :: Set LabeledDependency
typeDeps =
        Map TypeReference (DisplayObject () (Decl Symbol Ann))
typeResults
          Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> (Map TypeReference (DisplayObject () (Decl Symbol Ann))
    -> Set LabeledDependency)
-> Set LabeledDependency
forall a b. a -> (a -> b) -> b
& (TypeReference
 -> DisplayObject () (Decl Symbol Ann) -> Set LabeledDependency)
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> Set LabeledDependency
forall m a.
Monoid m =>
(TypeReference -> a -> m) -> Map TypeReference a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap \TypeReference
typeRef DisplayObject () (Decl Symbol Ann)
ddObj ->
            (Decl Symbol Ann -> Set LabeledDependency)
-> DisplayObject () (Decl Symbol Ann) -> Set LabeledDependency
forall m a. Monoid m => (a -> m) -> DisplayObject () a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TypeReference -> Decl Symbol Ann -> Set LabeledDependency
forall v a.
Var v =>
TypeReference -> Decl v a -> Set LabeledDependency
DD.labeledDeclDependenciesIncludingSelfAndFieldAccessors TypeReference
typeRef) DisplayObject () (Decl Symbol Ann)
ddObj
   in Set LabeledDependency
termDeps Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Set LabeledDependency
typeDeps Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Set LabeledDependency
topLevelTerms Set LabeledDependency
-> Set LabeledDependency -> Set LabeledDependency
forall a. Semigroup a => a -> a -> a
<> Set LabeledDependency
topLevelTypes

expandShortCausalHash :: ShortCausalHash -> Backend Sqlite.Transaction CausalHash
expandShortCausalHash :: ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
hash = do
  Set CausalHash
hashSet <- Transaction (Set CausalHash)
-> Backend Transaction (Set CausalHash)
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Set CausalHash)
 -> Backend Transaction (Set CausalHash))
-> Transaction (Set CausalHash)
-> Backend Transaction (Set CausalHash)
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Transaction (Set CausalHash)
Codebase.causalHashesByPrefix ShortCausalHash
hash
  Int
len <- Transaction Int -> Backend Transaction Int
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction Int -> Backend Transaction Int)
-> Transaction Int -> Backend Transaction Int
forall a b. (a -> b) -> a -> b
$ Transaction Int
Codebase.branchHashLength
  case Set CausalHash -> [CausalHash]
forall a. Set a -> [a]
Set.toList Set CausalHash
hashSet of
    [] -> BackendError -> Backend Transaction CausalHash
forall a. BackendError -> Backend Transaction a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BackendError -> Backend Transaction CausalHash)
-> BackendError -> Backend Transaction CausalHash
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> BackendError
CouldntExpandBranchHash ShortCausalHash
hash
    [CausalHash
h] -> CausalHash -> Backend Transaction CausalHash
forall a. a -> Backend Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalHash
h
    [CausalHash]
_ ->
      BackendError -> Backend Transaction CausalHash
forall a. BackendError -> Backend Transaction a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BackendError -> Backend Transaction CausalHash)
-> (Set ShortCausalHash -> BackendError)
-> Set ShortCausalHash
-> Backend Transaction CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> Set ShortCausalHash -> BackendError
AmbiguousBranchHash ShortCausalHash
hash (Set ShortCausalHash -> Backend Transaction CausalHash)
-> Set ShortCausalHash -> Backend Transaction CausalHash
forall a b. (a -> b) -> a -> b
$ (CausalHash -> ShortCausalHash)
-> Set CausalHash -> Set ShortCausalHash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
len) Set CausalHash
hashSet

-- | Efficiently resolve a root hash and path to a shallow branch's causal.
getShallowCausalAtPathFromRootHash ::
  CausalHash ->
  Path ->
  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
getShallowCausalAtPathFromRootHash :: CausalHash -> Path -> Transaction (CausalBranch Transaction)
getShallowCausalAtPathFromRootHash CausalHash
rootHash Path
path = do
  CausalBranch Transaction
shallowRoot <- CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
rootHash
  Path
-> CausalBranch Transaction
-> Transaction (CausalBranch Transaction)
Codebase.getShallowCausalAtPath Path
path CausalBranch Transaction
shallowRoot

formatType' :: (Var v) => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType' :: forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType' PrettyPrintEnv
ppe Width
w =
  Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
w (Pretty SyntaxText -> SyntaxText)
-> (Type v a -> Pretty SyntaxText) -> Type v a -> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Type v a -> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty SyntaxText
TypePrinter.prettySyntax PrettyPrintEnv
ppe

formatType :: (Var v) => PPE.PrettyPrintEnv -> Width -> Type v a -> Syntax.SyntaxText
formatType :: forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType PrettyPrintEnv
ppe Width
w = SyntaxText -> SyntaxText
forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText (SyntaxText -> SyntaxText)
-> (Type v a -> SyntaxText) -> Type v a -> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Width -> Type v a -> SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType' PrettyPrintEnv
ppe Width
w

formatSuffixedType ::
  (Var v) =>
  PPED.PrettyPrintEnvDecl ->
  Width ->
  Type v Ann ->
  Syntax.SyntaxText
formatSuffixedType :: forall v.
Var v =>
PrettyPrintEnvDecl -> Width -> Type v Ann -> SyntaxText
formatSuffixedType PrettyPrintEnvDecl
ppe = PrettyPrintEnv -> Width -> Type v Ann -> SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe)

mungeSyntaxText ::
  (Functor g) => g (UST.Element Reference) -> g Syntax.Element
mungeSyntaxText :: forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText = (Element TypeReference -> Element)
-> g (Element TypeReference) -> g Element
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element TypeReference -> Element
Syntax.convertElement

mkTypeDefinition ::
  (MonadIO m) =>
  Codebase IO Symbol Ann ->
  PPED.PrettyPrintEnvDecl ->
  Width ->
  Reference ->
  [(HashQualifiedName, UnisonHash, Doc.Doc)] ->
  DisplayObject
    (AnnotatedText (UST.Element Reference))
    (AnnotatedText (UST.Element Reference)) ->
  m TypeDefinition
mkTypeDefinition :: forall (m :: * -> *).
MonadIO m =>
Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> TypeReference
-> [(Text, Text, Doc)]
-> DisplayObject SyntaxText SyntaxText
-> m TypeDefinition
mkTypeDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
pped Width
width TypeReference
r [(Text, Text, Doc)]
docs DisplayObject SyntaxText SyntaxText
tp = do
  let bn :: Text
bn = forall v. Var v => PrettyPrintEnv -> Width -> TypeReference -> Text
bestNameForType @Symbol (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped) Width
width TypeReference
r
  TypeTag
tag <-
    IO TypeTag -> m TypeTag
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeTag -> m TypeTag) -> IO TypeTag -> m TypeTag
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Transaction TypeTag -> IO TypeTag
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
      TypeEntry -> TypeTag
typeEntryTag (TypeEntry -> TypeTag)
-> Transaction TypeEntry -> Transaction TypeTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> ExactName Name TypeReference -> Transaction TypeEntry
forall v (m :: * -> *).
Var v =>
Codebase m v Ann
-> ExactName Name TypeReference -> Transaction TypeEntry
typeListEntry Codebase IO Symbol Ann
codebase (Name -> TypeReference -> ExactName Name TypeReference
forall name ref. name -> ref -> ExactName name ref
ExactName (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
bn) TypeReference
r)
  pure $
    [Text]
-> Text
-> TypeTag
-> DisplayObject SyntaxText SyntaxText
-> [(Text, Text, Doc)]
-> TypeDefinition
TypeDefinition
      (HashQualified Name -> Text
HQ'.toText (HashQualified Name -> Text) -> [HashQualified Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnv -> TypeReference -> [HashQualified Name]
PPE.allTypeNames PrettyPrintEnv
fqnPPE TypeReference
r)
      Text
bn
      TypeTag
tag
      ((SyntaxText -> SyntaxText)
-> (SyntaxText -> SyntaxText)
-> DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText
forall a b c d.
(a -> b) -> (c -> d) -> DisplayObject a c -> DisplayObject b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SyntaxText -> SyntaxText
forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText SyntaxText -> SyntaxText
forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText DisplayObject SyntaxText SyntaxText
tp)
      [(Text, Text, Doc)]
docs
  where
    fqnPPE :: PrettyPrintEnv
fqnPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped

mkTermDefinition ::
  Codebase IO Symbol Ann ->
  PPED.PrettyPrintEnvDecl ->
  Width ->
  Reference ->
  [(HashQualifiedName, UnisonHash, Doc.Doc)] ->
  DisplayObject
    (AnnotatedText (UST.Element Reference))
    (AnnotatedText (UST.Element Reference)) ->
  Backend IO TermDefinition
mkTermDefinition :: Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> TypeReference
-> [(Text, Text, Doc)]
-> DisplayObject SyntaxText SyntaxText
-> Backend IO TermDefinition
mkTermDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
termPPED Width
width TypeReference
r [(Text, Text, Doc)]
docs DisplayObject SyntaxText SyntaxText
tm = do
  let referent :: Referent
referent = TypeReference -> Referent
Referent.Ref TypeReference
r
  Maybe (Type Symbol Ann)
ts <- IO (Maybe (Type Symbol Ann))
-> Backend IO (Maybe (Type Symbol Ann))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann
-> Transaction (Maybe (Type Symbol Ann))
-> IO (Maybe (Type Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> TypeReference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> TypeReference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase IO Symbol Ann
codebase TypeReference
r))
  let bn :: Text
bn = forall v. Var v => PrettyPrintEnv -> Width -> Referent -> Text
bestNameForTerm @Symbol (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
termPPED) Width
width (TypeReference -> Referent
Referent.Ref TypeReference
r)
  TermTag
tag <- IO TermTag -> Backend IO TermTag
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TermEntry Symbol Ann -> TermTag
forall v a. TermEntry v a -> TermTag
termEntryTag (TermEntry Symbol Ann -> TermTag)
-> IO (TermEntry Symbol Ann) -> IO TermTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> ExactName Name Referent -> IO (TermEntry Symbol Ann)
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> ExactName Name Referent -> m (TermEntry Symbol Ann)
termListEntry Codebase IO Symbol Ann
codebase (Name -> Referent -> ExactName Name Referent
forall name ref. name -> ref -> ExactName name ref
ExactName (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
bn) (Referent -> Referent
Cv.referent1to2 Referent
referent)))
  Maybe (Type Symbol Ann)
-> Text -> TermTag -> Backend IO TermDefinition
mk Maybe (Type Symbol Ann)
ts Text
bn TermTag
tag
  where
    fqnTermPPE :: PrettyPrintEnv
fqnTermPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
termPPED
    mk :: Maybe (Type Symbol Ann)
-> Text -> TermTag -> Backend IO TermDefinition
mk Maybe (Type Symbol Ann)
Nothing Text
_ TermTag
_ = BackendError -> Backend IO TermDefinition
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BackendError -> Backend IO TermDefinition)
-> BackendError -> Backend IO TermDefinition
forall a b. (a -> b) -> a -> b
$ TypeReference -> BackendError
MissingSignatureForTerm TypeReference
r
    mk (Just Type Symbol Ann
typeSig) Text
bn TermTag
tag = do
      -- We don't ever display individual constructors (they're shown as part of their
      -- type), so term references are never constructors.
      let referent :: Referent
referent = TypeReference -> Referent
Referent.Ref TypeReference
r
      TermDefinition -> Backend IO TermDefinition
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermDefinition -> Backend IO TermDefinition)
-> TermDefinition -> Backend IO TermDefinition
forall a b. (a -> b) -> a -> b
$
        [Text]
-> Text
-> TermTag
-> DisplayObject SyntaxText SyntaxText
-> SyntaxText
-> [(Text, Text, Doc)]
-> TermDefinition
TermDefinition
          (HashQualified Name -> Text
HQ'.toText (HashQualified Name -> Text) -> [HashQualified Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrettyPrintEnv -> Referent -> [HashQualified Name]
PPE.allTermNames PrettyPrintEnv
fqnTermPPE Referent
referent)
          Text
bn
          TermTag
tag
          ((SyntaxText -> SyntaxText)
-> (SyntaxText -> SyntaxText)
-> DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText
forall a b c d.
(a -> b) -> (c -> d) -> DisplayObject a c -> DisplayObject b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SyntaxText -> SyntaxText
forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText SyntaxText -> SyntaxText
forall (g :: * -> *).
Functor g =>
g (Element TypeReference) -> g Element
mungeSyntaxText DisplayObject SyntaxText SyntaxText
tm)
          (PrettyPrintEnvDecl -> Width -> Type Symbol Ann -> SyntaxText
forall v.
Var v =>
PrettyPrintEnvDecl -> Width -> Type v Ann -> SyntaxText
formatSuffixedType PrettyPrintEnvDecl
termPPED Width
width Type Symbol Ann
typeSig)
          [(Text, Text, Doc)]
docs

-- | Evaluate the doc at the given reference and return its evaluated-but-not-rendered form.
evalDocRef ::
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  TermReference ->
  -- Evaluation always produces a doc, (it just might have error messages in it).
  -- We still return the errors for logging and debugging.
  IO (Doc.EvaluatedDoc Symbol, [Rt.Error])
evalDocRef :: Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [Error])
evalDocRef Runtime Symbol
rt Codebase IO Symbol Ann
codebase TypeReference
r = do
  let tm :: Term2 Symbol () () Symbol ()
tm = () -> TypeReference -> Term2 Symbol () () Symbol ()
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
Term.ref () TypeReference
r
  TVar [Error]
errsVar <- [Error] -> IO (TVar [Error])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
UnliftIO.newTVarIO []
  EvaluatedDoc Symbol
evalResult <- (TypeReference -> IO (Maybe (Term2 Symbol () () Symbol ())))
-> (Referent -> IO (Maybe (Type Symbol ())))
-> (Term2 Symbol () () Symbol ()
    -> IO (Maybe (Term2 Symbol () () Symbol ())))
-> (TypeReference -> IO (Maybe (Decl Symbol ())))
-> Term2 Symbol () () Symbol ()
-> IO (EvaluatedDoc Symbol)
forall v (m :: * -> *).
(Var v, Monad m) =>
(TypeReference -> m (Maybe (Term v ())))
-> (Referent -> m (Maybe (Type v ())))
-> (Term v () -> m (Maybe (Term v ())))
-> (TypeReference -> m (Maybe (Decl v ())))
-> Term v ()
-> m (EvaluatedDoc v)
Doc.evalDoc TypeReference -> IO (Maybe (Term2 Symbol () () Symbol ()))
terms Referent -> IO (Maybe (Type Symbol ()))
typeOf (TVar [Error]
-> Term2 Symbol () () Symbol ()
-> IO (Maybe (Term2 Symbol () () Symbol ()))
eval TVar [Error]
errsVar) TypeReference -> IO (Maybe (Decl Symbol ()))
decls Term2 Symbol () () Symbol ()
tm
  [Error]
errs <- TVar [Error] -> IO [Error]
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
UnliftIO.readTVarIO TVar [Error]
errsVar
  pure (EvaluatedDoc Symbol
evalResult, [Error]
errs)
  where
    terms :: TypeReference -> IO (Maybe (Term2 Symbol () () Symbol ()))
terms r :: TypeReference
r@(Reference.Builtin Text
_) = Maybe (Term2 Symbol () () Symbol ())
-> IO (Maybe (Term2 Symbol () () Symbol ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term2 Symbol () () Symbol ()
-> Maybe (Term2 Symbol () () Symbol ())
forall a. a -> Maybe a
Just (() -> TypeReference -> Term2 Symbol () () Symbol ()
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
Term.ref () TypeReference
r))
    terms (Reference.DerivedId Id' Hash
r) =
      (Term Symbol Ann -> Term2 Symbol () () Symbol ())
-> Maybe (Term Symbol Ann) -> Maybe (Term2 Symbol () () Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term Symbol Ann -> Term2 Symbol () () Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate (Maybe (Term Symbol Ann) -> Maybe (Term2 Symbol () () Symbol ()))
-> IO (Maybe (Term Symbol Ann))
-> IO (Maybe (Term2 Symbol () () Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Transaction (Maybe (Term Symbol Ann))
-> IO (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Term v a))
Codebase.getTerm Codebase IO Symbol Ann
codebase Id' Hash
r)

    typeOf :: Referent -> IO (Maybe (Type Symbol ()))
typeOf Referent
r = (Type Symbol Ann -> Type Symbol ())
-> Maybe (Type Symbol Ann) -> Maybe (Type Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type Symbol Ann -> Type Symbol ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe (Type Symbol Ann) -> Maybe (Type Symbol ()))
-> IO (Maybe (Type Symbol Ann)) -> IO (Maybe (Type Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Transaction (Maybe (Type Symbol Ann))
-> IO (Maybe (Type Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Referent -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfReferent Codebase IO Symbol Ann
codebase Referent
r)
    eval :: TVar [Error]
-> Term2 Symbol () () Symbol ()
-> IO (Maybe (Term2 Symbol () () Symbol ()))
eval TVar [Error]
errsVar ((() -> Ann) -> Term2 Symbol () () Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
forall a. Monoid a => a
mempty) -> Term Symbol Ann
tm) = do
      -- We use an empty ppe for evalutation, it's only used for adding additional context to errors.
      let evalPPE :: PrettyPrintEnv
evalPPE = PrettyPrintEnv
PPE.empty
      let codeLookup :: CodeLookup Symbol IO Ann
codeLookup = Codebase IO Symbol Ann -> CodeLookup Symbol IO Ann
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann -> CodeLookup Symbol m Ann
Codebase.codebaseToCodeLookup Codebase IO Symbol Ann
codebase
      let cache :: Id' Hash -> IO (Maybe (Term2 Symbol () () Symbol ()))
cache Id' Hash
r = (Term Symbol Ann -> Term2 Symbol () () Symbol ())
-> Maybe (Term Symbol Ann) -> Maybe (Term2 Symbol () () Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term Symbol Ann -> Term2 Symbol () () Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate (Maybe (Term Symbol Ann) -> Maybe (Term2 Symbol () () Symbol ()))
-> IO (Maybe (Term Symbol Ann))
-> IO (Maybe (Term2 Symbol () () Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Transaction (Maybe (Term Symbol Ann))
-> IO (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Term v a))
Codebase.lookupWatchCache Codebase IO Symbol Ann
codebase Id' Hash
r)
      Maybe ([Error], Term2 Symbol () () Symbol ())
r <- (Either Error ([Error], Term2 Symbol () () Symbol ())
 -> Maybe ([Error], Term2 Symbol () () Symbol ()))
-> IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
-> IO (Maybe ([Error], Term2 Symbol () () Symbol ()))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Error ([Error], Term2 Symbol () () Symbol ())
-> Maybe ([Error], Term2 Symbol () () Symbol ())
forall a b. Either a b -> Maybe b
hush (IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
 -> IO (Maybe ([Error], Term2 Symbol () () Symbol ())))
-> (IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
    -> IO (Either Error ([Error], Term2 Symbol () () Symbol ())))
-> IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
-> IO (Maybe ([Error], Term2 Symbol () () Symbol ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
-> IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
 -> IO (Maybe ([Error], Term2 Symbol () () Symbol ())))
-> IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
-> IO (Maybe ([Error], Term2 Symbol () () Symbol ()))
forall a b. (a -> b) -> a -> b
$ CodeLookup Symbol IO Ann
-> (Id' Hash -> IO (Maybe (Term2 Symbol () () Symbol ())))
-> PrettyPrintEnv
-> Runtime Symbol
-> Term Symbol Ann
-> IO (Either Error ([Error], Term2 Symbol () () Symbol ()))
forall v a.
(Var v, Monoid a) =>
CodeLookup v IO a
-> (Id' Hash -> IO (Maybe (Term v)))
-> PrettyPrintEnv
-> Runtime v
-> Term v a
-> IO (Either Error ([Error], Term v))
Rt.evaluateTerm' CodeLookup Symbol IO Ann
codeLookup Id' Hash -> IO (Maybe (Term2 Symbol () () Symbol ()))
cache PrettyPrintEnv
evalPPE Runtime Symbol
rt Term Symbol Ann
tm
      -- Only cache watches when we're not in readonly mode
      WatchKind -> IO (Maybe WatchKind)
forall (m :: * -> *). MonadIO m => WatchKind -> m (Maybe WatchKind)
Env.lookupEnv WatchKind
"UNISON_READONLY" IO (Maybe WatchKind) -> (Maybe WatchKind -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Char
_ : WatchKind
_) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe WatchKind
_ -> do
          case Maybe ([Error], Term2 Symbol () () Symbol ())
r of
            -- don't cache when there were decompile errors
            Just ([Error]
errs, Term2 Symbol () () Symbol ()
tmr)
              | [Error] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error]
errs ->
                  Codebase IO Symbol Ann -> Transaction () -> IO ()
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
                    WatchKind -> Id' Hash -> Term Symbol Ann -> Transaction ()
Codebase.putWatch
                      WatchKind
forall a. (Eq a, IsString a) => a
WK.RegularWatch
                      (Term Symbol Ann -> Id' Hash
forall v a. Var v => Term v a -> Id' Hash
Hashing.hashClosedTerm Term Symbol Ann
tm)
                      ((() -> Ann) -> Term2 Symbol () () Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
forall a. Monoid a => a
mempty) Term2 Symbol () () Symbol ()
tmr)
              | Bool
otherwise -> do
                  STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
UnliftIO.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    TVar [Error] -> ([Error] -> [Error]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
UnliftIO.modifyTVar TVar [Error]
errsVar ([Error]
errs [Error] -> [Error] -> [Error]
forall a. [a] -> [a] -> [a]
++)
                    pure ()
            Maybe ([Error], Term2 Symbol () () Symbol ())
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      pure $ Maybe ([Error], Term2 Symbol () () Symbol ())
r Maybe ([Error], Term2 Symbol () () Symbol ())
-> (([Error], Term2 Symbol () () Symbol ())
    -> Term2 Symbol () () Symbol ())
-> Maybe (Term2 Symbol () () Symbol ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (() -> ())
-> Term2 Symbol () () Symbol () -> Term2 Symbol () () Symbol ()
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (() -> () -> ()
forall a b. a -> b -> a
const ()
forall a. Monoid a => a
mempty) (Term2 Symbol () () Symbol () -> Term2 Symbol () () Symbol ())
-> (([Error], Term2 Symbol () () Symbol ())
    -> Term2 Symbol () () Symbol ())
-> ([Error], Term2 Symbol () () Symbol ())
-> Term2 Symbol () () Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Error], Term2 Symbol () () Symbol ())
-> Term2 Symbol () () Symbol ()
forall a b. (a, b) -> b
snd

    decls :: TypeReference -> IO (Maybe (Decl Symbol ()))
decls (Reference.DerivedId Id' Hash
r) =
      (Decl Symbol Ann -> Decl Symbol ())
-> Maybe (Decl Symbol Ann) -> Maybe (Decl Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ann -> ()) -> Decl Symbol Ann -> Decl Symbol ()
forall a a2 v. (a -> a2) -> Decl v a -> Decl v a2
DD.amap (() -> Ann -> ()
forall a b. a -> b -> a
const ())) (Maybe (Decl Symbol Ann) -> Maybe (Decl Symbol ()))
-> IO (Maybe (Decl Symbol Ann)) -> IO (Maybe (Decl Symbol ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Transaction (Maybe (Decl Symbol Ann))
-> IO (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> Id' Hash -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase IO Symbol Ann
codebase Id' Hash
r)
    decls TypeReference
_ = Maybe (Decl Symbol ()) -> IO (Maybe (Decl Symbol ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Decl Symbol ())
forall a. Maybe a
Nothing

-- | Fetch the docs associated with the given name.
-- Returns all references with a Doc type which are at the name provided, or at '<name>.doc'.
docsForDefinitionName ::
  Codebase IO Symbol Ann ->
  NameSearch Sqlite.Transaction ->
  Names.SearchType ->
  Name ->
  Sqlite.Transaction [TermReference]
docsForDefinitionName :: Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [TypeReference]
docsForDefinitionName Codebase IO Symbol Ann
codebase (NameSearch {Search Transaction Referent
$sel:termSearch:NameSearch :: forall (m :: * -> *). NameSearch m -> Search m Referent
termSearch :: Search Transaction Referent
termSearch}) SearchType
searchType Name
name = do
  let potentialDocNames :: [Name]
potentialDocNames = [Name
name, Name
name Name -> NameSegment -> Name
forall a b. Snoc a a b b => a -> b -> a
Cons.:> NameSegment
NameSegment.docSegment]
  Set Referent
refs <-
    [Name]
potentialDocNames [Name]
-> ([Name] -> Transaction (Set Referent))
-> Transaction (Set Referent)
forall a b. a -> (a -> b) -> b
& (Name -> Transaction (Set Referent))
-> [Name] -> Transaction (Set Referent)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \Name
name ->
      Search Transaction Referent
-> SearchType -> HashQualified Name -> Transaction (Set Referent)
forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' Search Transaction Referent
termSearch SearchType
searchType (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
name)
  [Referent] -> Transaction [TypeReference]
filterForDocs (Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Referent
refs)
  where
    filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
    filterForDocs :: [Referent] -> Transaction [TypeReference]
filterForDocs [Referent]
rs = do
      [(TypeReference, Type Symbol Ann)]
rts <- ([[(TypeReference, Type Symbol Ann)]]
 -> [(TypeReference, Type Symbol Ann)])
-> Transaction [[(TypeReference, Type Symbol Ann)]]
-> Transaction [(TypeReference, Type Symbol Ann)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(TypeReference, Type Symbol Ann)]]
-> [(TypeReference, Type Symbol Ann)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Transaction [[(TypeReference, Type Symbol Ann)]]
 -> Transaction [(TypeReference, Type Symbol Ann)])
-> ((Referent -> Transaction [(TypeReference, Type Symbol Ann)])
    -> Transaction [[(TypeReference, Type Symbol Ann)]])
-> (Referent -> Transaction [(TypeReference, Type Symbol Ann)])
-> Transaction [(TypeReference, Type Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Referent]
-> (Referent -> Transaction [(TypeReference, Type Symbol Ann)])
-> Transaction [[(TypeReference, Type Symbol Ann)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Referent]
rs ((Referent -> Transaction [(TypeReference, Type Symbol Ann)])
 -> Transaction [(TypeReference, Type Symbol Ann)])
-> (Referent -> Transaction [(TypeReference, Type Symbol Ann)])
-> Transaction [(TypeReference, Type Symbol Ann)]
forall a b. (a -> b) -> a -> b
$ \case
        Referent.Ref TypeReference
r ->
          [(TypeReference, Type Symbol Ann)]
-> (Type Symbol Ann -> [(TypeReference, Type Symbol Ann)])
-> Maybe (Type Symbol Ann)
-> [(TypeReference, Type Symbol Ann)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((TypeReference, Type Symbol Ann)
-> [(TypeReference, Type Symbol Ann)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TypeReference, Type Symbol Ann)
 -> [(TypeReference, Type Symbol Ann)])
-> (Type Symbol Ann -> (TypeReference, Type Symbol Ann))
-> Type Symbol Ann
-> [(TypeReference, Type Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReference
r,)) (Maybe (Type Symbol Ann) -> [(TypeReference, Type Symbol Ann)])
-> Transaction (Maybe (Type Symbol Ann))
-> Transaction [(TypeReference, Type Symbol Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> TypeReference -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> TypeReference -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfTerm Codebase IO Symbol Ann
codebase TypeReference
r
        Referent
_ -> [(TypeReference, Type Symbol Ann)]
-> Transaction [(TypeReference, Type Symbol Ann)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      pure [TypeReference
r | (TypeReference
r, Type Symbol Ann
t) <- [(TypeReference, Type Symbol Ann)]
rts, Maybe (Type Symbol Ann) -> Bool
forall v loc. (Var v, Monoid loc) => Maybe (Type v loc) -> Bool
isDoc' (Type Symbol Ann -> Maybe (Type Symbol Ann)
forall a. a -> Maybe a
Just Type Symbol Ann
t)]

-- | Evaluate and render the given docs
renderDocRefs ::
  (Traversable t) =>
  PPED.PrettyPrintEnvDecl ->
  Width ->
  Codebase IO Symbol Ann ->
  Rt.Runtime Symbol ->
  t TermReference ->
  IO (t (HashQualifiedName, UnisonHash, Doc.Doc, [Rt.Error]))
renderDocRefs :: forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t TypeReference
-> IO (t (Text, Text, Doc, [Error]))
renderDocRefs PrettyPrintEnvDecl
pped Width
width Codebase IO Symbol Ann
codebase Runtime Symbol
rt t TypeReference
docRefs = do
  t (TypeReference, (EvaluatedDoc Symbol, [Error]))
eDocs <- t TypeReference
-> (TypeReference
    -> IO (TypeReference, (EvaluatedDoc Symbol, [Error])))
-> IO (t (TypeReference, (EvaluatedDoc Symbol, [Error])))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for t TypeReference
docRefs \TypeReference
ref -> (TypeReference
ref,) ((EvaluatedDoc Symbol, [Error])
 -> (TypeReference, (EvaluatedDoc Symbol, [Error])))
-> IO (EvaluatedDoc Symbol, [Error])
-> IO (TypeReference, (EvaluatedDoc Symbol, [Error]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [Error])
evalDocRef Runtime Symbol
rt Codebase IO Symbol Ann
codebase TypeReference
ref)
  t (TypeReference, (EvaluatedDoc Symbol, [Error]))
-> ((TypeReference, (EvaluatedDoc Symbol, [Error]))
    -> IO (Text, Text, Doc, [Error]))
-> IO (t (Text, Text, Doc, [Error]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for t (TypeReference, (EvaluatedDoc Symbol, [Error]))
eDocs \(TypeReference
ref, (EvaluatedDoc Symbol
eDoc, [Error]
docEvalErrs)) -> do
    let name :: Text
name = forall v. Var v => PrettyPrintEnv -> Width -> Referent -> Text
bestNameForTerm @Symbol (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped) Width
width (TypeReference -> Referent
Referent.Ref TypeReference
ref)
    let hash :: Text
hash = TypeReference -> Text
Reference.toText TypeReference
ref
    let renderedDoc :: Doc
renderedDoc = PrettyPrintEnvDecl -> EvaluatedDoc Symbol -> Doc
forall v. Var v => PrettyPrintEnvDecl -> EvaluatedDoc v -> Doc
Doc.renderDoc PrettyPrintEnvDecl
pped EvaluatedDoc Symbol
eDoc
    (Text, Text, Doc, [Error]) -> IO (Text, Text, Doc, [Error])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, Text
hash, Doc
renderedDoc, [Error]
docEvalErrs)

docsInBranchToHtmlFiles ::
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  Branch IO ->
  FilePath ->
  -- Returns any doc evaluation errors which may have occurred.
  -- Note that all docs will still be rendered even if there are errors.
  IO [Rt.Error]
docsInBranchToHtmlFiles :: Runtime Symbol
-> Codebase IO Symbol Ann -> Branch IO -> WatchKind -> IO [Error]
docsInBranchToHtmlFiles Runtime Symbol
runtime Codebase IO Symbol Ann
codebase Branch IO
currentBranch WatchKind
directory = do
  let allTerms :: [(Referent, Name)]
allTerms = (Relation Referent Name -> [(Referent, Name)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Referent Name -> [(Referent, Name)])
-> (Branch IO -> Relation Referent Name)
-> Branch IO
-> [(Referent, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms (Branch0 IO -> Relation Referent Name)
-> (Branch IO -> Branch0 IO) -> Branch IO -> Relation Referent Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head) Branch IO
currentBranch
  -- ignores docs inside lib namespace, recursively
  let notLib :: (a, Name) -> Bool
notLib (a
_, Name
name) = NameSegment
NameSegment.libSegment NameSegment -> NonEmpty NameSegment -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Name -> NonEmpty NameSegment
Name.segments Name
name
  ([(Referent, Name)]
docTermsWithNames, Int
hqLength) <-
    Codebase IO Symbol Ann
-> Transaction ([(Referent, Name)], Int)
-> IO ([(Referent, Name)], Int)
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
      [(Referent, Name)]
docTermsWithNames <- ((Referent, Name) -> Transaction Bool)
-> [(Referent, Name)] -> Transaction [(Referent, Name)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Codebase IO Symbol Ann -> Referent -> Transaction Bool
forall (m :: * -> *).
Codebase m Symbol Ann -> Referent -> Transaction Bool
isDoc Codebase IO Symbol Ann
codebase (Referent -> Transaction Bool)
-> ((Referent, Name) -> Referent)
-> (Referent, Name)
-> Transaction Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent, Name) -> Referent
forall a b. (a, b) -> a
fst) (((Referent, Name) -> Bool)
-> [(Referent, Name)] -> [(Referent, Name)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Referent, Name) -> Bool
forall {a}. (a, Name) -> Bool
notLib [(Referent, Name)]
allTerms)
      Int
hqLength <- Transaction Int
Codebase.hashLength
      pure ([(Referent, Name)]
docTermsWithNames, Int
hqLength)
  let docNamesByRef :: Map Referent Name
docNamesByRef = [(Referent, Name)] -> Map Referent Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Referent, Name)]
docTermsWithNames
  let pped :: PrettyPrintEnvDecl
pped = Int -> Branch0 IO -> PrettyPrintEnvDecl
forall (m :: * -> *). Int -> Branch0 m -> PrettyPrintEnvDecl
Branch.toPrettyPrintEnvDecl Int
hqLength (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
currentBranch)
  [(Name, Text, Doc, [Error])]
docs <- [(Referent, Name)]
-> ((Referent, Name) -> IO (Name, Text, Doc, [Error]))
-> IO [(Name, Text, Doc, [Error])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Referent, Name)]
docTermsWithNames (PrettyPrintEnvDecl
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> (Referent, Name)
-> IO (Name, Text, Doc, [Error])
forall {a}.
PrettyPrintEnvDecl
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> (Referent, a)
-> IO (a, Text, Doc, [Error])
renderDoc' PrettyPrintEnvDecl
pped Runtime Symbol
runtime Codebase IO Symbol Ann
codebase)
  IO [Error] -> IO [Error]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Error] -> IO [Error]) -> IO [Error] -> IO [Error]
forall a b. (a -> b) -> a -> b
$
    [(Name, Text, Doc, [Error])]
docs [(Name, Text, Doc, [Error])]
-> ([(Name, Text, Doc, [Error])] -> IO [Error]) -> IO [Error]
forall a b. a -> (a -> b) -> b
& ((Name, Text, Doc, [Error]) -> IO [Error])
-> [(Name, Text, Doc, [Error])] -> IO [Error]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM \(Name
name, Text
text, Doc
doc, [Error]
errs) -> do
      Map Referent Name -> WatchKind -> (Name, Text, Doc) -> IO ()
renderDocToHtmlFile Map Referent Name
docNamesByRef WatchKind
directory (Name
name, Text
text, Doc
doc)
      pure [Error]
errs
  where
    renderDoc' :: PrettyPrintEnvDecl
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> (Referent, a)
-> IO (a, Text, Doc, [Error])
renderDoc' PrettyPrintEnvDecl
ppe Runtime Symbol
runtime Codebase IO Symbol Ann
codebase (Referent
docReferent, a
name) = do
      let docReference :: TypeReference
docReference = Referent -> TypeReference
Referent.toReference Referent
docReferent
      (EvaluatedDoc Symbol
eDoc, [Error]
errs) <- Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [Error])
evalDocRef Runtime Symbol
runtime Codebase IO Symbol Ann
codebase TypeReference
docReference
      let renderedDoc :: Doc
renderedDoc = PrettyPrintEnvDecl -> EvaluatedDoc Symbol -> Doc
forall v. Var v => PrettyPrintEnvDecl -> EvaluatedDoc v -> Doc
Doc.renderDoc PrettyPrintEnvDecl
ppe EvaluatedDoc Symbol
eDoc
      let hash :: Text
hash = TypeReference -> Text
Reference.toText TypeReference
docReference
      pure (a
name, Text
hash, Doc
renderedDoc, [Error]
errs)

    cleanPath :: FilePath -> FilePath
    cleanPath :: ShowS
cleanPath WatchKind
filePath =
      WatchKind
filePath WatchKind -> (Char -> Char) -> WatchKind
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Char
'#' -> Char
'@'
        Char
c -> Char
c

    docFilePath :: FilePath -> Name -> FilePath
    docFilePath :: WatchKind -> Name -> WatchKind
docFilePath WatchKind
destination Name
docFQN =
      let (WatchKind
dir, WatchKind
fileName) =
            case [WatchKind] -> Maybe ([WatchKind], WatchKind)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc ([WatchKind] -> Maybe ([WatchKind], WatchKind))
-> (Name -> [WatchKind]) -> Name -> Maybe ([WatchKind], WatchKind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> WatchKind) -> [NameSegment] -> [WatchKind]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> WatchKind
Text.unpack (Text -> WatchKind)
-> (NameSegment -> Text) -> NameSegment -> WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toUnescapedText) ([NameSegment] -> [WatchKind])
-> (Name -> [NameSegment]) -> Name -> [WatchKind]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> [NameSegment]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty NameSegment -> [NameSegment])
-> (Name -> NonEmpty NameSegment) -> Name -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NonEmpty NameSegment
Name.segments (Name -> Maybe ([WatchKind], WatchKind))
-> Name -> Maybe ([WatchKind], WatchKind)
forall a b. (a -> b) -> a -> b
$ Name
docFQN of
              Just ([WatchKind]
path, WatchKind
leafName) ->
                ([WatchKind] -> WatchKind
directoryPath [WatchKind]
path, ShowS
docFileName WatchKind
leafName)
              Maybe ([WatchKind], WatchKind)
Nothing ->
                WatchKind -> (WatchKind, WatchKind)
forall a. HasCallStack => WatchKind -> a
error WatchKind
"Could not parse doc name"

          directoryPath :: [WatchKind] -> WatchKind
directoryPath [WatchKind]
p =
            WatchKind
destination WatchKind -> ShowS
</> [WatchKind] -> WatchKind
joinPath [WatchKind]
p

          docFileName :: ShowS
docFileName WatchKind
n =
            ShowS
cleanPath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ WatchKind
n WatchKind -> ShowS
forall a. Semigroup a => a -> a -> a
<> WatchKind
".html"
       in WatchKind
dir WatchKind -> ShowS
</> WatchKind
fileName

    renderDocToHtmlFile :: Map Referent Name -> FilePath -> (Name, UnisonHash, Doc.Doc) -> IO ()
    renderDocToHtmlFile :: Map Referent Name -> WatchKind -> (Name, Text, Doc) -> IO ()
renderDocToHtmlFile Map Referent Name
docNamesByRef WatchKind
destination (Name
docName, Text
_, Doc
doc) = do
      let fullPath :: WatchKind
fullPath =
            WatchKind -> Name -> WatchKind
docFilePath WatchKind
destination Name
docName

          directoryPath :: WatchKind
directoryPath =
            ShowS
takeDirectory WatchKind
fullPath

          (DocHtml.FrontMatterData Map Text [Text]
frontmatter, Html ()
html) =
            Map Referent Name -> Doc -> (FrontMatterData, Html ())
DocHtml.toHtml Map Referent Name
docNamesByRef Doc
doc

          go :: [Text] -> Value
go [Text
v] = Text -> Value
Yaml.String Text
v
          go [Text]
vs = [Value] -> Value
Yaml.array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
Yaml.String [Text]
vs

          frontMatterToYaml :: f [Text] -> f Value
frontMatterToYaml f [Text]
fm =
            ([Text] -> Value) -> f [Text] -> f Value
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Value
go f [Text]
fm

          frontmatterTxt :: Text
frontmatterTxt =
            if Map Text [Text] -> Bool
forall k a. Map k a -> Bool
Map.null Map Text [Text]
frontmatter
              then Text
""
              else Text
"---\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TextE.decodeUtf8 (Map Text Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode (Map Text Value -> ByteString) -> Map Text Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Map Text [Text] -> Map Text Value
forall {f :: * -> *}. Functor f => f [Text] -> f Value
frontMatterToYaml Map Text [Text]
frontmatter) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"---\n"

          htmlAsText :: Text
htmlAsText =
            Html () -> Text
forall a. Html a -> Text
Lucid.renderText Html ()
html

          fileContents :: Text
fileContents =
            Text
frontmatterTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
toStrict Text
htmlAsText
       in do
            -- Ensure all directories exists
            ()
_ <- Bool -> WatchKind -> IO ()
createDirectoryIfMissing Bool
True WatchKind
directoryPath
            WatchKind -> WatchKind -> IO ()
writeFile WatchKind
fullPath (Text -> WatchKind
Text.unpack Text
fileContents)

bestNameForTerm ::
  forall v. (Var v) => PPE.PrettyPrintEnv -> Width -> Referent -> Text
bestNameForTerm :: forall v. Var v => PrettyPrintEnv -> Width -> Referent -> Text
bestNameForTerm PrettyPrintEnv
ppe Width
width =
  WatchKind -> Text
Text.pack
    (WatchKind -> Text) -> (Referent -> WatchKind) -> Referent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty WatchKind -> WatchKind
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width
    (Pretty WatchKind -> WatchKind)
-> (Referent -> Pretty WatchKind) -> Referent -> WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxText -> WatchKind) -> Pretty SyntaxText -> Pretty WatchKind
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyntaxText -> WatchKind
forall r. SyntaxText' r -> WatchKind
UST.toPlain
    (Pretty SyntaxText -> Pretty WatchKind)
-> (Referent -> Pretty SyntaxText) -> Referent -> Pretty WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv
-> Reader (Env v) (Pretty SyntaxText) -> Pretty SyntaxText
forall v a. Var v => PrettyPrintEnv -> Reader (Env v) a -> a
TermPrinter.runPretty PrettyPrintEnv
ppe
    (Reader (Env v) (Pretty SyntaxText) -> Pretty SyntaxText)
-> (Referent -> Reader (Env v) (Pretty SyntaxText))
-> Referent
-> Pretty SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (m :: * -> *).
MonadPretty v m =>
AmbientContext -> Term3 v PrintAnnotation -> m (Pretty SyntaxText)
TermPrinter.pretty0 @v AmbientContext
TermPrinter.emptyAc
    (Term3 v PrintAnnotation -> Reader (Env v) (Pretty SyntaxText))
-> (Referent -> Term3 v PrintAnnotation)
-> Referent
-> Reader (Env v) (Pretty SyntaxText)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintAnnotation -> Referent -> Term3 v PrintAnnotation
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent PrintAnnotation
forall a. Monoid a => a
mempty

bestNameForType ::
  forall v. (Var v) => PPE.PrettyPrintEnv -> Width -> Reference -> Text
bestNameForType :: forall v. Var v => PrettyPrintEnv -> Width -> TypeReference -> Text
bestNameForType PrettyPrintEnv
ppe Width
width =
  WatchKind -> Text
Text.pack
    (WatchKind -> Text)
-> (TypeReference -> WatchKind) -> TypeReference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty WatchKind -> WatchKind
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width
    (Pretty WatchKind -> WatchKind)
-> (TypeReference -> Pretty WatchKind)
-> TypeReference
-> WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxText -> WatchKind) -> Pretty SyntaxText -> Pretty WatchKind
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyntaxText -> WatchKind
forall r. SyntaxText' r -> WatchKind
UST.toPlain
    (Pretty SyntaxText -> Pretty WatchKind)
-> (TypeReference -> Pretty SyntaxText)
-> TypeReference
-> Pretty WatchKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a.
Var v =>
PrettyPrintEnv -> Type v a -> Pretty SyntaxText
TypePrinter.prettySyntax @v PrettyPrintEnv
ppe
    (Type v () -> Pretty SyntaxText)
-> (TypeReference -> Type v ())
-> TypeReference
-> Pretty SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> TypeReference -> Type v ()
forall v a. Ord v => a -> TypeReference -> Type v a
Type.ref ()

-- | Gets the names and PPED for the branch at the provided path from the root branch for the
-- provided branch hash.
namesAtPathFromRootBranchHash ::
  forall m n v a.
  (MonadIO m) =>
  Codebase m v a ->
  V2Branch.CausalBranch n ->
  Path ->
  Backend m (Names, PPED.PrettyPrintEnvDecl)
namesAtPathFromRootBranchHash :: forall (m :: * -> *) (n :: * -> *) v a.
MonadIO m =>
Codebase m v a
-> CausalBranch n -> Path -> Backend m (Names, PrettyPrintEnvDecl)
namesAtPathFromRootBranchHash Codebase m v a
codebase CausalBranch n
cb Path
path = do
  Bool
shouldUseNamesIndex <- (BackendEnv -> Bool) -> Backend m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks BackendEnv -> Bool
useNamesIndex
  let (BranchHash
rootBranchHash, CausalHash
rootCausalHash) = (CausalBranch n -> BranchHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> he
V2Causal.valueHash CausalBranch n
cb, CausalBranch n -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2Causal.causalHash CausalBranch n
cb)
  Bool
haveNameLookupForRoot <- m Bool -> Backend m Bool
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Backend m Bool) -> m Bool -> Backend m Bool
forall a b. (a -> b) -> a -> b
$ Codebase m v a -> Transaction Bool -> m Bool
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase (BranchHash -> Transaction Bool
Ops.checkBranchHashNameLookupExists BranchHash
rootBranchHash)
  Int
hashLen <- m Int -> Backend m Int
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Int -> Backend m Int) -> m Int -> Backend m Int
forall a b. (a -> b) -> a -> b
$ Codebase m v a -> Transaction Int -> m Int
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase Transaction Int
Codebase.hashLength
  Names
names <-
    if Bool
shouldUseNamesIndex
      then do
        Bool -> Backend m () -> Backend m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
haveNameLookupForRoot) (Backend m () -> Backend m ())
-> (BackendError -> Backend m ()) -> BackendError -> Backend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendError -> Backend m ()
forall a. BackendError -> Backend m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BackendError -> Backend m ()) -> BackendError -> Backend m ()
forall a b. (a -> b) -> a -> b
$ BranchHash -> BackendError
ExpectedNameLookup BranchHash
rootBranchHash
        m Names -> Backend m Names
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Names -> Backend m Names)
-> (Transaction Names -> m Names)
-> Transaction Names
-> Backend m Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase m v a -> Transaction Names -> m Names
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase (Transaction Names -> Backend m Names)
-> Transaction Names -> Backend m Names
forall a b. (a -> b) -> a -> b
$ BranchHash -> Path -> Transaction Names
Codebase.namesAtPath BranchHash
rootBranchHash Path
path
      else do
        Branch0 m -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 m -> Names)
-> (Branch m -> Branch0 m) -> Branch m -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Branch0 m -> Branch0 m
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 Path
path (Branch0 m -> Branch0 m)
-> (Branch m -> Branch0 m) -> Branch m -> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch m -> Names) -> Backend m (Branch m) -> Backend m Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CausalHash -> Codebase m v a -> Backend m (Branch m)
forall (m :: * -> *) v a.
Monad m =>
CausalHash -> Codebase m v a -> Backend m (Branch m)
resolveCausalHash CausalHash
rootCausalHash Codebase m v a
codebase
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  (Names, PrettyPrintEnvDecl)
-> Backend m (Names, PrettyPrintEnvDecl)
forall a. a -> Backend m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
names, PrettyPrintEnvDecl
pped)

resolveCausalHash ::
  (Monad m) => CausalHash -> Codebase m v a -> Backend m (Branch m)
resolveCausalHash :: forall (m :: * -> *) v a.
Monad m =>
CausalHash -> Codebase m v a -> Backend m (Branch m)
resolveCausalHash CausalHash
bhash Codebase m v a
codebase = do
  Maybe (Branch m)
mayBranch <- m (Maybe (Branch m)) -> Backend m (Maybe (Branch m))
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Branch m)) -> Backend m (Maybe (Branch m)))
-> m (Maybe (Branch m)) -> Backend m (Maybe (Branch m))
forall a b. (a -> b) -> a -> b
$ Codebase m v a -> CausalHash -> m (Maybe (Branch m))
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> m (Maybe (Branch m))
Codebase.getBranchForHash Codebase m v a
codebase CausalHash
bhash
  Maybe (Branch m) -> Backend m (Branch m) -> Backend m (Branch m)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
whenNothing Maybe (Branch m)
mayBranch (BackendError -> Backend m (Branch m)
forall a. BackendError -> Backend m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BackendError -> Backend m (Branch m))
-> BackendError -> Backend m (Branch m)
forall a b. (a -> b) -> a -> b
$ CausalHash -> BackendError
NoBranchForHash CausalHash
bhash)

resolveRootBranchHash ::
  (MonadIO m) => ShortCausalHash -> Codebase m v a -> Backend m (Branch m)
resolveRootBranchHash :: forall (m :: * -> *) v a.
MonadIO m =>
ShortCausalHash -> Codebase m v a -> Backend m (Branch m)
resolveRootBranchHash ShortCausalHash
sch Codebase m v a
codebase = do
  CausalHash
h <- (forall x. Transaction x -> m x)
-> Backend Transaction CausalHash -> Backend m CausalHash
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
hoistBackend (Codebase m v a -> Transaction x -> m x
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase) (ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
sch)
  CausalHash -> Codebase m v a -> Backend m (Branch m)
forall (m :: * -> *) v a.
Monad m =>
CausalHash -> Codebase m v a -> Backend m (Branch m)
resolveCausalHash CausalHash
h Codebase m v a
codebase

resolveRootBranchHashV2 ::
  ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
resolveRootBranchHashV2 :: ShortCausalHash -> Backend Transaction (CausalBranch Transaction)
resolveRootBranchHashV2 ShortCausalHash
sch = do
  CausalHash
h <- ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
sch
  Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
h)

normaliseRootCausalHash :: Either ShortCausalHash CausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
normaliseRootCausalHash :: Either ShortCausalHash CausalHash
-> Backend Transaction (CausalBranch Transaction)
normaliseRootCausalHash = \case
  (Left ShortCausalHash
sch) -> do
    CausalHash
ch <- ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
sch
    Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (CausalBranch Transaction)
 -> Backend Transaction (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
ch
  (Right CausalHash
ch) -> Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (CausalBranch Transaction)
 -> Backend Transaction (CausalBranch Transaction))
-> Transaction (CausalBranch Transaction)
-> Backend Transaction (CausalBranch Transaction)
forall a b. (a -> b) -> a -> b
$ CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
ch

-- | Determines whether we include full cycles in the results, (e.g. if I search for `isEven`, will I find `isOdd` too?)
--
-- This was once used for both term and decl components, but now is only used for decl components, because 'update' does
-- The Right Thing for terms (i.e. propagates changes to all dependents, including component-mates, which are de facto
-- dependents).
--
-- Ticket of interest: https://github.com/unisonweb/unison/issues/3445
data IncludeCycles
  = IncludeCycles
  | DontIncludeCycles

definitionsByName ::
  Codebase m Symbol Ann ->
  NameSearch Sqlite.Transaction ->
  IncludeCycles ->
  Names.SearchType ->
  [HQ.HashQualified Name] ->
  Sqlite.Transaction DefinitionResults
definitionsByName :: forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> [HashQualified Name]
-> Transaction DefinitionResults
definitionsByName Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch IncludeCycles
includeCycles SearchType
searchType [HashQualified Name]
query = do
  QueryResult [HashQualified Name]
misses [SearchResult]
results <- Codebase m Symbol Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
hqNameQuery Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
searchType [HashQualified Name]
query
  -- todo: remember to replace this with getting components directly,
  -- and maybe even remove getComponentLength from Codebase interface altogether
  Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms <- (TypeReference
 -> Transaction
      (TypeReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Set TypeReference
-> Transaction
     (Map
        TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall k (m :: * -> *) (t :: * -> *) a v.
(Ord k, Monad m, Foldable t) =>
(a -> m (k, v)) -> t a -> m (Map k v)
Map.foldMapM (\TypeReference
ref -> (TypeReference
ref,) (DisplayObject (Type Symbol Ann) (Term Symbol Ann)
 -> (TypeReference,
     DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (TypeReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
displayTerm Codebase m Symbol Ann
codebase TypeReference
ref) ([SearchResult] -> Set TypeReference
searchResultsToTermRefs [SearchResult]
results)
  Map TypeReference (DisplayObject () (Decl Symbol Ann))
types <- do
    let typeRefsWithoutCycles :: Set TypeReference
typeRefsWithoutCycles = [SearchResult] -> Set TypeReference
searchResultsToTypeRefs [SearchResult]
results
    Set TypeReference
typeRefs <- case IncludeCycles
includeCycles of
      IncludeCycles
IncludeCycles ->
        (TypeReference -> Transaction (Set TypeReference))
-> Set TypeReference -> Transaction (Set TypeReference)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
Monoid.foldMapM
          TypeReference -> Transaction (Set TypeReference)
Codebase.componentReferencesForReference
          Set TypeReference
typeRefsWithoutCycles
      IncludeCycles
DontIncludeCycles -> Set TypeReference -> Transaction (Set TypeReference)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set TypeReference
typeRefsWithoutCycles
    (TypeReference
 -> Transaction (TypeReference, DisplayObject () (Decl Symbol Ann)))
-> Set TypeReference
-> Transaction
     (Map TypeReference (DisplayObject () (Decl Symbol Ann)))
forall k (m :: * -> *) (t :: * -> *) a v.
(Ord k, Monad m, Foldable t) =>
(a -> m (k, v)) -> t a -> m (Map k v)
Map.foldMapM (\TypeReference
ref -> (TypeReference
ref,) (DisplayObject () (Decl Symbol Ann)
 -> (TypeReference, DisplayObject () (Decl Symbol Ann)))
-> Transaction (DisplayObject () (Decl Symbol Ann))
-> Transaction (TypeReference, DisplayObject () (Decl Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject () (Decl Symbol Ann))
displayType Codebase m Symbol Ann
codebase TypeReference
ref) Set TypeReference
typeRefs
  pure (Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map TypeReference (DisplayObject () (Decl Symbol Ann))
-> [HashQualified Name]
-> DefinitionResults
DefinitionResults Map
  TypeReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map TypeReference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses)
  where
    searchResultsToTermRefs :: [SR.SearchResult] -> Set Reference
    searchResultsToTermRefs :: [SearchResult] -> Set TypeReference
searchResultsToTermRefs [SearchResult]
results =
      [TypeReference] -> Set TypeReference
forall a. Ord a => [a] -> Set a
Set.fromList [TypeReference
r | SR.Tm' HashQualified Name
_ (Referent.Ref TypeReference
r) Set (HashQualified Name)
_ <- [SearchResult]
results]
    searchResultsToTypeRefs :: [SR.SearchResult] -> Set Reference
    searchResultsToTypeRefs :: [SearchResult] -> Set TypeReference
searchResultsToTypeRefs [SearchResult]
results =
      [TypeReference] -> Set TypeReference
forall a. Ord a => [a] -> Set a
Set.fromList ((SearchResult -> Maybe TypeReference)
-> [SearchResult] -> [TypeReference]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe SearchResult -> Maybe TypeReference
f [SearchResult]
results)
      where
        f :: SR.SearchResult -> Maybe Reference
        f :: SearchResult -> Maybe TypeReference
f = \case
          SR.Tm' HashQualified Name
_ (Referent.Con GConstructorReference TypeReference
r ConstructorType
_) Set (HashQualified Name)
_ -> TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just (GConstructorReference TypeReference
r GConstructorReference TypeReference
-> Getting
     TypeReference (GConstructorReference TypeReference) TypeReference
-> TypeReference
forall s a. s -> Getting a s a -> a
^. Getting
  TypeReference (GConstructorReference TypeReference) TypeReference
forall r s (f :: * -> *).
Functor f =>
(r -> f s)
-> GConstructorReference r -> f (GConstructorReference s)
ConstructorReference.reference_)
          SR.Tp' HashQualified Name
_ TypeReference
r Set (HashQualified Name)
_ -> TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just TypeReference
r
          SearchResult
_ -> Maybe TypeReference
forall a. Maybe a
Nothing

displayTerm :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
displayTerm :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
displayTerm Codebase m Symbol Ann
codebase = \case
  ref :: TypeReference
ref@(Reference.Builtin Text
_) -> do
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case TypeReference
-> Map TypeReference (Type Symbol ()) -> Maybe (Type Symbol ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReference
ref Map TypeReference (Type Symbol ())
B.termRefTypes of
      -- This would be better as a `MissingBuiltin` constructor; `MissingObject` is kind of being
      -- misused here. Is `MissingObject` even possible anymore?
      Maybe (Type Symbol ())
Nothing -> ShortHash -> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
forall b a. ShortHash -> DisplayObject b a
MissingObject (ShortHash -> DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> ShortHash -> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
forall a b. (a -> b) -> a -> b
$ TypeReference -> ShortHash
Reference.toShortHash TypeReference
ref
      Just Type Symbol ()
typ -> Type Symbol Ann
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
forall b a. b -> DisplayObject b a
BuiltinObject (Ann
forall a. Monoid a => a
mempty Ann -> Type Symbol () -> Type Symbol Ann
forall a b. a -> Term F Symbol b -> Term F Symbol a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Type Symbol ()
typ)
  Reference.DerivedId Id' Hash
rid -> do
    (Term Symbol Ann
term, Type Symbol Ann
ty) <- Codebase m Symbol Ann
-> Id' Hash -> Transaction (Term Symbol Ann, Type Symbol Ann)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id' Hash -> Transaction (Term v a, Type v a)
Codebase.unsafeGetTermWithType Codebase m Symbol Ann
codebase Id' Hash
rid
    DisplayObject (Type Symbol Ann) (Term Symbol Ann)
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Term Symbol Ann
term of
      Term.Ann' Term Symbol Ann
_ Type Symbol Ann
_ -> Term Symbol Ann
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
forall b a. a -> DisplayObject b a
UserObject Term Symbol Ann
term
      -- manually annotate if necessary
      Term Symbol Ann
_ -> Term Symbol Ann
-> DisplayObject (Type Symbol Ann) (Term Symbol Ann)
forall b a. a -> DisplayObject b a
UserObject (Ann -> Term Symbol Ann -> Type Symbol Ann -> Term Symbol Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
Term.ann (Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
term) Term Symbol Ann
term Type Symbol Ann
ty)

displayType :: Codebase m Symbol Ann -> Reference -> Sqlite.Transaction (DisplayObject () (DD.Decl Symbol Ann))
displayType :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject () (Decl Symbol Ann))
displayType Codebase m Symbol Ann
codebase = \case
  Reference.Builtin Text
_ -> DisplayObject () (Decl Symbol Ann)
-> Transaction (DisplayObject () (Decl Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> DisplayObject () (Decl Symbol Ann)
forall b a. b -> DisplayObject b a
BuiltinObject ())
  Reference.DerivedId Id' Hash
rid -> do
    Decl Symbol Ann
decl <- Codebase m Symbol Ann -> Id' Hash -> Transaction (Decl Symbol Ann)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id' Hash -> Transaction (Decl v a)
Codebase.unsafeGetTypeDeclaration Codebase m Symbol Ann
codebase Id' Hash
rid
    pure (Decl Symbol Ann -> DisplayObject () (Decl Symbol Ann)
forall b a. a -> DisplayObject b a
UserObject Decl Symbol Ann
decl)

-- | Version of 'termsToSyntax' which works over arbitrary traversals.
--
-- E.g.
-- @@
-- termsToSyntaxOf suff width pped traversed [(ref, dispObj)]
--
-- or
--
-- termsToSyntaxOf suff width pped id (ref, dispObj)
--
-- or
--
-- termsToSyntaxOf suff width pped Map.asList_ (Map.singleton ref dispObj)
-- @@
-- e.g. 'traversed'
termsToSyntaxOf ::
  (Var v) =>
  (Ord a) =>
  Suffixify ->
  Width ->
  PPED.PrettyPrintEnvDecl ->
  Traversal s t (TermReference, DisplayObject (Type v a) (Term v a)) (TermReference, DisplayObject SyntaxText SyntaxText) ->
  s ->
  t
termsToSyntaxOf :: forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (TypeReference, DisplayObject (Type v a) (Term v a))
     (TypeReference, DisplayObject SyntaxText SyntaxText)
-> s
-> t
termsToSyntaxOf Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 Traversal
  s
  t
  (TypeReference, DisplayObject (Type v a) (Term v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
trav s
s =
  s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& ASetter
  s
  t
  [(TypeReference, DisplayObject (Type v a) (Term v a))]
  [(TypeReference, DisplayObject SyntaxText SyntaxText)]
-> ([(TypeReference, DisplayObject (Type v a) (Term v a))]
    -> [(TypeReference, DisplayObject SyntaxText SyntaxText)])
-> s
-> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Traversing
  (->)
  Identity
  s
  t
  (TypeReference, DisplayObject (Type v a) (Term v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
-> ASetter
     s
     t
     [(TypeReference, DisplayObject (Type v a) (Term v a))]
     [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall (f :: * -> *) s t a b.
Functor f =>
Traversing (->) f s t a b -> LensLike f s t [a] [b]
unsafePartsOf Traversing
  (->)
  Identity
  s
  t
  (TypeReference, DisplayObject (Type v a) (Term v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
Traversal
  s
  t
  (TypeReference, DisplayObject (Type v a) (Term v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
trav) (\[(TypeReference, DisplayObject (Type v a) (Term v a))]
displayObjs -> Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject (Type v a) (Term v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject (Type v a) (Term v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
termsToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 [(TypeReference, DisplayObject (Type v a) (Term v a))]
displayObjs)

-- | Converts Type Display Objects into Syntax Text.
termsToSyntax ::
  (Var v) =>
  (Ord a) =>
  Suffixify ->
  Width ->
  PPED.PrettyPrintEnvDecl ->
  [(TermReference, (DisplayObject (Type v a) (Term v a)))] ->
  [(TermReference, DisplayObject SyntaxText SyntaxText)]
termsToSyntax :: forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject (Type v a) (Term v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
termsToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 [(TypeReference, DisplayObject (Type v a) (Term v a))]
terms =
  [(TypeReference, DisplayObject (Type v a) (Term v a))]
terms
    [(TypeReference, DisplayObject (Type v a) (Term v a))]
-> ((TypeReference, DisplayObject (Type v a) (Term v a))
    -> (TypeReference, DisplayObject SyntaxText SyntaxText))
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TypeReference
r, DisplayObject (Type v a) (Term v a)
dispObj) ->
      let n :: HashQualified Name
n = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
ppeDecl (Referent -> HashQualified Name)
-> (TypeReference -> Referent)
-> TypeReference
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Referent
Referent.Ref (TypeReference -> HashQualified Name)
-> TypeReference -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TypeReference
r
       in (TypeReference
r,) case DisplayObject (Type v a) (Term v a)
dispObj of
            DisplayObject.BuiltinObject Type v a
typ ->
              SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. b -> DisplayObject b a
DisplayObject.BuiltinObject (SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> SyntaxText -> DisplayObject SyntaxText SyntaxText
forall a b. (a -> b) -> a -> b
$
                PrettyPrintEnv -> Width -> Type v a -> SyntaxText
forall v a.
Var v =>
PrettyPrintEnv -> Width -> Type v a -> SyntaxText
formatType' (TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r) Width
width Type v a
typ
            DisplayObject.MissingObject ShortHash
sh -> ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
DisplayObject.MissingObject ShortHash
sh
            DisplayObject.UserObject Term v a
tm ->
              SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. a -> DisplayObject b a
DisplayObject.UserObject
                (SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> (Pretty SyntaxText -> SyntaxText)
-> Pretty SyntaxText
-> DisplayObject SyntaxText SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width
                (Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> HashQualified Name -> Term v a -> Pretty SyntaxText
forall v at ap a.
Var v =>
PrettyPrintEnv
-> HashQualified Name -> Term2 v at ap v a -> Pretty SyntaxText
TermPrinter.prettyBinding (TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r) HashQualified Name
n Term v a
tm
  where
    ppeBody :: TypeReference -> PrettyPrintEnv
ppeBody TypeReference
r =
      if Suffixify -> Bool
suffixified Suffixify
suff
        then PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe0
        else PrettyPrintEnvDecl -> TypeReference -> PrettyPrintEnv
PPE.declarationPPE PrettyPrintEnvDecl
ppe0 TypeReference
r
    ppeDecl :: PrettyPrintEnv
ppeDecl =
      (if Suffixify -> Bool
suffixified Suffixify
suff then PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE else PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE) PrettyPrintEnvDecl
ppe0

-- | Version of 'typesToSyntax' which works over arbitrary traversals.
--
-- E.g.
-- @@
-- typesToSyntaxOf suff width pped traversed [(ref, dispObj)]
--
-- or
--
-- typesToSyntaxOf suff width pped id (ref, dispObj)
--
-- or
--
-- typesToSyntaxOf suff width pped Map.asList_ (Map.singleton ref dispObj)
-- @@
typesToSyntaxOf ::
  (Var v) =>
  (Ord a) =>
  Suffixify ->
  Width ->
  PPED.PrettyPrintEnvDecl ->
  Traversal s t (TypeReference, DisplayObject () (DD.Decl v a)) (TypeReference, DisplayObject SyntaxText SyntaxText) ->
  s ->
  t
typesToSyntaxOf :: forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (TypeReference, DisplayObject () (Decl v a))
     (TypeReference, DisplayObject SyntaxText SyntaxText)
-> s
-> t
typesToSyntaxOf Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 Traversal
  s
  t
  (TypeReference, DisplayObject () (Decl v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
trav s
s =
  s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& ASetter
  s
  t
  [(TypeReference, DisplayObject () (Decl v a))]
  [(TypeReference, DisplayObject SyntaxText SyntaxText)]
-> ([(TypeReference, DisplayObject () (Decl v a))]
    -> [(TypeReference, DisplayObject SyntaxText SyntaxText)])
-> s
-> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Traversing
  (->)
  Identity
  s
  t
  (TypeReference, DisplayObject () (Decl v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
-> ASetter
     s
     t
     [(TypeReference, DisplayObject () (Decl v a))]
     [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall (f :: * -> *) s t a b.
Functor f =>
Traversing (->) f s t a b -> LensLike f s t [a] [b]
unsafePartsOf Traversing
  (->)
  Identity
  s
  t
  (TypeReference, DisplayObject () (Decl v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
Traversal
  s
  t
  (TypeReference, DisplayObject () (Decl v a))
  (TypeReference, DisplayObject SyntaxText SyntaxText)
trav) (Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject () (Decl v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject () (Decl v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
typesToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0)

-- | Converts Type Display Objects into Syntax Text.
typesToSyntax ::
  (Var v) =>
  (Ord a) =>
  Suffixify ->
  Width ->
  PPED.PrettyPrintEnvDecl ->
  [(TypeReference, (DisplayObject () (DD.Decl v a)))] ->
  [(TypeReference, (DisplayObject SyntaxText SyntaxText))]
typesToSyntax :: forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> [(TypeReference, DisplayObject () (Decl v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
typesToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 [(TypeReference, DisplayObject () (Decl v a))]
types =
  [(TypeReference, DisplayObject () (Decl v a))]
types
    [(TypeReference, DisplayObject () (Decl v a))]
-> ((TypeReference, DisplayObject () (Decl v a))
    -> (TypeReference, DisplayObject SyntaxText SyntaxText))
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(TypeReference
r, DisplayObject () (Decl v a)
dispObj) ->
      let n :: HashQualified Name
n = PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppeDecl TypeReference
r
       in (TypeReference
r,) (DisplayObject SyntaxText SyntaxText
 -> (TypeReference, DisplayObject SyntaxText SyntaxText))
-> DisplayObject SyntaxText SyntaxText
-> (TypeReference, DisplayObject SyntaxText SyntaxText)
forall a b. (a -> b) -> a -> b
$ case DisplayObject () (Decl v a)
dispObj of
            BuiltinObject ()
_ -> SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. b -> DisplayObject b a
BuiltinObject (PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName' PrettyPrintEnv
ppeDecl TypeReference
r)
            MissingObject ShortHash
sh -> ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
MissingObject ShortHash
sh
            UserObject Decl v a
d ->
              SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. a -> DisplayObject b a
UserObject (SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> (Pretty SyntaxText -> SyntaxText)
-> Pretty SyntaxText
-> DisplayObject SyntaxText SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width (Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText
forall a b. (a -> b) -> a -> b
$
                PrettyPrintEnvDecl
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
DeclPrinter.prettyDecl (PrettyPrintEnvDecl -> TypeReference -> PrettyPrintEnvDecl
PPE.declarationPPEDecl PrettyPrintEnvDecl
ppe0 TypeReference
r) TypeReference
r HashQualified Name
n Decl v a
d
  where
    ppeDecl :: PrettyPrintEnv
ppeDecl =
      if Suffixify -> Bool
suffixified Suffixify
suff
        then PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
ppe0
        else PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
ppe0

-- | Renders a type to its decl header, e.g.
--
-- Effect:
--
-- unique ability Stream s
--
-- Data:
--
-- structural type Maybe a
typeToSyntaxHeader ::
  Width ->
  HQ.HashQualified Name ->
  DisplayObject () (DD.Decl Symbol Ann) ->
  DisplayObject SyntaxText SyntaxText
typeToSyntaxHeader :: Width
-> HashQualified Name
-> DisplayObject () (Decl Symbol Ann)
-> DisplayObject SyntaxText SyntaxText
typeToSyntaxHeader Width
width HashQualified Name
hqName DisplayObject () (Decl Symbol Ann)
obj =
  case DisplayObject () (Decl Symbol Ann)
obj of
    BuiltinObject ()
_ ->
      let syntaxName :: SyntaxText
syntaxName = Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Pretty s -> s
Pretty.renderUnbroken (Pretty SyntaxText -> SyntaxText)
-> (HashQualified Name -> Pretty SyntaxText)
-> HashQualified Name
-> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty SyntaxText -> Pretty SyntaxText)
-> HashQualified Name -> Pretty SyntaxText
forall s.
IsString s =>
(Pretty s -> Pretty s) -> HashQualified Name -> Pretty s
NP.styleHashQualified Pretty SyntaxText -> Pretty SyntaxText
forall a. a -> a
id (HashQualified Name -> SyntaxText)
-> HashQualified Name -> SyntaxText
forall a b. (a -> b) -> a -> b
$ HashQualified Name
hqName
       in SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. b -> DisplayObject b a
BuiltinObject SyntaxText
syntaxName
    MissingObject ShortHash
sh -> ShortHash -> DisplayObject SyntaxText SyntaxText
forall b a. ShortHash -> DisplayObject b a
MissingObject ShortHash
sh
    UserObject Decl Symbol Ann
d ->
      SyntaxText -> DisplayObject SyntaxText SyntaxText
forall b a. a -> DisplayObject b a
UserObject (SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> (Pretty SyntaxText -> SyntaxText)
-> Pretty SyntaxText
-> DisplayObject SyntaxText SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width (Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText)
-> Pretty SyntaxText -> DisplayObject SyntaxText SyntaxText
forall a b. (a -> b) -> a -> b
$
        HashQualified Name -> Decl Symbol Ann -> Pretty SyntaxText
forall v a.
Var v =>
HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty SyntaxText
DeclPrinter.prettyDeclHeader HashQualified Name
hqName Decl Symbol Ann
d

loadSearchResults ::
  Codebase m Symbol Ann ->
  [SR.SearchResult] ->
  Sqlite.Transaction [SR'.SearchResult' Symbol Ann]
loadSearchResults :: forall (m :: * -> *).
Codebase m Symbol Ann
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
loadSearchResults Codebase m Symbol Ann
c = (SearchResult -> Transaction (SearchResult' Symbol Ann))
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse SearchResult -> Transaction (SearchResult' Symbol Ann)
loadSearchResult
  where
    loadSearchResult :: SearchResult -> Transaction (SearchResult' Symbol Ann)
loadSearchResult = \case
      SR.Tm (SR.TermResult HashQualified Name
name Referent
r Set (HashQualified Name)
aliases) -> do
        Maybe (Type Symbol Ann)
typ <- Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
loadReferentType Codebase m Symbol Ann
c Referent
r
        pure $ HashQualified Name
-> Maybe (Type Symbol Ann)
-> Referent
-> Set (HashQualified Name)
-> SearchResult' Symbol Ann
forall v a.
HashQualified Name
-> Maybe (Type v a)
-> Referent
-> Set (HashQualified Name)
-> SearchResult' v a
SR'.Tm HashQualified Name
name Maybe (Type Symbol Ann)
typ Referent
r Set (HashQualified Name)
aliases
      SR.Tp (SR.TypeResult HashQualified Name
name TypeReference
r Set (HashQualified Name)
aliases) -> do
        DisplayObject () (Decl Symbol Ann)
dt <- Codebase m Symbol Ann
-> TypeReference
-> Transaction (DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *) v.
Codebase m v Ann
-> TypeReference -> Transaction (DisplayObject () (Decl v Ann))
loadTypeDisplayObject Codebase m Symbol Ann
c TypeReference
r
        pure $ HashQualified Name
-> DisplayObject () (Decl Symbol Ann)
-> TypeReference
-> Set (HashQualified Name)
-> SearchResult' Symbol Ann
forall v a.
HashQualified Name
-> DisplayObject () (Decl v a)
-> TypeReference
-> Set (HashQualified Name)
-> SearchResult' v a
SR'.Tp HashQualified Name
name DisplayObject () (Decl Symbol Ann)
dt TypeReference
r Set (HashQualified Name)
aliases

loadTypeDisplayObject ::
  Codebase m v Ann ->
  Reference ->
  Sqlite.Transaction (DisplayObject () (DD.Decl v Ann))
loadTypeDisplayObject :: forall (m :: * -> *) v.
Codebase m v Ann
-> TypeReference -> Transaction (DisplayObject () (Decl v Ann))
loadTypeDisplayObject Codebase m v Ann
c = \case
  Reference.Builtin Text
_ -> DisplayObject () (Decl v Ann)
-> Transaction (DisplayObject () (Decl v Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> DisplayObject () (Decl v Ann)
forall b a. b -> DisplayObject b a
BuiltinObject ())
  Reference.DerivedId Id' Hash
id ->
    DisplayObject () (Decl v Ann)
-> (Decl v Ann -> DisplayObject () (Decl v Ann))
-> Maybe (Decl v Ann)
-> DisplayObject () (Decl v Ann)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShortHash -> DisplayObject () (Decl v Ann)
forall b a. ShortHash -> DisplayObject b a
MissingObject (ShortHash -> DisplayObject () (Decl v Ann))
-> ShortHash -> DisplayObject () (Decl v Ann)
forall a b. (a -> b) -> a -> b
$ Id' Hash -> ShortHash
Reference.idToShortHash Id' Hash
id) Decl v Ann -> DisplayObject () (Decl v Ann)
forall b a. a -> DisplayObject b a
UserObject
      (Maybe (Decl v Ann) -> DisplayObject () (Decl v Ann))
-> Transaction (Maybe (Decl v Ann))
-> Transaction (DisplayObject () (Decl v Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m v Ann -> Id' Hash -> Transaction (Maybe (Decl v Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id' Hash -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase m v Ann
c Id' Hash
id