{-# LANGUAGE AllowAmbiguousTypes #-}
{-# 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,
    encodeFrontmatter,
    expandShortCausalHash,
    findDocInBranch,
    formatSuffixedType,
    getShallowCausalAtPathFromRootHash,
    getTermTag,
    getTypeTag,
    hoistBackend,
    hqNameQuery,
    loadReferentType,
    loadSearchResults,
    lsAtPath,
    lsBranch,
    mungeSyntaxText,
    Codebase.expectCausalBranchByCausalHash,
    resolveRootBranchHashV2,
    namesAtPathFromRootBranchHash,
    termEntryDisplayName,
    termEntryHQName,
    termEntryToNamedTerm,
    termEntryLabeledDependencies,
    termListEntry,
    Codebase.termReferentsByShortHash,
    termSummaryForReferent,
    typeSummaryForReference,
    typeDeclHeader,
    typeEntryDisplayName,
    typeEntryHQName,
    typeEntryToNamedType,
    typeEntryLabeledDependencies,
    typeListEntry,
    Codebase.typeReferencesByShortHash,
    typeToSyntaxHeader,
    renderDocRefs,
    docsForDefinitionName,
    normaliseRootCausalHash,
    resolveProjectRootHash,
    resolveProjectRoot,

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

    -- * Re-exported for Share Server
    termsToSyntax,
    termsToSyntaxOf,
    typeToSyntax,
    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.Aeson 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 V2
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 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.Runtime.Profile (ProfileSpec (NoProf))
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.Project (ProjectAndBranch (..), 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 (Runtime)
import Unison.Runtime.Decompile (DecompError)
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.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

-- |
--
--  __TODO__: Submit this to [frontmatter](https://github.com/yamadapc/haskell-frontmatter).
encodeFrontmatter :: (Yaml.ToJSON a) => a -> ByteString
encodeFrontmatter :: forall a. ToJSON a => a -> ByteString
encodeFrontmatter a
frontmatter = ByteString
"---\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode a
frontmatter ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"---\n"

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.Absolute Path.Absolute
  | 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)

data BackendEnv = BackendEnv

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
      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 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)
termEntryType :: forall v a. TermEntry v a -> Maybe (Type v a)
termEntryType :: Maybe (Type v a)
termEntryType, Referent
termEntryReferent :: forall v a. TermEntry v a -> Referent
termEntryReferent :: Referent
termEntryReferent, TermTag
termEntryTag :: forall v a. TermEntry v a -> TermTag
termEntryTag :: TermTag
termEntryTag, Name
termEntryName :: 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
termEntryName :: forall v a. TermEntry v a -> Name
termEntryName :: Name
termEntryName, Bool
termEntryConflicted :: forall v a. TermEntry v a -> Bool
termEntryConflicted :: Bool
termEntryConflicted, ShortHash
termEntryHash :: 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
typeEntryReference :: 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
typeEntryName :: TypeEntry -> Name
typeEntryName :: Name
typeEntryName, Bool
typeEntryConflicted :: TypeEntry -> Bool
typeEntryConflicted :: Bool
typeEntryConflicted, TypeReference
typeEntryReference :: 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
  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)
  lsBranch codebase 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
        name <- [NameSegment]
toCheck
        term <- toList $ Map.lookup name termsMap
        k <- Map.keys term
        case 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
  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 $ isDoc' 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
  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
    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
    ot <- loadReferentType codebase v1Referent
    pure (ot)
  tag <- getTermTag codebase ref ot
  pure $
    TermEntry
      { termEntryReferent = ref,
        termEntryName = name,
        termEntryType = ot,
        termEntryTag = tag,
        -- See typeEntryConflicted
        termEntryConflicted = False,
        termEntryHash = Cv.referent2toshorthash1 Nothing 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
  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
      | isDoc -> Doc
      | isTest -> Test
      | Just CT.Effect <- constructorType -> Constructor Ability
      | Just CT.Data <- constructorType -> Constructor Data
      | otherwise -> 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
      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 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
  hashLength <- Transaction Int
Codebase.hashLength
  tag <- getTypeTag codebase ref
  pure $
    TypeEntry
      { typeEntryReference = ref,
        typeEntryName = 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.
        typeEntryConflicted = False,
        typeEntryTag = tag,
        typeEntryHash = SH.shortenTo hashLength $ Reference.toShortHash 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 (RenderUniqueTypeGuids
-> HashQualified Name -> Decl v Ann -> Pretty SyntaxText
forall v a.
Var v =>
RenderUniqueTypeGuids
-> HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty SyntaxText
DeclPrinter.prettyDeclHeader RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No 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 = Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
0 (Pretty SyntaxText -> SyntaxText)
-> (TypeReference -> Pretty SyntaxText)
-> TypeReference
-> 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 -> Pretty SyntaxText)
-> (TypeReference -> HashQualified Name)
-> TypeReference
-> Pretty SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppe

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 {termEntryType :: forall v a. TermEntry v a -> Maybe (Type v a)
termEntryType = Maybe (Type v a)
mayType, termEntryTag :: forall v a. TermEntry v a -> TermTag
termEntryTag = TermTag
tag, ShortHash
termEntryHash :: forall v a. TermEntry v a -> ShortHash
termEntryHash :: ShortHash
termEntryHash} =
  NamedTerm
    { termName :: HashQualified Name
termName = TermEntry v a -> HashQualified Name
forall v a. TermEntry v a -> HashQualified Name
termEntryHQName TermEntry v a
te,
      termHash :: ShortHash
termHash = ShortHash
termEntryHash,
      termType :: 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,
      termTag :: TermTag
termTag = TermTag
tag
    }

typeEntryToNamedType :: TypeEntry -> NamedType
typeEntryToNamedType :: TypeEntry -> NamedType
typeEntryToNamedType te :: TypeEntry
te@TypeEntry {TypeTag
typeEntryTag :: TypeEntry -> TypeTag
typeEntryTag :: TypeTag
typeEntryTag, ShortHash
typeEntryHash :: TypeEntry -> ShortHash
typeEntryHash :: ShortHash
typeEntryHash} =
  NamedType
    { typeName :: HashQualified Name
typeName = TypeEntry -> HashQualified Name
typeEntryHQName (TypeEntry -> HashQualified Name)
-> TypeEntry -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ TypeEntry
te,
      typeHash :: ShortHash
typeHash = ShortHash
typeEntryHash,
      typeTag :: 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
        (ns, 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
        r <- Map.keys refs
        pure (r, ns)
  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)
  typeEntries <-
    Codebase.runTransaction codebase do
      for (flattenRefs $ V2Branch.types 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)
  childrenWithStats <- Codebase.runTransaction codebase (V2Branch.childStats b0)
  let branchEntries :: [ShallowListEntry Symbol Ann] = do
        (ns, (h, stats)) <- Map.toList $ childrenWithStats
        guard $ V2Branch.hasDefinitions stats
        pure $ ShallowBranchEntry ns (V2Causal.causalHash h) stats
  pure . List.sortOn listEntryName $
    termEntries
      ++ typeEntries
      ++ 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 Absolute -> Maybe Name
forall path. Namey path => path -> Maybe Name
Path.toName 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 -> Bool
Path.isRoot Absolute
root
        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 ->
  Set (HQ.HashQualified Name) ->
  Sqlite.Transaction QueryResult
hqNameQuery :: forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> Set (HashQualified Name)
-> Transaction QueryResult
hqNameQuery Codebase m v Ann
codebase NameSearch {Search Transaction TypeReference
typeSearch :: Search Transaction TypeReference
typeSearch :: forall (m :: * -> *). NameSearch m -> Search m TypeReference
typeSearch, Search Transaction Referent
termSearch :: Search Transaction Referent
termSearch :: forall (m :: * -> *). NameSearch m -> Search m Referent
termSearch} SearchType
searchType Set (HashQualified Name)
hqsSet = do
  let hqs :: [HashQualified Name]
hqs = Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList Set (HashQualified Name)
hqsSet

  -- 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 -> HashOrHQ n
HQ'.fromHQ [HashQualified Name]
hqs)
  -- Find the terms with those hashes.
  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)
Codebase.termReferentsByShortHash Codebase m v Ann
codebase)
        [ShortHash]
hashes
  -- Find types with those hashes.
  typeRefs <-
    filter (not . Set.null . snd) . zip hashes
      <$> traverse
        Codebase.typeReferencesByShortHash
        hashes
  -- Now do the name queries.
  let 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
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 =
        (\(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 =
        (\(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
  resultss <- for 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 (misses, hits) =
        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)
          )
          hqnames
          resultss
          & partitionEithers
      -- Handle query misses correctly
      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] -> [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)
  pure
    QueryResult
      { misses = missingRefs ++ map HQ'.toHQ misses,
        hits = 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))
termResults :: 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))
typeResults :: 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
  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
  len <- lift $ Codebase.branchHashLength
  case Set.toList 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
  shallowRoot <- CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
rootHash
  Codebase.getShallowCausalAtPath path 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
  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 $
    TypeDefinition
      (HQ'.toText <$> PPE.allTypeNames fqnPPE r)
      bn
      tag
      (bimap mungeSyntaxText mungeSyntaxText tp)
      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
  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 = forall v. Var v => PrettyPrintEnv -> Width -> Referent -> Text
bestNameForTerm @Symbol (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
termPPED) Width
width (TypeReference -> Referent
Referent.Ref TypeReference
r)
  tag <- lift (termEntryTag <$> termListEntry codebase (ExactName (Name.unsafeParseText bn) (Cv.referent1to2 referent)))
  mk ts bn 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 ::
  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, [DecompError])
evalDocRef :: Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [DecompError])
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
  errsVar <- [DecompError] -> IO (TVar [DecompError])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
UnliftIO.newTVarIO []
  evalResult <- Doc.evalDoc terms typeOf (eval errsVar) decls tm
  errs <- UnliftIO.readTVarIO errsVar
  pure (evalResult, 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 [DecompError]
-> Term2 Symbol () () Symbol ()
-> IO (Maybe (Term2 Symbol () () Symbol ()))
eval TVar [DecompError]
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)
      r <- (Either Error (Response DecompError, Term2 Symbol () () Symbol ())
 -> Maybe (Response DecompError, Term2 Symbol () () Symbol ()))
-> IO
     (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
-> IO (Maybe (Response DecompError, 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 (Response DecompError, Term2 Symbol () () Symbol ())
-> Maybe (Response DecompError, Term2 Symbol () () Symbol ())
forall a b. Either a b -> Maybe b
hush (IO
   (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
 -> IO (Maybe (Response DecompError, Term2 Symbol () () Symbol ())))
-> (IO
      (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
    -> IO
         (Either
            Error (Response DecompError, Term2 Symbol () () Symbol ())))
-> IO
     (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
-> IO (Maybe (Response DecompError, Term2 Symbol () () Symbol ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
-> IO
     (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
 -> IO (Maybe (Response DecompError, Term2 Symbol () () Symbol ())))
-> IO
     (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
-> IO (Maybe (Response DecompError, Term2 Symbol () () Symbol ()))
forall a b. (a -> b) -> a -> b
$ CodeLookup Symbol IO Ann
-> (Id' Hash -> IO (Maybe (Term2 Symbol () () Symbol ())))
-> PrettyPrintEnv
-> ProfileSpec
-> Runtime Symbol
-> Term Symbol Ann
-> IO
     (Either Error (Response DecompError, Term2 Symbol () () Symbol ()))
forall v a e e'.
(Var v, Monoid a) =>
CodeLookup v IO a
-> (Id' Hash -> IO (Maybe (Term v)))
-> PrettyPrintEnv
-> ProfileSpec
-> Runtime e e' v
-> Term v a
-> IO (Either e (Response e', Term v))
Rt.evaluateTerm' CodeLookup Symbol IO Ann
codeLookup Id' Hash -> IO (Maybe (Term2 Symbol () () Symbol ()))
cache PrettyPrintEnv
evalPPE ProfileSpec
NoProf Runtime Symbol
rt Term Symbol Ann
tm
      -- Only cache watches when we're not in readonly mode
      Env.lookupEnv "UNISON_READONLY" >>= \case
        Just (Char
_ : WatchKind
_) -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe WatchKind
_ -> do
          case Maybe (Response DecompError, Term2 Symbol () () Symbol ())
r of
            -- don't cache when there were decompile errors
            Just (Rt.DecompErrs [DecompError]
errs, Term2 Symbol () () Symbol ()
tmr)
              | [DecompError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DecompError]
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 [DecompError] -> ([DecompError] -> [DecompError]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
UnliftIO.modifyTVar TVar [DecompError]
errsVar ([DecompError]
errs [DecompError] -> [DecompError] -> [DecompError]
forall a. [a] -> [a] -> [a]
++)
                    () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Maybe (Response DecompError, Term2 Symbol () () Symbol ())
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      pure $ r <&> Term.amap (const mempty) . 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
termSearch :: 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]
  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)
  filterForDocs (toList refs)
  where
    filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
    filterForDocs :: [Referent] -> Transaction [TypeReference]
filterForDocs [Referent]
rs = do
      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 [r | (r, t) <- rts, isDoc' (Just t)]

-- | Evaluate and render the given docs
renderDocRefs ::
  (Traversable t) =>
  PPED.PrettyPrintEnvDecl ->
  Width ->
  Codebase IO Symbol Ann ->
  Runtime Symbol ->
  t TermReference ->
  IO (t (HashQualifiedName, UnisonHash, Doc.Doc, [DecompError]))
renderDocRefs :: forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t TypeReference
-> IO (t (Text, Text, Doc, [DecompError]))
renderDocRefs PrettyPrintEnvDecl
pped Width
width Codebase IO Symbol Ann
codebase Runtime Symbol
rt t TypeReference
docRefs = do
  eDocs <- t TypeReference
-> (TypeReference
    -> IO (TypeReference, (EvaluatedDoc Symbol, [DecompError])))
-> IO (t (TypeReference, (EvaluatedDoc Symbol, [DecompError])))
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, [DecompError])
 -> (TypeReference, (EvaluatedDoc Symbol, [DecompError])))
-> IO (EvaluatedDoc Symbol, [DecompError])
-> IO (TypeReference, (EvaluatedDoc Symbol, [DecompError]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [DecompError])
evalDocRef Runtime Symbol
rt Codebase IO Symbol Ann
codebase TypeReference
ref)
  for eDocs \(TypeReference
ref, (EvaluatedDoc Symbol
eDoc, [DecompError]
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, [DecompError])
-> IO (Text, Text, Doc, [DecompError])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
name, Text
hash, Doc
renderedDoc, [DecompError]
docEvalErrs)

docsInBranchToHtmlFiles ::
  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 [DecompError]
docsInBranchToHtmlFiles :: Runtime Symbol
-> Codebase IO Symbol Ann
-> Branch IO
-> WatchKind
-> IO [DecompError]
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
  (docTermsWithNames, 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
      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)
      hqLength <- Codebase.hashLength
      pure (docTermsWithNames, hqLength)
  let docNamesByRef = [(Referent, Name)] -> Map Referent Name
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Referent, Name)]
docTermsWithNames
  let 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)
  docs <- for docTermsWithNames (renderDoc' pped runtime codebase)
  liftIO $
    docs & foldMapM \(Name
name, Text
text, Doc
doc, [DecompError]
errs) -> do
      Map Referent Name -> WatchKind -> (Name, Text, Doc) -> IO ()
renderDocToHtmlFile Map Referent Name
docNamesByRef WatchKind
directory (Name
name, Text
text, Doc
doc)
      [DecompError] -> IO [DecompError]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DecompError]
errs
  where
    renderDoc' :: PrettyPrintEnvDecl
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> (Referent, a)
-> IO (a, Text, Doc, [DecompError])
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
      (eDoc, errs) <- Runtime Symbol
-> Codebase IO Symbol Ann
-> TypeReference
-> IO (EvaluatedDoc Symbol, [DecompError])
evalDocRef Runtime Symbol
runtime Codebase IO Symbol Ann
codebase TypeReference
docReference
      let renderedDoc = PrettyPrintEnvDecl -> EvaluatedDoc Symbol -> Doc
forall v. Var v => PrettyPrintEnvDecl -> EvaluatedDoc v -> Doc
Doc.renderDoc PrettyPrintEnvDecl
ppe EvaluatedDoc Symbol
eDoc
      let hash = TypeReference -> Text
Reference.toText TypeReference
docReference
      pure (name, hash, renderedDoc, 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

          frontMatterToYaml :: Map Text [Text] -> Map Text Value
frontMatterToYaml = ([Text] -> Value) -> Map Text [Text] -> Map Text Value
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
            [Text
v] -> Text -> Value
Yaml.String Text
v
            [Text]
vs -> [Value] -> Value
Yaml.array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Yaml.String (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
vs

          frontmatterTxt :: Text
frontmatterTxt =
            if Map Text [Text] -> Bool
forall k a. Map k a -> Bool
Map.null Map Text [Text]
frontmatter
              then Text
""
              else ByteString -> Text
TextE.decodeUtf8 (ByteString -> Text)
-> (Map Text Value -> ByteString) -> Map Text Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodeFrontmatter (Map Text Value -> Text) -> Map Text Value -> Text
forall a b. (a -> b) -> a -> b
$ Map Text [Text] -> Map Text Value
frontMatterToYaml Map Text [Text]
frontmatter

          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
            writeFile fullPath (Text.unpack 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 =
  Width -> Pretty Text -> Text
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width
    (Pretty Text -> Text)
-> (Referent -> Pretty Text) -> Referent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxText -> Text) -> Pretty SyntaxText -> Pretty Text
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyntaxText -> Text
forall r. SyntaxText' r -> Text
UST.toPlain
    (Pretty SyntaxText -> Pretty Text)
-> (Referent -> Pretty SyntaxText) -> Referent -> Pretty Text
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 =
  Width -> Pretty Text -> Text
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width
    (Pretty Text -> Text)
-> (TypeReference -> Pretty Text) -> TypeReference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SyntaxText -> Text) -> Pretty SyntaxText -> Pretty Text
forall a b. (a -> b) -> Pretty a -> Pretty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SyntaxText -> Text
forall r. SyntaxText' r -> Text
UST.toPlain
    (Pretty SyntaxText -> Pretty Text)
-> (TypeReference -> Pretty SyntaxText)
-> TypeReference
-> Pretty Text
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
  let rootCausalHash :: CausalHash
rootCausalHash = CausalBranch n -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2Causal.causalHash CausalBranch n
cb
  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 <- Branch.toNames . Branch.getAt0 path . Branch.head <$> resolveCausalHash rootCausalHash codebase
  let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLen Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  pure (names, 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
  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
  whenNothing mayBranch (throwError $ NoBranchForHash 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
  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)
  resolveCausalHash h codebase

resolveRootBranchHashV2 ::
  ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
resolveRootBranchHashV2 :: ShortCausalHash -> Backend Transaction (CausalBranch Transaction)
resolveRootBranchHashV2 ShortCausalHash
sch = do
  h <- ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
sch
  lift (Codebase.expectCausalBranchByCausalHash 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
    ch <- ShortCausalHash -> Backend Transaction CausalHash
expandShortCausalHash ShortCausalHash
sch
    lift $ Codebase.expectCausalBranchByCausalHash 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 ->
  Set (HQ.HashQualified Name) ->
  Sqlite.Transaction DefinitionResults
definitionsByName :: forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> Set (HashQualified Name)
-> Transaction DefinitionResults
definitionsByName Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch IncludeCycles
includeCycles SearchType
searchType Set (HashQualified Name)
query = do
  QueryResult misses results <- Codebase m Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Set (HashQualified Name)
-> Transaction QueryResult
forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> Set (HashQualified Name)
-> Transaction QueryResult
hqNameQuery Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
searchType Set (HashQualified Name)
query
  -- todo: remember to replace this with getting components directly,
  -- and maybe even remove getComponentLength from Codebase interface altogether
  terms <- 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) (searchResultsToTermRefs results)
  types <- do
    let typeRefsWithoutCycles = [SearchResult] -> Set TypeReference
searchResultsToTypeRefs [SearchResult]
results
    typeRefs <- case 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
    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) typeRefs
  pure (DefinitionResults terms types 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, 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
    pure case 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 <- 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 (UserObject 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,
            (Type v a -> SyntaxText)
-> (Term v a -> SyntaxText)
-> DisplayObject (Type v a) (Term v a)
-> 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
              (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)
              (Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width (Pretty SyntaxText -> SyntaxText)
-> (Term v a -> Pretty SyntaxText) -> Term v a -> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
              DisplayObject (Type v a) (Term v a)
dispObj
          )
  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))
 -> (TypeReference, DisplayObject SyntaxText SyntaxText))
-> [(TypeReference, DisplayObject () (Decl v a))]
-> [(TypeReference, DisplayObject SyntaxText SyntaxText)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(TypeReference
r, DisplayObject () (Decl v a)
dispObj) -> (TypeReference
r, Suffixify
-> Width
-> PrettyPrintEnvDecl
-> TypeReference
-> DisplayObject () (Decl v a)
-> DisplayObject SyntaxText SyntaxText
forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> TypeReference
-> DisplayObject () (Decl v a)
-> DisplayObject SyntaxText SyntaxText
typeToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 TypeReference
r DisplayObject () (Decl v a)
dispObj)

-- | Converts a Type Display Object into Syntax Text.
typeToSyntax ::
  (Var v, Ord a) =>
  Suffixify ->
  Width ->
  PPED.PrettyPrintEnvDecl ->
  TypeReference ->
  DisplayObject () (DD.Decl v a) ->
  DisplayObject SyntaxText SyntaxText
typeToSyntax :: forall v a.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> TypeReference
-> DisplayObject () (Decl v a)
-> DisplayObject SyntaxText SyntaxText
typeToSyntax Suffixify
suff Width
width PrettyPrintEnvDecl
ppe0 TypeReference
r =
  let n :: HashQualified Name
n = PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName PrettyPrintEnv
ppeDecl TypeReference
r
   in (() -> SyntaxText)
-> (Decl v a -> SyntaxText)
-> DisplayObject () (Decl v a)
-> 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
        (\() -> PrettyPrintEnv -> TypeReference -> SyntaxText
formatTypeName' PrettyPrintEnv
ppeDecl TypeReference
r)
        (Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width (Pretty SyntaxText -> SyntaxText)
-> (Decl v a -> Pretty SyntaxText) -> Decl v a -> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> RenderUniqueTypeGuids
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
DeclPrinter.prettyDecl PrettyPrintEnvDecl
ppe0 RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No TypeReference
r HashQualified Name
n)
  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 =
  (() -> SyntaxText)
-> (Decl Symbol Ann -> SyntaxText)
-> DisplayObject () (Decl Symbol Ann)
-> 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
    (\() -> Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
0 (Pretty SyntaxText -> SyntaxText)
-> Pretty SyntaxText -> SyntaxText
forall a b. (a -> b) -> a -> b
$ (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
hqName)
    (Width -> Pretty SyntaxText -> SyntaxText
forall s. (Monoid s, IsString s) => Width -> Pretty s -> s
Pretty.render Width
width (Pretty SyntaxText -> SyntaxText)
-> (Decl Symbol Ann -> Pretty SyntaxText)
-> Decl Symbol Ann
-> SyntaxText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderUniqueTypeGuids
-> HashQualified Name -> Decl Symbol Ann -> Pretty SyntaxText
forall v a.
Var v =>
RenderUniqueTypeGuids
-> HashQualified Name
-> Either (EffectDeclaration v a) (DataDeclaration v a)
-> Pretty SyntaxText
DeclPrinter.prettyDeclHeader RenderUniqueTypeGuids
DeclPrinter.RenderUniqueTypeGuids'No HashQualified Name
hqName)

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
        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 $ SR'.Tm name typ r aliases
      SR.Tp (SR.TypeResult HashQualified Name
name TypeReference
r Set (HashQualified Name)
aliases) -> do
        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 $ SR'.Tp name dt r 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

resolveProjectRoot :: Codebase IO v a -> ProjectAndBranch ProjectName ProjectBranchName -> Backend IO (V2.CausalBranch Sqlite.Transaction)
resolveProjectRoot :: forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
resolveProjectRoot Codebase IO v a
codebase projectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName@(ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) = do
  mayCB <- IO (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (CausalBranch Transaction))
 -> Backend IO (Maybe (CausalBranch Transaction)))
-> (Transaction (Maybe (CausalBranch Transaction))
    -> IO (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO v a
-> Transaction (Maybe (CausalBranch Transaction))
-> IO (Maybe (CausalBranch Transaction))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO v a
codebase (Transaction (Maybe (CausalBranch Transaction))
 -> Backend IO (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName
-> Transaction (Maybe (CausalBranch Transaction))
Codebase.getShallowProjectRootByNames ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
  case mayCB of
    Maybe (CausalBranch Transaction)
Nothing -> BackendError -> Backend IO (CausalBranch Transaction)
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ProjectName -> ProjectBranchName -> BackendError
ProjectBranchNameNotFound ProjectName
projectName ProjectBranchName
branchName)
    Just CausalBranch Transaction
cb -> CausalBranch Transaction -> Backend IO (CausalBranch Transaction)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalBranch Transaction
cb

resolveProjectRootHash :: Codebase IO v a -> ProjectAndBranch ProjectName ProjectBranchName -> Backend IO CausalHash
resolveProjectRootHash :: forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO v a
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName = do
  Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
resolveProjectRoot Codebase IO v a
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName Backend IO (CausalBranch Transaction)
-> (CausalBranch Transaction -> CausalHash)
-> Backend IO CausalHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CausalBranch Transaction -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2Causal.causalHash

termSummaryForReferent ::
  Codebase IO Symbol Ann ->
  Referent ->
  Maybe Name ->
  (Set LD.LabeledDependency -> Sqlite.Transaction PPED.PrettyPrintEnvDecl) ->
  Maybe Width ->
  Backend IO TermSummary
termSummaryForReferent :: Codebase IO Symbol Ann
-> Referent
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TermSummary
termSummaryForReferent Codebase IO Symbol Ann
codebase Referent
referent Maybe Name
mayName Set LabeledDependency -> Transaction PrettyPrintEnvDecl
mkPPE Maybe Width
mayWidth = do
  let shortHash :: ShortHash
shortHash = Referent -> ShortHash
Referent.toShortHash Referent
referent
  let termReference :: TypeReference
termReference = Referent -> TypeReference
Referent.toReference Referent
referent
  let v2Referent :: Referent
v2Referent = Referent -> Referent
Cv.referent1to2 Referent
referent

  sig <- (forall x. Transaction x -> IO x)
-> Backend Transaction (Maybe (Type Symbol Ann))
-> Backend IO (Maybe (Type Symbol Ann))
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
hoistBackend (Codebase IO Symbol Ann -> Transaction x -> IO x
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase) do
    sig <- Transaction (Maybe (Type Symbol Ann))
-> Backend Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codebase IO Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
loadReferentType Codebase IO Symbol Ann
codebase Referent
referent)
    pure sig
  case sig of
    Maybe (Type Symbol Ann)
Nothing ->
      BackendError -> Backend IO TermSummary
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TypeReference -> BackendError
MissingSignatureForTerm TypeReference
termReference)
    Just Type Symbol Ann
typeSig -> do
      let deps :: Set LabeledDependency
deps = Type Symbol Ann -> Set LabeledDependency
forall v a. Ord v => Type v a -> Set LabeledDependency
Type.labeledDependencies Type Symbol Ann
typeSig
      pped <- IO PrettyPrintEnvDecl -> Backend IO PrettyPrintEnvDecl
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO PrettyPrintEnvDecl -> Backend IO PrettyPrintEnvDecl)
-> (Transaction PrettyPrintEnvDecl -> IO PrettyPrintEnvDecl)
-> Transaction PrettyPrintEnvDecl
-> Backend IO PrettyPrintEnvDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction PrettyPrintEnvDecl -> IO PrettyPrintEnvDecl
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction PrettyPrintEnvDecl -> Backend IO PrettyPrintEnvDecl)
-> Transaction PrettyPrintEnvDecl -> Backend IO PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ Set LabeledDependency -> Transaction PrettyPrintEnvDecl
mkPPE Set LabeledDependency
deps
      let formattedTermSig = PrettyPrintEnvDecl -> Width -> Type Symbol Ann -> SyntaxText
forall v.
Var v =>
PrettyPrintEnvDecl -> Width -> Type v Ann -> SyntaxText
formatSuffixedType PrettyPrintEnvDecl
pped Width
width Type Symbol Ann
typeSig
      let summary = TypeReference -> SyntaxText -> DisplayObject SyntaxText SyntaxText
forall {a}. TypeReference -> a -> DisplayObject a a
mkSummary TypeReference
termReference SyntaxText
formattedTermSig
      tag <- lift $ getTermTag codebase v2Referent sig
      let displayName = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Referent
referent
      pure $ TermSummary (maybe displayName HQ.NameOnly mayName) shortHash summary tag
  where
    width :: Width
width = Maybe Width -> Width
mayDefaultWidth Maybe Width
mayWidth
    mkSummary :: TypeReference -> a -> DisplayObject a a
mkSummary TypeReference
reference a
termSig =
      if TypeReference -> Bool
Reference.isBuiltin TypeReference
reference
        then a -> DisplayObject a a
forall b a. b -> DisplayObject b a
BuiltinObject a
termSig
        else a -> DisplayObject a a
forall b a. a -> DisplayObject b a
UserObject a
termSig

typeSummaryForReference ::
  Codebase IO Symbol Ann ->
  Reference ->
  Maybe Name ->
  (Set LD.LabeledDependency -> Sqlite.Transaction PPED.PrettyPrintEnvDecl) ->
  Maybe Width ->
  Backend IO TypeSummary
typeSummaryForReference :: Codebase IO Symbol Ann
-> TypeReference
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TypeSummary
typeSummaryForReference Codebase IO Symbol Ann
codebase TypeReference
reference Maybe Name
mayName Set LabeledDependency -> Transaction PrettyPrintEnvDecl
mkPPED Maybe Width
mayWidth = do
  let shortHash :: ShortHash
shortHash = TypeReference -> ShortHash
Reference.toShortHash TypeReference
reference
  IO TypeSummary -> Backend IO TypeSummary
forall (m :: * -> *) a. Monad m => m a -> Backend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift do
    Codebase IO Symbol Ann -> Transaction TypeSummary -> IO TypeSummary
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
      pped <- Set LabeledDependency -> Transaction PrettyPrintEnvDecl
mkPPED (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Set LabeledDependency -> Transaction PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ LabeledDependency -> Set LabeledDependency
forall a. a -> Set a
Set.singleton (TypeReference -> LabeledDependency
LD.TypeReference TypeReference
reference)
      let displayName = PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) TypeReference
reference
      tag <- getTypeTag codebase reference
      displayDecl <- displayType codebase reference
      let syntaxHeader = Width
-> HashQualified Name
-> DisplayObject () (Decl Symbol Ann)
-> DisplayObject SyntaxText SyntaxText
typeToSyntaxHeader Width
width HashQualified Name
displayName DisplayObject () (Decl Symbol Ann)
displayDecl
      pure $
        TypeSummary
          { displayName = (maybe displayName HQ.NameOnly mayName),
            hash = shortHash,
            summary = bimap mungeSyntaxText mungeSyntaxText syntaxHeader,
            tag = tag
          }
  where
    width :: Width
width = Maybe Width -> Width
mayDefaultWidth Maybe Width
mayWidth