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 qualified as Path
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.Runtime (Runtime)
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.Absolute ->
  -- | 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.
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  -- | The name, hash, or both, of the definition to display.
  HQ.HashQualified Name ->
  Backend IO DefinitionDisplayResults
prettyDefinitionsForHQName :: Absolute
-> CausalBranch Transaction
-> Maybe Width
-> Suffixify
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> HashQualified Name
-> Backend IO DefinitionDisplayResults
prettyDefinitionsForHQName Absolute
perspective CausalBranch Transaction
shallowRoot Maybe Width
renderWidth Suffixify
suffixifyBindings Runtime Symbol
rt Codebase IO Symbol Ann
codebase HashQualified Name
perspectiveQuery = do
  result <- IO (Either BackendError (Absolute, HashQualified Name))
-> Backend IO (Either BackendError (Absolute, HashQualified Name))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either BackendError (Absolute, HashQualified Name))
 -> Backend IO (Either BackendError (Absolute, HashQualified Name)))
-> (Transaction
      (Either BackendError (Absolute, HashQualified Name))
    -> IO (Either BackendError (Absolute, HashQualified Name)))
-> Transaction (Either BackendError (Absolute, HashQualified Name))
-> Backend IO (Either BackendError (Absolute, HashQualified Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Transaction (Either BackendError (Absolute, HashQualified Name))
-> IO (Either BackendError (Absolute, 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 (Absolute, HashQualified Name))
 -> Backend IO (Either BackendError (Absolute, HashQualified Name)))
-> Transaction (Either BackendError (Absolute, HashQualified Name))
-> Backend IO (Either BackendError (Absolute, HashQualified Name))
forall a b. (a -> b) -> a -> b
$ do
    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
    Local.relocateToNameRoot perspective perspectiveQuery shallowBranch
  (namesRoot, query) <- either throwError pure 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`,o
  -- 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 = 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
  hqLength <- liftIO $ Codebase.runTransaction codebase $ Codebase.hashLength
  (localNamesOnly, unbiasedPPED) <- namesAtPathFromRootBranchHash codebase shallowRoot $ Path.unabsolute namesRoot
  let pped = [Name] -> PrettyPrintEnvDecl -> PrettyPrintEnvDecl
PPED.biasTo [Name]
biases PrettyPrintEnvDecl
unbiasedPPED
  let nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
makeNameSearch Int
hqLength Names
localNamesOnly
  (DefinitionResults terms types misses) <- liftIO $ Codebase.runTransaction codebase do
    definitionsByName codebase nameSearch DontIncludeCycles Names.ExactName [query]
  let width = Maybe Width -> Width
mayDefaultWidth Maybe Width
renderWidth
  let docResults :: Name -> IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
      docResults Name
name = do
        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
        renderDocRefs pped width codebase rt docRefs
          -- local server currently ignores doc eval errors
          <&> fmap \(Text
hqn, Text
h, Doc
doc, [DecompError]
_errs) -> (Text
hqn, Text
h, Doc
doc)

  let fqnPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
  typeDefinitions <-
    ifor (typesToSyntaxOf suffixifyBindings width pped (Map.asList_ . traversed) 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
      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))
      mkTypeDefinition codebase pped width ref docs tp
  termDefinitions <-
    ifor (termsToSyntaxOf suffixifyBindings width pped (Map.asList_ . traversed) 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
      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))
      mkTermDefinition codebase pped width reference docs trm
  let 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 = (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 = (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
  pure $
    DefinitionDisplayResults
      renderedDisplayTerms
      renderedDisplayTypes
      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
  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)
  ref <- fmap NESet.findMin . hoistMaybe $ NESet.nonEmptySet refs
  case 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 ->
  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
  (ref, displayObject, 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
    (ref, 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
    docRefs <- lift $ Backend.docsForDefinitionName codebase nameSearch NS.ExactName name
    pure (ref, displayObject, docRefs)
  renderedDocs <-
    liftIO $
      renderDocRefs pped width codebase rt docRefs
        -- local server currently ignores doc eval errors
        <&> fmap \(Text
hqn, Text
h, Doc
doc, [DecompError]
_errs) -> (Text
hqn, Text
h, Doc
doc)
  let (_ref, syntaxDO) = Backend.termsToSyntaxOf (Suffixify False) width pped id (ref, displayObject)
  lift $ Backend.mkTermDefinition codebase biasedPPED width ref renderedDocs 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
  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)
  ref <- fmap NESet.findMin . hoistMaybe $ NESet.nonEmptySet refs
  fmap (ref,) . lift $ Backend.displayType codebase ref

typeDefinitionByName ::
  Codebase IO Symbol Ann ->
  PPED.PrettyPrintEnvDecl ->
  NameSearch Sqlite.Transaction ->
  Width ->
  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
  (ref, displayObject, 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
    (ref, 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
    docRefs <- lift $ Backend.docsForDefinitionName codebase nameSearch NS.ExactName name
    pure (ref, displayObject, docRefs)
  renderedDocs <-
    liftIO $
      renderDocRefs pped width codebase rt docRefs
        -- local server currently ignores doc eval errors
        <&> fmap \(Text
hqn, Text
h, Doc
doc, [DecompError]
_errs) -> (Text
hqn, Text
h, Doc
doc)
  let (_ref, syntaxDO) = Backend.typesToSyntaxOf (Suffixify False) width pped id (ref, displayObject)
  lift $ Backend.mkTypeDefinition codebase biasedPPED width ref renderedDocs syntaxDO