module Unison.Server.Local.Definitions
  ( prettyDefinitionsForHQName,
    termDefinitionByName,
    typeDefinitionByName,
  )
where

import Control.Lens hiding ((??))
import Control.Monad.Except
import Control.Monad.Trans.Maybe (mapMaybeT)
import Data.Map qualified as Map
import Data.Set.NonEmpty qualified as NESet
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.Reference (TermReference, TypeReference)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
import Unison.Codebase.Path (Path)
import Unison.Codebase.Runtime qualified as Rt
import Unison.DataDeclaration qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.NamesWithHistory qualified as NS
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Server.Backend
import Unison.Server.Backend qualified as Backend
import Unison.Server.Doc qualified as Doc
import Unison.Server.Local qualified as Local
import Unison.Server.NameSearch (NameSearch)
import Unison.Server.NameSearch qualified as NS
import Unison.Server.NameSearch qualified as NameSearch
import Unison.Server.NameSearch.FromNames (makeNameSearch)
import Unison.Server.Types
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ (toText)
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.Util.Map qualified as Map
import Unison.Util.Pretty (Width)

-- | Renders a definition for the given name or hash alongside its documentation.
prettyDefinitionsForHQName ::
  -- | The path representing the user's current perspective.
  -- Searches will be limited to definitions within this path, and names will be relative to
  -- this path.
  Path ->
  -- | The root branch to use
  V2Branch.CausalBranch Sqlite.Transaction ->
  Maybe Width ->
  -- | Whether to suffixify bindings in the rendered syntax
  Suffixify ->
  -- | Runtime used to evaluate docs. This should be sandboxed if run on the server.
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  -- | The name, hash, or both, of the definition to display.
  HQ.HashQualified Name ->
  Backend IO DefinitionDisplayResults
prettyDefinitionsForHQName :: Path
-> CausalBranch Transaction
-> Maybe Width
-> Suffixify
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> HashQualified Name
-> Backend IO DefinitionDisplayResults
prettyDefinitionsForHQName Path
perspective CausalBranch Transaction
shallowRoot Maybe Width
renderWidth Suffixify
suffixifyBindings Runtime Symbol
rt Codebase IO Symbol Ann
codebase HashQualified Name
perspectiveQuery = do
  Either
  BackendError (CausalBranch Transaction, Path, HashQualified Name)
result <- IO
  (Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name))
-> Backend
     IO
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      BackendError (CausalBranch Transaction, Path, HashQualified Name))
 -> Backend
      IO
      (Either
         BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> (Transaction
      (Either
         BackendError (CausalBranch Transaction, Path, HashQualified Name))
    -> IO
         (Either
            BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
-> Backend
     IO
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
-> IO
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction
   (Either
      BackendError (CausalBranch Transaction, Path, HashQualified Name))
 -> Backend
      IO
      (Either
         BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
-> Backend
     IO
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a b. (a -> b) -> a -> b
$ do
    Branch Transaction
shallowBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value CausalBranch Transaction
shallowRoot
    Path
-> HashQualified Name
-> Branch Transaction
-> Transaction (Either BackendError (Path, HashQualified Name))
Local.relocateToNameRoot Path
perspective HashQualified Name
perspectiveQuery Branch Transaction
shallowBranch Transaction (Either BackendError (Path, HashQualified Name))
-> (Either BackendError (Path, HashQualified Name)
    -> Transaction
         (Either
            BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left BackendError
err -> Either
  BackendError (CausalBranch Transaction, Path, HashQualified Name)
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   BackendError (CausalBranch Transaction, Path, HashQualified Name)
 -> Transaction
      (Either
         BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name)
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a b. (a -> b) -> a -> b
$ BackendError
-> Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name)
forall a b. a -> Either a b
Left BackendError
err
      Right (Path
namesRoot, HashQualified Name
locatedQuery) -> do
        Either
  BackendError (CausalBranch Transaction, Path, HashQualified Name)
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   BackendError (CausalBranch Transaction, Path, HashQualified Name)
 -> Transaction
      (Either
         BackendError (CausalBranch Transaction, Path, HashQualified Name)))
-> Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name)
-> Transaction
     (Either
        BackendError (CausalBranch Transaction, Path, HashQualified Name))
forall a b. (a -> b) -> a -> b
$ (CausalBranch Transaction, Path, HashQualified Name)
-> Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name)
forall a b. b -> Either a b
Right (CausalBranch Transaction
shallowRoot, Path
namesRoot, HashQualified Name
locatedQuery)
  (CausalBranch Transaction
shallowRoot, Path
namesRoot, HashQualified Name
query) <- (BackendError
 -> Backend IO (CausalBranch Transaction, Path, HashQualified Name))
-> ((CausalBranch Transaction, Path, HashQualified Name)
    -> Backend IO (CausalBranch Transaction, Path, HashQualified Name))
-> Either
     BackendError (CausalBranch Transaction, Path, HashQualified Name)
-> Backend IO (CausalBranch Transaction, Path, HashQualified Name)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BackendError
-> Backend IO (CausalBranch Transaction, Path, HashQualified Name)
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CausalBranch Transaction, Path, HashQualified Name)
-> Backend IO (CausalBranch Transaction, Path, HashQualified Name)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either
  BackendError (CausalBranch Transaction, Path, HashQualified Name)
result
  -- Bias towards both relative and absolute path to queries,
  -- This allows us to still bias towards definitions outside our perspective but within the
  -- same tree;
  -- e.g. if the query is `map` and we're in `base.trunk.List`,
  -- we bias towards `map` and `.base.trunk.List.map` which ensures we still prefer names in
  -- `trunk` over those in other releases.
  -- ppe which returns names fully qualified to the current perspective,  not to the codebase root.
  let biases :: [Name]
biases = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
query
  Int
hqLength <- IO Int -> Backend IO Int
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Backend IO Int) -> IO Int -> Backend IO Int
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Transaction Int -> IO Int
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction Int -> IO Int) -> Transaction Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Transaction Int
Codebase.hashLength
  (Names
localNamesOnly, PrettyPrintEnvDecl
unbiasedPPED) <- Codebase IO Symbol Ann
-> CausalBranch Transaction
-> Path
-> Backend IO (Names, PrettyPrintEnvDecl)
forall (m :: * -> *) (n :: * -> *) v a.
MonadIO m =>
Codebase m v a
-> CausalBranch n -> Path -> Backend m (Names, PrettyPrintEnvDecl)
namesAtPathFromRootBranchHash Codebase IO Symbol Ann
codebase CausalBranch Transaction
shallowRoot Path
namesRoot
  let pped :: PrettyPrintEnvDecl
pped = [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo [Name]
biases PrettyPrintEnvDecl
unbiasedPPED
  let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
makeNameSearch Int
hqLength Names
localNamesOnly
  (DefinitionResults Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms Map Reference (DisplayObject () (Decl Symbol Ann))
types [HashQualified Name]
misses) <- IO DefinitionResults -> Backend IO DefinitionResults
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DefinitionResults -> Backend IO DefinitionResults)
-> IO DefinitionResults -> Backend IO DefinitionResults
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Transaction DefinitionResults -> IO DefinitionResults
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase do
    Codebase IO Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> [HashQualified Name]
-> Transaction DefinitionResults
forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> IncludeCycles
-> SearchType
-> [HashQualified Name]
-> Transaction DefinitionResults
definitionsByName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch IncludeCycles
DontIncludeCycles SearchType
Names.ExactName [HashQualified Name
query]
  let width :: Width
width = Maybe Width -> Width
mayDefaultWidth Maybe Width
renderWidth
  let docResults :: Name -> IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
      docResults :: Name -> IO [(Text, Text, Doc)]
docResults Name
name = do
        [Reference]
docRefs <- Codebase IO Symbol Ann -> Transaction [Reference] -> IO [Reference]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Transaction [Reference] -> IO [Reference])
-> Transaction [Reference] -> IO [Reference]
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [Reference]
docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
Names.ExactName Name
name
        PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> [Reference]
-> IO [(Text, Text, Doc, [Error])]
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [Error]))
renderDocRefs PrettyPrintEnvDecl
pped Width
width Codebase IO Symbol Ann
codebase Runtime Symbol
rt [Reference]
docRefs
          -- local server currently ignores doc eval errors
          IO [(Text, Text, Doc, [Error])]
-> ([(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Text, Text, Doc, [Error]) -> (Text, Text, Doc))
-> [(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Text
hqn, Text
h, Doc
doc, [Error]
_errs) -> (Text
hqn, Text
h, Doc
doc)

  let fqnPPE :: PrettyPrintEnv
fqnPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
  Map Reference TypeDefinition
typeDefinitions <-
    Map
  Reference
  (DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
-> (Reference
    -> DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))
    -> Backend IO TypeDefinition)
-> Backend IO (Map Reference TypeDefinition)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
t a -> (i -> a -> f b) -> f (t b)
ifor (Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     (Map Reference (DisplayObject () (Decl Symbol Ann)))
     (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
     (Reference, DisplayObject () (Decl Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> Map
     Reference
     (DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (Reference, DisplayObject () (Decl v a))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> s
-> t
typesToSyntaxOf Suffixify
suffixifyBindings Width
width PrettyPrintEnvDecl
pped (([(Reference, DisplayObject () (Decl Symbol Ann))]
 -> f [(Reference,
        DisplayObject
          (AnnotatedText (Element Reference))
          (AnnotatedText (Element Reference)))])
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> f (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
forall k' k v v'.
Ord k' =>
Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')]
Traversal
  (Map Reference (DisplayObject () (Decl Symbol Ann)))
  (Map
     Reference
     (DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference))))
  [(Reference, DisplayObject () (Decl Symbol Ann))]
  [(Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))]
Map.asList_ (([(Reference, DisplayObject () (Decl Symbol Ann))]
  -> f [(Reference,
         DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference)))])
 -> Map Reference (DisplayObject () (Decl Symbol Ann))
 -> f (Map
         Reference
         (DisplayObject
            (AnnotatedText (Element Reference))
            (AnnotatedText (Element Reference)))))
-> (((Reference, DisplayObject () (Decl Symbol Ann))
     -> f (Reference,
           DisplayObject
             (AnnotatedText (Element Reference))
             (AnnotatedText (Element Reference))))
    -> [(Reference, DisplayObject () (Decl Symbol Ann))]
    -> f [(Reference,
           DisplayObject
             (AnnotatedText (Element Reference))
             (AnnotatedText (Element Reference)))])
-> ((Reference, DisplayObject () (Decl Symbol Ann))
    -> f (Reference,
          DisplayObject
            (AnnotatedText (Element Reference))
            (AnnotatedText (Element Reference))))
-> Map Reference (DisplayObject () (Decl Symbol Ann))
-> f (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, DisplayObject () (Decl Symbol Ann))
 -> f (Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))))
-> [(Reference, DisplayObject () (Decl Symbol Ann))]
-> f [(Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference)))]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Reference, DisplayObject () (Decl Symbol Ann))]
  [(Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))]
  (Reference, DisplayObject () (Decl Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
traversed) Map Reference (DisplayObject () (Decl Symbol Ann))
types) \Reference
ref DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
tp -> do
      let hqTypeName :: HashQualified Name
hqTypeName = PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeNameOrHashOnly PrettyPrintEnv
fqnPPE Reference
ref
      [(Text, Text, Doc)]
docs <- IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)]
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)]
forall a b. (a -> b) -> a -> b
$ (IO [(Text, Text, Doc)]
-> (Name -> IO [(Text, Text, Doc)])
-> Maybe Name
-> IO [(Text, Text, Doc)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(Text, Text, Doc)] -> IO [(Text, Text, Doc)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Name -> IO [(Text, Text, Doc)]
docResults (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqTypeName))
      Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> Backend IO TypeDefinition
forall (m :: * -> *).
MonadIO m =>
Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> m TypeDefinition
mkTypeDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
pped Width
width Reference
ref [(Text, Text, Doc)]
docs DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
tp
  Map Reference TermDefinition
termDefinitions <-
    Map
  Reference
  (DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
-> (Reference
    -> DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))
    -> Backend IO TermDefinition)
-> Backend IO (Map Reference TermDefinition)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
t a -> (i -> a -> f b) -> f (t b)
ifor (Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     (Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
     (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Map
     Reference
     (DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (Reference, DisplayObject (Type v a) (Term v a))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> s
-> t
termsToSyntaxOf Suffixify
suffixifyBindings Width
width PrettyPrintEnvDecl
pped (([(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
 -> f [(Reference,
        DisplayObject
          (AnnotatedText (Element Reference))
          (AnnotatedText (Element Reference)))])
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> f (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
forall k' k v v'.
Ord k' =>
Traversal (Map k v) (Map k' v') [(k, v)] [(k', v')]
Traversal
  (Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
  (Map
     Reference
     (DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference))))
  [(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
  [(Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))]
Map.asList_ (([(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
  -> f [(Reference,
         DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference)))])
 -> Map
      Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> f (Map
         Reference
         (DisplayObject
            (AnnotatedText (Element Reference))
            (AnnotatedText (Element Reference)))))
-> (((Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
     -> f (Reference,
           DisplayObject
             (AnnotatedText (Element Reference))
             (AnnotatedText (Element Reference))))
    -> [(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
    -> f [(Reference,
           DisplayObject
             (AnnotatedText (Element Reference))
             (AnnotatedText (Element Reference)))])
-> ((Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
    -> f (Reference,
          DisplayObject
            (AnnotatedText (Element Reference))
            (AnnotatedText (Element Reference))))
-> Map
     Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> f (Map
        Reference
        (DisplayObject
           (AnnotatedText (Element Reference))
           (AnnotatedText (Element Reference))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> f (Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))))
-> [(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
-> f [(Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference)))]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  [(Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]
  [(Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))]
  (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
traversed) Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
terms) \Reference
reference DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
trm -> do
      let referent :: Referent
referent = Reference -> Referent
Referent.Ref Reference
reference
      let hqTermName :: HashQualified Name
hqTermName = PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termNameOrHashOnly PrettyPrintEnv
fqnPPE Referent
referent
      [(Text, Text, Doc)]
docs <- IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)]
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)] -> Backend IO [(Text, Text, Doc)]
forall a b. (a -> b) -> a -> b
$ (IO [(Text, Text, Doc)]
-> (Name -> IO [(Text, Text, Doc)])
-> Maybe Name
-> IO [(Text, Text, Doc)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([(Text, Text, Doc)] -> IO [(Text, Text, Doc)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) Name -> IO [(Text, Text, Doc)]
docResults (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqTermName))
      Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> Backend IO TermDefinition
mkTermDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
pped Width
width Reference
reference [(Text, Text, Doc)]
docs DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
trm
  let renderedDisplayTerms :: Map Text TermDefinition
renderedDisplayTerms = (Reference -> Text)
-> Map Reference TermDefinition -> Map Text TermDefinition
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Reference -> Text
Reference.toText Map Reference TermDefinition
termDefinitions
      renderedDisplayTypes :: Map Text TypeDefinition
renderedDisplayTypes = (Reference -> Text)
-> Map Reference TypeDefinition -> Map Text TypeDefinition
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Reference -> Text
Reference.toText Map Reference TypeDefinition
typeDefinitions
      renderedMisses :: [Text]
renderedMisses = (HashQualified Name -> Text) -> [HashQualified Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashQualified Name -> Text
HQ.toText [HashQualified Name]
misses
  DefinitionDisplayResults -> Backend IO DefinitionDisplayResults
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionDisplayResults -> Backend IO DefinitionDisplayResults)
-> DefinitionDisplayResults -> Backend IO DefinitionDisplayResults
forall a b. (a -> b) -> a -> b
$
    Map Text TermDefinition
-> Map Text TypeDefinition -> [Text] -> DefinitionDisplayResults
DefinitionDisplayResults
      Map Text TermDefinition
renderedDisplayTerms
      Map Text TypeDefinition
renderedDisplayTypes
      [Text]
renderedMisses

-- | Find the term referenced by the given name and return a display object for it.
termDisplayObjectByName :: Codebase m Symbol Ann -> NameSearch Sqlite.Transaction -> Name -> Sqlite.Transaction (Maybe (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
termDisplayObjectByName :: forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
termDisplayObjectByName Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch Name
name = MaybeT
  Transaction
  (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  Set Referent
refs <- Transaction (Set Referent) -> MaybeT Transaction (Set Referent)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Set Referent) -> MaybeT Transaction (Set Referent))
-> Transaction (Set Referent) -> MaybeT Transaction (Set Referent)
forall a b. (a -> b) -> a -> b
$ Search Transaction Referent
-> SearchType -> HashQualified Name -> Transaction (Set Referent)
forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
NameSearch.lookupRelativeHQRefs' (NameSearch Transaction -> Search Transaction Referent
forall (m :: * -> *). NameSearch m -> Search m Referent
NS.termSearch NameSearch Transaction
nameSearch) SearchType
NS.ExactName (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
name)
  Referent
ref <- (NESet Referent -> Referent)
-> MaybeT Transaction (NESet Referent)
-> MaybeT Transaction Referent
forall a b.
(a -> b) -> MaybeT Transaction a -> MaybeT Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESet Referent -> Referent
forall a. NESet a -> a
NESet.findMin (MaybeT Transaction (NESet Referent)
 -> MaybeT Transaction Referent)
-> (Maybe (NESet Referent) -> MaybeT Transaction (NESet Referent))
-> Maybe (NESet Referent)
-> MaybeT Transaction Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NESet Referent) -> MaybeT Transaction (NESet Referent)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (NESet Referent) -> MaybeT Transaction Referent)
-> Maybe (NESet Referent) -> MaybeT Transaction Referent
forall a b. (a -> b) -> a -> b
$ Set Referent -> Maybe (NESet Referent)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet Set Referent
refs
  case Referent
ref of
    Referent.Ref Reference
r -> (Reference
r,) (DisplayObject (Type Symbol Ann) (Term Symbol Ann)
 -> (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> MaybeT
     Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> MaybeT
     Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codebase m Symbol Ann
-> Reference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Reference
-> Transaction (DisplayObject (Type Symbol Ann) (Term Symbol Ann))
Backend.displayTerm Codebase m Symbol Ann
codebase Reference
r)
    Referent.Con ConstructorReference
_ ConstructorType
_ ->
      -- TODO: Should we error here or some other sensible thing rather than returning no
      -- result?
      MaybeT
  Transaction
  (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall a. MaybeT Transaction a
forall (f :: * -> *) a. Alternative f => f a
empty

termDefinitionByName ::
  Codebase IO Symbol Ann ->
  PPED.PrettyPrintEnvDecl ->
  NameSearch Sqlite.Transaction ->
  Width ->
  Rt.Runtime Symbol ->
  Name ->
  Backend IO (Maybe TermDefinition)
termDefinitionByName :: Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TermDefinition)
termDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
pped NameSearch Transaction
nameSearch Width
width Runtime Symbol
rt Name
name = MaybeT (Backend IO) TermDefinition
-> Backend IO (Maybe TermDefinition)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Backend IO) TermDefinition
 -> Backend IO (Maybe TermDefinition))
-> MaybeT (Backend IO) TermDefinition
-> Backend IO (Maybe TermDefinition)
forall a b. (a -> b) -> a -> b
$ do
  let biasedPPED :: PrettyPrintEnvDecl
biasedPPED = [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo [Name
name] PrettyPrintEnvDecl
pped
  (Reference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
displayObject, [Reference]
docRefs) <- (Transaction
   (Maybe
      (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
       [Reference]))
 -> Backend
      IO
      (Maybe
         (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
          [Reference])))
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference])
-> MaybeT
     (Backend IO)
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference])
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT (IO
  (Maybe
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference]))
-> Backend
     IO
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
         [Reference]))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Maybe
      (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
       [Reference]))
 -> Backend
      IO
      (Maybe
         (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
          [Reference])))
-> (Transaction
      (Maybe
         (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
          [Reference]))
    -> IO
         (Maybe
            (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
             [Reference])))
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
         [Reference]))
-> Backend
     IO
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
         [Reference]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
         [Reference]))
-> IO
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
         [Reference]))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase) (MaybeT
   Transaction
   (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
    [Reference])
 -> MaybeT
      (Backend IO)
      (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
       [Reference]))
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference])
-> MaybeT
     (Backend IO)
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference])
forall a b. (a -> b) -> a -> b
$ do
    (Reference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
displayObject) <- Transaction
  (Maybe
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction
   (Maybe
      (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
 -> MaybeT
      Transaction
      (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe
        (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
termDisplayObjectByName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch Name
name
    [Reference]
docRefs <- Transaction [Reference] -> MaybeT Transaction [Reference]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [Reference] -> MaybeT Transaction [Reference])
-> Transaction [Reference] -> MaybeT Transaction [Reference]
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [Reference]
Backend.docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
NS.ExactName Name
name
    (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
 [Reference])
-> MaybeT
     Transaction
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann),
      [Reference])
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
displayObject, [Reference]
docRefs)
  [(Text, Text, Doc)]
renderedDocs <-
    IO [(Text, Text, Doc)] -> MaybeT (Backend IO) [(Text, Text, Doc)]
forall a. IO a -> MaybeT (Backend IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, Text, Doc)] -> MaybeT (Backend IO) [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)]
-> MaybeT (Backend IO) [(Text, Text, Doc)]
forall a b. (a -> b) -> a -> b
$
      PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> [Reference]
-> IO [(Text, Text, Doc, [Error])]
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [Error]))
renderDocRefs PrettyPrintEnvDecl
pped Width
width Codebase IO Symbol Ann
codebase Runtime Symbol
rt [Reference]
docRefs
        -- local server currently ignores doc eval errors
        IO [(Text, Text, Doc, [Error])]
-> ([(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Text, Text, Doc, [Error]) -> (Text, Text, Doc))
-> [(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Text
hqn, Text
h, Doc
doc, [Error]
_errs) -> (Text
hqn, Text
h, Doc
doc)
  let (Reference
_ref, DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
syntaxDO) = Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
     (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> (Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))
forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (Reference, DisplayObject (Type v a) (Term v a))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> s
-> t
Backend.termsToSyntaxOf (Bool -> Suffixify
Suffixify Bool
False) Width
width PrettyPrintEnvDecl
pped ((Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
 -> f (Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))))
-> (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
-> f (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
forall a. a -> a
Traversal
  (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
  (Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
id (Reference
ref, DisplayObject (Type Symbol Ann) (Term Symbol Ann)
displayObject)
  Backend IO TermDefinition -> MaybeT (Backend IO) TermDefinition
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Backend IO TermDefinition -> MaybeT (Backend IO) TermDefinition)
-> Backend IO TermDefinition -> MaybeT (Backend IO) TermDefinition
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> Backend IO TermDefinition
Backend.mkTermDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
biasedPPED Width
width Reference
ref [(Text, Text, Doc)]
renderedDocs DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
syntaxDO

-- | Find the type referenced by the given name and return a display object for it.
typeDisplayObjectByName :: Codebase m Symbol Ann -> NameSearch Sqlite.Transaction -> Name -> Sqlite.Transaction (Maybe (TypeReference, DisplayObject () (DD.Decl Symbol Ann)))
typeDisplayObjectByName :: forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
typeDisplayObjectByName Codebase m Symbol Ann
codebase NameSearch Transaction
nameSearch Name
name = MaybeT Transaction (Reference, DisplayObject () (Decl Symbol Ann))
-> Transaction
     (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
  Set Reference
refs <- Transaction (Set Reference) -> MaybeT Transaction (Set Reference)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (Set Reference) -> MaybeT Transaction (Set Reference))
-> Transaction (Set Reference)
-> MaybeT Transaction (Set Reference)
forall a b. (a -> b) -> a -> b
$ Search Transaction Reference
-> SearchType -> HashQualified Name -> Transaction (Set Reference)
forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
NameSearch.lookupRelativeHQRefs' (NameSearch Transaction -> Search Transaction Reference
forall (m :: * -> *). NameSearch m -> Search m Reference
NS.typeSearch NameSearch Transaction
nameSearch) SearchType
NS.ExactName (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
name)
  Reference
ref <- (NESet Reference -> Reference)
-> MaybeT Transaction (NESet Reference)
-> MaybeT Transaction Reference
forall a b.
(a -> b) -> MaybeT Transaction a -> MaybeT Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESet Reference -> Reference
forall a. NESet a -> a
NESet.findMin (MaybeT Transaction (NESet Reference)
 -> MaybeT Transaction Reference)
-> (Maybe (NESet Reference)
    -> MaybeT Transaction (NESet Reference))
-> Maybe (NESet Reference)
-> MaybeT Transaction Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NESet Reference) -> MaybeT Transaction (NESet Reference)
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe (NESet Reference) -> MaybeT Transaction Reference)
-> Maybe (NESet Reference) -> MaybeT Transaction Reference
forall a b. (a -> b) -> a -> b
$ Set Reference -> Maybe (NESet Reference)
forall a. Set a -> Maybe (NESet a)
NESet.nonEmptySet Set Reference
refs
  (DisplayObject () (Decl Symbol Ann)
 -> (Reference, DisplayObject () (Decl Symbol Ann)))
-> MaybeT Transaction (DisplayObject () (Decl Symbol Ann))
-> MaybeT
     Transaction (Reference, DisplayObject () (Decl Symbol Ann))
forall a b.
(a -> b) -> MaybeT Transaction a -> MaybeT Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference
ref,) (MaybeT Transaction (DisplayObject () (Decl Symbol Ann))
 -> MaybeT
      Transaction (Reference, DisplayObject () (Decl Symbol Ann)))
-> (Transaction (DisplayObject () (Decl Symbol Ann))
    -> MaybeT Transaction (DisplayObject () (Decl Symbol Ann)))
-> Transaction (DisplayObject () (Decl Symbol Ann))
-> MaybeT
     Transaction (Reference, DisplayObject () (Decl Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (DisplayObject () (Decl Symbol Ann))
-> MaybeT Transaction (DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction (DisplayObject () (Decl Symbol Ann))
 -> MaybeT
      Transaction (Reference, DisplayObject () (Decl Symbol Ann)))
-> Transaction (DisplayObject () (Decl Symbol Ann))
-> MaybeT
     Transaction (Reference, DisplayObject () (Decl Symbol Ann))
forall a b. (a -> b) -> a -> b
$ Codebase m Symbol Ann
-> Reference -> Transaction (DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Reference -> Transaction (DisplayObject () (Decl Symbol Ann))
Backend.displayType Codebase m Symbol Ann
codebase Reference
ref

typeDefinitionByName ::
  Codebase IO Symbol Ann ->
  PPED.PrettyPrintEnvDecl ->
  NameSearch Sqlite.Transaction ->
  Width ->
  Rt.Runtime Symbol ->
  Name ->
  Backend IO (Maybe TypeDefinition)
typeDefinitionByName :: Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TypeDefinition)
typeDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
pped NameSearch Transaction
nameSearch Width
width Runtime Symbol
rt Name
name = MaybeT (Backend IO) TypeDefinition
-> Backend IO (Maybe TypeDefinition)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Backend IO) TypeDefinition
 -> Backend IO (Maybe TypeDefinition))
-> MaybeT (Backend IO) TypeDefinition
-> Backend IO (Maybe TypeDefinition)
forall a b. (a -> b) -> a -> b
$ do
  let biasedPPED :: PrettyPrintEnvDecl
biasedPPED = [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo [Name
name] PrettyPrintEnvDecl
pped
  (Reference
ref, DisplayObject () (Decl Symbol Ann)
displayObject, [Reference]
docRefs) <- (Transaction
   (Maybe
      (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
 -> Backend
      IO
      (Maybe
         (Reference, DisplayObject () (Decl Symbol Ann), [Reference])))
-> MaybeT
     Transaction
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
-> MaybeT
     (Backend IO)
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT (IO
  (Maybe
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
-> Backend
     IO
     (Maybe
        (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Maybe
      (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
 -> Backend
      IO
      (Maybe
         (Reference, DisplayObject () (Decl Symbol Ann), [Reference])))
-> (Transaction
      (Maybe
         (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
    -> IO
         (Maybe
            (Reference, DisplayObject () (Decl Symbol Ann), [Reference])))
-> Transaction
     (Maybe
        (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
-> Backend
     IO
     (Maybe
        (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction
     (Maybe
        (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
-> IO
     (Maybe
        (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase) (MaybeT
   Transaction
   (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
 -> MaybeT
      (Backend IO)
      (Reference, DisplayObject () (Decl Symbol Ann), [Reference]))
-> MaybeT
     Transaction
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
-> MaybeT
     (Backend IO)
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
forall a b. (a -> b) -> a -> b
$ do
    (Reference
ref, DisplayObject () (Decl Symbol Ann)
displayObject) <- Transaction (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
-> MaybeT
     Transaction (Reference, DisplayObject () (Decl Symbol Ann))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Transaction
   (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
 -> MaybeT
      Transaction (Reference, DisplayObject () (Decl Symbol Ann)))
-> Transaction
     (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
-> MaybeT
     Transaction (Reference, DisplayObject () (Decl Symbol Ann))
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> NameSearch Transaction
-> Name
-> Transaction
     (Maybe (Reference, DisplayObject () (Decl Symbol Ann)))
typeDisplayObjectByName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch Name
name
    [Reference]
docRefs <- Transaction [Reference] -> MaybeT Transaction [Reference]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Transaction [Reference] -> MaybeT Transaction [Reference])
-> Transaction [Reference] -> MaybeT Transaction [Reference]
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [Reference]
Backend.docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
NS.ExactName Name
name
    (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
-> MaybeT
     Transaction
     (Reference, DisplayObject () (Decl Symbol Ann), [Reference])
forall a. a -> MaybeT Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference
ref, DisplayObject () (Decl Symbol Ann)
displayObject, [Reference]
docRefs)
  [(Text, Text, Doc)]
renderedDocs <-
    IO [(Text, Text, Doc)] -> MaybeT (Backend IO) [(Text, Text, Doc)]
forall a. IO a -> MaybeT (Backend IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, Text, Doc)] -> MaybeT (Backend IO) [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)]
-> MaybeT (Backend IO) [(Text, Text, Doc)]
forall a b. (a -> b) -> a -> b
$
      PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> [Reference]
-> IO [(Text, Text, Doc, [Error])]
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [Error]))
renderDocRefs PrettyPrintEnvDecl
pped Width
width Codebase IO Symbol Ann
codebase Runtime Symbol
rt [Reference]
docRefs
        -- local server currently ignores doc eval errors
        IO [(Text, Text, Doc, [Error])]
-> ([(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)])
-> IO [(Text, Text, Doc)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Text, Text, Doc, [Error]) -> (Text, Text, Doc))
-> [(Text, Text, Doc, [Error])] -> [(Text, Text, Doc)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \(Text
hqn, Text
h, Doc
doc, [Error]
_errs) -> (Text
hqn, Text
h, Doc
doc)
  let (Reference
_ref, DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
syntaxDO) = Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     (Reference, DisplayObject () (Decl Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
     (Reference, DisplayObject () (Decl Symbol Ann))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> (Reference, DisplayObject () (Decl Symbol Ann))
-> (Reference,
    DisplayObject
      (AnnotatedText (Element Reference))
      (AnnotatedText (Element Reference)))
forall v a s t.
(Var v, Ord a) =>
Suffixify
-> Width
-> PrettyPrintEnvDecl
-> Traversal
     s
     t
     (Reference, DisplayObject () (Decl v a))
     (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
-> s
-> t
Backend.typesToSyntaxOf (Bool -> Suffixify
Suffixify Bool
False) Width
width PrettyPrintEnvDecl
pped ((Reference, DisplayObject () (Decl Symbol Ann))
 -> f (Reference,
       DisplayObject
         (AnnotatedText (Element Reference))
         (AnnotatedText (Element Reference))))
-> (Reference, DisplayObject () (Decl Symbol Ann))
-> f (Reference,
      DisplayObject
        (AnnotatedText (Element Reference))
        (AnnotatedText (Element Reference)))
forall a. a -> a
Traversal
  (Reference, DisplayObject () (Decl Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
  (Reference, DisplayObject () (Decl Symbol Ann))
  (Reference,
   DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference)))
id (Reference
ref, DisplayObject () (Decl Symbol Ann)
displayObject)
  Backend IO TypeDefinition -> MaybeT (Backend IO) TypeDefinition
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Backend IO TypeDefinition -> MaybeT (Backend IO) TypeDefinition)
-> Backend IO TypeDefinition -> MaybeT (Backend IO) TypeDefinition
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> Backend IO TypeDefinition
forall (m :: * -> *).
MonadIO m =>
Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> Width
-> Reference
-> [(Text, Text, Doc)]
-> DisplayObject
     (AnnotatedText (Element Reference))
     (AnnotatedText (Element Reference))
-> m TypeDefinition
Backend.mkTypeDefinition Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
biasedPPED Width
width Reference
ref [(Text, Text, Doc)]
renderedDocs DisplayObject
  (AnnotatedText (Element Reference))
  (AnnotatedText (Element Reference))
syntaxDO