{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.Local.Endpoints.Definitions where

import Data.Bifoldable (Bifoldable (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Set qualified as Set
import Servant
  ( QueryParam,
    QueryParams,
    ServerT,
    (:<|>) (..),
    (:>),
  )
import Servant.Docs
  ( DocQueryParam (..),
    ParamKind (..),
    ToParam (..),
    ToSample (..),
    noSamples,
  )
import U.Codebase.Causal qualified as Causal
import U.Codebase.Reference (TermReferenceId)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.NamesWithHistory (SearchType (..))
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Project
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Runtime (Runtime)
import Unison.Server.Backend qualified as Backend
import Unison.Server.Local.Definitions qualified as Local
import Unison.Server.NameSearch.FromNames (makeNameSearch)
import Unison.Server.QueryResult (QueryResult (..))
import Unison.Server.SearchResult (SearchResult (..), TermResult (..), TypeResult (..))
import Unison.Server.Types
  ( APIGet,
    APIHeaders,
    DefinitionDisplayResults,
    DefinitionSearchResult (..),
    DefinitionSearchResults (..),
    RequiredQueryParam,
    Suffixify (..),
    TermOrTypeSummary (..),
    defaultWidth,
    setCacheControl,
  )
import Unison.Symbol (Symbol)
import Unison.Util.Defns (Defns (..))
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Pretty (Width)

type DefinitionsAPI =
  ("getDefinition" :> GetDefinitionEndpoint)
    :<|> ("getDefinitionDependents" :> GetDefinitionDependentsEndpoint)
    :<|> ("getDefinitionDependencies" :> GetDefinitionDependenciesEndpoint)

-- More endpoints could go here in the future

type GetDefinitionEndpoint =
  QueryParam "relativeTo" Path.Path
    :> QueryParams "names" (HQ.HashQualified Name)
    :> QueryParam "renderWidth" Width
    :> QueryParam "suffixifyBindings" Suffixify
    :> APIGet DefinitionDisplayResults

type GetDefinitionDependentsEndpoint =
  RequiredQueryParam "name" (HQ.HashQualified Name)
    :> QueryParam "renderWidth" Width
    :> APIGet DefinitionSearchResults

type GetDefinitionDependenciesEndpoint =
  RequiredQueryParam "name" (HQ.HashQualified Name)
    :> QueryParam "renderWidth" Width
    :> APIGet DefinitionSearchResults

instance ToParam (QueryParam "renderWidth" Width) where
  toParam :: Proxy (QueryParam "renderWidth" Width) -> DocQueryParam
toParam Proxy (QueryParam "renderWidth" Width)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"renderWidth"
      [String
"80", String
"100", String
"120"]
      ( String
"The preferred maximum line width (in characters) of the source code of "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"definitions to be rendered. "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the render width is assumed to be "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Width -> String
forall a. Show a => a -> String
show Width
defaultWidth
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
      )
      ParamKind
Normal

instance ToParam (QueryParam "suffixifyBindings" Suffixify) where
  toParam :: Proxy (QueryParam "suffixifyBindings" Suffixify) -> DocQueryParam
toParam Proxy (QueryParam "suffixifyBindings" Suffixify)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"suffixifyBindings"
      [String
"True", String
"False"]
      ( String
"If True or absent, renders definitions using the shortest unambiguous "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"suffix. If False, uses the fully qualified name. "
      )
      ParamKind
Normal

instance ToParam (QueryParam "relativeTo" Path.Path) where
  toParam :: Proxy (QueryParam "relativeTo" Path) -> DocQueryParam
toParam Proxy (QueryParam "relativeTo" Path)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"relativeTo"
      []
      ( String
"The namespace relative to which names will be resolved and displayed. "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the root namespace will be used."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"E.g. base.List"
      )
      ParamKind
Normal

instance ToParam (QueryParam "namespace" Path.Path) where
  toParam :: Proxy (QueryParam "namespace" Path) -> DocQueryParam
toParam Proxy (QueryParam "namespace" Path)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"namespace"
      []
      ( String
"The namespace required by the endpoint."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If left absent, the relativeTo namespace will be used."
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"E.g. base.List"
      )
      ParamKind
Normal

instance ToParam (QueryParams "names" (HQ.HashQualified Name)) where
  toParam :: Proxy (QueryParams "names" (HashQualified Name)) -> DocQueryParam
toParam Proxy (QueryParams "names" (HashQualified Name))
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"names"
      [String
".base.List", String
"foo.bar", String
"@abc123"]
      (String
"A fully qualified name, hash-qualified name, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"or hash.")
      ParamKind
List

instance ToSample DefinitionDisplayResults where
  toSamples :: Proxy DefinitionDisplayResults
-> [(Text, DefinitionDisplayResults)]
toSamples Proxy DefinitionDisplayResults
_ = [(Text, DefinitionDisplayResults)]
forall a. [(Text, a)]
noSamples

getDefinitionDependentsEndpoint ::
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  HQ.HashQualified Name ->
  Maybe Width ->
  Backend.Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependentsEndpoint :: Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> HashQualified Name
-> Maybe Width
-> Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependentsEndpoint Runtime Symbol
_rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch HashQualified Name
hqn Maybe Width
mayWidth = do
  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
  CausalBranch Transaction
rootCausal <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
Backend.resolveProjectRoot Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
  (DefnsF Set TermReferenceId TermReferenceId
dependents, Names
namesWithoutLibdeps) <- (forall x. Transaction x -> IO x)
-> Backend
     Transaction (DefnsF Set TermReferenceId TermReferenceId, Names)
-> Backend IO (DefnsF Set TermReferenceId TermReferenceId, Names)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
Backend.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) (Backend
   Transaction (DefnsF Set TermReferenceId TermReferenceId, Names)
 -> Backend IO (DefnsF Set TermReferenceId TermReferenceId, Names))
-> Backend
     Transaction (DefnsF Set TermReferenceId TermReferenceId, Names)
-> Backend IO (DefnsF Set TermReferenceId TermReferenceId, Names)
forall a b. (a -> b) -> a -> b
$ do
    Branch Transaction
rootBranch <- Transaction (Branch Transaction)
-> Backend Transaction (Branch 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 (Branch Transaction)
 -> Backend Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
-> Backend Transaction (Branch Transaction)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> CausalHash -> Transaction (Branch Transaction)
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> Transaction (Branch Transaction)
Codebase.expectBranchForHashTx Codebase IO Symbol Ann
codebase (CausalBranch Transaction -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
Causal.causalHash CausalBranch Transaction
rootCausal)
    let rootBranch0 :: Branch0 Transaction
rootBranch0 = Branch Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch Transaction
rootBranch
    let rootBranch0WithoutLibdeps :: Branch0 Transaction
rootBranch0WithoutLibdeps = Branch0 Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 Transaction
rootBranch0
    let namesWithoutLibdeps :: Names
namesWithoutLibdeps = Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 Transaction -> Names) -> Branch0 Transaction -> Names
forall a b. (a -> b) -> a -> b
$ Branch0 Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 Transaction
rootBranch0
    let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
makeNameSearch Int
hqLength Names
namesWithoutLibdeps
    QueryResult {[SearchResult]
hits :: [SearchResult]
$sel:hits:QueryResult :: QueryResult -> [SearchResult]
hits} <- Transaction QueryResult -> Backend Transaction QueryResult
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 QueryResult -> Backend Transaction QueryResult)
-> Transaction QueryResult -> Backend Transaction QueryResult
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
Backend.hqNameQuery Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
ExactName [HashQualified Name
hqn]

    let defs :: Defns (Set Referent) (Set Reference)
defs =
          [SearchResult]
hits [SearchResult]
-> ([SearchResult] -> Defns (Set Referent) (Set Reference))
-> Defns (Set Referent) (Set Reference)
forall a b. a -> (a -> b) -> b
& (SearchResult -> Defns (Set Referent) (Set Reference))
-> [SearchResult] -> Defns (Set Referent) (Set Reference)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
            Tp TypeResult {Reference
reference :: Reference
$sel:reference:TypeResult :: TypeResult -> Reference
reference} -> Defns {$sel:terms:Defns :: Set Referent
terms = Set Referent
forall a. Set a
Set.empty, $sel:types:Defns :: Set Reference
types = (Reference -> Set Reference
forall a. a -> Set a
Set.singleton Reference
reference)}
            Tm TermResult {Referent
referent :: Referent
$sel:referent:TermResult :: TermResult -> Referent
referent} -> Defns {$sel:terms:Defns :: Set Referent
terms = (Referent -> Set Referent
forall a. a -> Set a
Set.singleton Referent
referent), $sel:types:Defns :: Set Reference
types = Set Reference
forall a. Set a
Set.empty}

    DefnsF Set TermReferenceId TermReferenceId
dependents <- Transaction (DefnsF Set TermReferenceId TermReferenceId)
-> Backend Transaction (DefnsF Set TermReferenceId TermReferenceId)
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 (DefnsF Set TermReferenceId TermReferenceId)
 -> Backend
      Transaction (DefnsF Set TermReferenceId TermReferenceId))
-> Transaction (DefnsF Set TermReferenceId TermReferenceId)
-> Backend Transaction (DefnsF Set TermReferenceId TermReferenceId)
forall a b. (a -> b) -> a -> b
$ Branch0 Transaction
-> Defns (Set Referent) (Set Reference)
-> Transaction (DefnsF Set TermReferenceId TermReferenceId)
forall (m :: * -> *).
Branch0 m
-> Defns (Set Referent) (Set Reference)
-> Transaction (DefnsF Set TermReferenceId TermReferenceId)
Codebase.dependentsWithinBranchScope Branch0 Transaction
rootBranch0WithoutLibdeps Defns (Set Referent) (Set Reference)
defs
    (DefnsF Set TermReferenceId TermReferenceId, Names)
-> Backend
     Transaction (DefnsF Set TermReferenceId TermReferenceId, Names)
forall a. a -> Backend Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefnsF Set TermReferenceId TermReferenceId
dependents, Names
namesWithoutLibdeps)

  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithoutLibdeps) Suffixifier
PPE.dontSuffixify
  Defns [DefinitionSearchResult] [DefinitionSearchResult]
definitionSearchResults <-
    DefnsF Set TermReferenceId TermReferenceId
dependents
      DefnsF Set TermReferenceId TermReferenceId
-> (DefnsF Set TermReferenceId TermReferenceId
    -> Backend
         IO (Defns [DefinitionSearchResult] [DefinitionSearchResult]))
-> Backend
     IO (Defns [DefinitionSearchResult] [DefinitionSearchResult])
forall a b. a -> (a -> b) -> b
& (Set TermReferenceId -> Backend IO [DefinitionSearchResult])
-> (Set TermReferenceId -> Backend IO [DefinitionSearchResult])
-> DefnsF Set TermReferenceId TermReferenceId
-> Backend
     IO (Defns [DefinitionSearchResult] [DefinitionSearchResult])
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((TermReferenceId -> Backend IO (Maybe DefinitionSearchResult))
-> [TermReferenceId] -> Backend IO [DefinitionSearchResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither (PrettyPrintEnvDecl
-> TermReferenceId -> Backend IO (Maybe DefinitionSearchResult)
doTerm PrettyPrintEnvDecl
pped) ([TermReferenceId] -> Backend IO [DefinitionSearchResult])
-> (Set TermReferenceId -> [TermReferenceId])
-> Set TermReferenceId
-> Backend IO [DefinitionSearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TermReferenceId -> [TermReferenceId]
forall a. Set a -> [a]
Set.toList) ((TermReferenceId -> Backend IO (Maybe DefinitionSearchResult))
-> [TermReferenceId] -> Backend IO [DefinitionSearchResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither (PrettyPrintEnvDecl
-> TermReferenceId -> Backend IO (Maybe DefinitionSearchResult)
doType PrettyPrintEnvDecl
pped) ([TermReferenceId] -> Backend IO [DefinitionSearchResult])
-> (Set TermReferenceId -> [TermReferenceId])
-> Set TermReferenceId
-> Backend IO [DefinitionSearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TermReferenceId -> [TermReferenceId]
forall a. Set a -> [a]
Set.toList)
  Defns [DefinitionSearchResult] [DefinitionSearchResult]
definitionSearchResults
    Defns [DefinitionSearchResult] [DefinitionSearchResult]
-> (Defns [DefinitionSearchResult] [DefinitionSearchResult]
    -> [DefinitionSearchResult])
-> [DefinitionSearchResult]
forall a b. a -> (a -> b) -> b
& Defns [DefinitionSearchResult] [DefinitionSearchResult]
-> [DefinitionSearchResult]
forall m. Monoid m => Defns m m -> m
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold
    [DefinitionSearchResult]
-> ([DefinitionSearchResult] -> DefinitionSearchResults)
-> DefinitionSearchResults
forall a b. a -> (a -> b) -> b
& [DefinitionSearchResult] -> DefinitionSearchResults
DefinitionSearchResults
    DefinitionSearchResults
-> (DefinitionSearchResults -> APIHeaders DefinitionSearchResults)
-> APIHeaders DefinitionSearchResults
forall a b. a -> (a -> b) -> b
& DefinitionSearchResults -> APIHeaders DefinitionSearchResults
forall v. v -> APIHeaders v
setCacheControl
    APIHeaders DefinitionSearchResults
-> (APIHeaders DefinitionSearchResults
    -> Backend IO (APIHeaders DefinitionSearchResults))
-> Backend IO (APIHeaders DefinitionSearchResults)
forall a b. a -> (a -> b) -> b
& APIHeaders DefinitionSearchResults
-> Backend IO (APIHeaders DefinitionSearchResults)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    project :: ProjectName
project = ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch.project
    branchRef :: ProjectBranchName
branchRef = ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch.branch
    doTerm :: PPED.PrettyPrintEnvDecl -> TermReferenceId -> Backend.Backend IO (Maybe DefinitionSearchResult)
    doTerm :: PrettyPrintEnvDecl
-> TermReferenceId -> Backend IO (Maybe DefinitionSearchResult)
doTerm PrettyPrintEnvDecl
pped TermReferenceId
refId = MaybeT (Backend IO) DefinitionSearchResult
-> Backend IO (Maybe DefinitionSearchResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      let referent :: Referent
referent = TermReferenceId -> Referent
Referent.fromTermReferenceId TermReferenceId
refId
      Name
fqn <- Maybe Name -> MaybeT (Backend IO) Name
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe Name -> MaybeT (Backend IO) Name)
-> Maybe Name -> MaybeT (Backend IO) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Maybe Name)
-> HashQualified Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Referent
referent
      TermSummary
summary <- Backend IO TermSummary -> MaybeT (Backend IO) TermSummary
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 TermSummary -> MaybeT (Backend IO) TermSummary)
-> Backend IO TermSummary -> MaybeT (Backend IO) TermSummary
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Referent
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TermSummary
Backend.termSummaryForReferent Codebase IO Symbol Ann
codebase Referent
referent Maybe Name
forall a. Maybe a
Nothing (\Set LabeledDependency
_ -> PrettyPrintEnvDecl -> Transaction PrettyPrintEnvDecl
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnvDecl
pped) Maybe Width
mayWidth
      DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a. a -> MaybeT (Backend IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionSearchResult
 -> MaybeT (Backend IO) DefinitionSearchResult)
-> DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a b. (a -> b) -> a -> b
$
        DefinitionSearchResult
          { Name
fqn :: Name
$sel:fqn:DefinitionSearchResult :: Name
fqn,
            $sel:summary:DefinitionSearchResult :: TermOrTypeSummary
summary = TermSummary -> TermOrTypeSummary
ToTTermSummary TermSummary
summary,
            ProjectName
project :: ProjectName
$sel:project:DefinitionSearchResult :: ProjectName
project,
            ProjectBranchName
branchRef :: ProjectBranchName
$sel:branchRef:DefinitionSearchResult :: ProjectBranchName
branchRef
          }

    doType :: PrettyPrintEnvDecl
-> TermReferenceId -> Backend IO (Maybe DefinitionSearchResult)
doType PrettyPrintEnvDecl
pped TermReferenceId
refId = do
      MaybeT (Backend IO) DefinitionSearchResult
-> Backend IO (Maybe DefinitionSearchResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
        let reference :: Reference
reference = TermReferenceId -> Reference
Reference.fromId TermReferenceId
refId
        Name
fqn <- Maybe Name -> MaybeT (Backend IO) Name
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe Name -> MaybeT (Backend IO) Name)
-> Maybe Name -> MaybeT (Backend IO) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Maybe Name)
-> HashQualified Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Reference
reference
        TypeSummary
summary <- Backend IO TypeSummary -> MaybeT (Backend IO) TypeSummary
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 TypeSummary -> MaybeT (Backend IO) TypeSummary)
-> Backend IO TypeSummary -> MaybeT (Backend IO) TypeSummary
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Reference
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TypeSummary
Backend.typeSummaryForReference Codebase IO Symbol Ann
codebase Reference
reference Maybe Name
forall a. Maybe a
Nothing (\Set LabeledDependency
_ -> PrettyPrintEnvDecl -> Transaction PrettyPrintEnvDecl
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnvDecl
pped) Maybe Width
mayWidth
        DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a. a -> MaybeT (Backend IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionSearchResult
 -> MaybeT (Backend IO) DefinitionSearchResult)
-> DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a b. (a -> b) -> a -> b
$
          DefinitionSearchResult
            { Name
$sel:fqn:DefinitionSearchResult :: Name
fqn :: Name
fqn,
              $sel:summary:DefinitionSearchResult :: TermOrTypeSummary
summary = TypeSummary -> TermOrTypeSummary
ToTTypeSummary TypeSummary
summary,
              ProjectName
project :: ProjectName
$sel:project:DefinitionSearchResult :: ProjectName
project,
              ProjectBranchName
branchRef :: ProjectBranchName
$sel:branchRef:DefinitionSearchResult :: ProjectBranchName
branchRef
            }

getDefinitionDependenciesEndpoint ::
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  HQ.HashQualified Name ->
  Maybe Width ->
  Backend.Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependenciesEndpoint :: Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> HashQualified Name
-> Maybe Width
-> Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependenciesEndpoint Runtime Symbol
_rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch HashQualified Name
hqn Maybe Width
mayWidth = do
  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
  CausalBranch Transaction
rootCausal <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
Backend.resolveProjectRoot Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
  (DefnsF Set Reference Reference
dependencies, Names
names) <- (forall x. Transaction x -> IO x)
-> Backend Transaction (DefnsF Set Reference Reference, Names)
-> Backend IO (DefnsF Set Reference Reference, Names)
forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> Backend m a -> Backend n a
Backend.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) (Backend Transaction (DefnsF Set Reference Reference, Names)
 -> Backend IO (DefnsF Set Reference Reference, Names))
-> Backend Transaction (DefnsF Set Reference Reference, Names)
-> Backend IO (DefnsF Set Reference Reference, Names)
forall a b. (a -> b) -> a -> b
$ do
    Branch Transaction
rootBranch <- Transaction (Branch Transaction)
-> Backend Transaction (Branch 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 (Branch Transaction)
 -> Backend Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
-> Backend Transaction (Branch Transaction)
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> CausalHash -> Transaction (Branch Transaction)
forall (m :: * -> *) v a.
Codebase m v a -> CausalHash -> Transaction (Branch Transaction)
Codebase.expectBranchForHashTx Codebase IO Symbol Ann
codebase (CausalBranch Transaction -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
Causal.causalHash CausalBranch Transaction
rootCausal)
    let rootBranch0 :: Branch0 Transaction
rootBranch0 = Branch Transaction -> Branch0 Transaction
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch Transaction
rootBranch
    let names :: Names
names = Branch0 Transaction -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 Transaction
rootBranch0
    let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
makeNameSearch Int
hqLength Names
names
    QueryResult {[SearchResult]
$sel:hits:QueryResult :: QueryResult -> [SearchResult]
hits :: [SearchResult]
hits} <- Transaction QueryResult -> Backend Transaction QueryResult
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 QueryResult -> Backend Transaction QueryResult)
-> Transaction QueryResult -> Backend Transaction QueryResult
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
forall (m :: * -> *) v.
Codebase m v Ann
-> NameSearch Transaction
-> SearchType
-> [HashQualified Name]
-> Transaction QueryResult
Backend.hqNameQuery Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
ExactName [HashQualified Name
hqn]

    let defs :: Defns (Set Referent) (Set Reference)
defs =
          [SearchResult]
hits [SearchResult]
-> ([SearchResult] -> Defns (Set Referent) (Set Reference))
-> Defns (Set Referent) (Set Reference)
forall a b. a -> (a -> b) -> b
& (SearchResult -> Defns (Set Referent) (Set Reference))
-> [SearchResult] -> Defns (Set Referent) (Set Reference)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
            Tp TypeResult {Reference
$sel:reference:TypeResult :: TypeResult -> Reference
reference :: Reference
reference} -> Defns {$sel:terms:Defns :: Set Referent
terms = Set Referent
forall a. Set a
Set.empty, $sel:types:Defns :: Set Reference
types = (Reference -> Set Reference
forall a. a -> Set a
Set.singleton Reference
reference)}
            Tm TermResult {Referent
$sel:referent:TermResult :: TermResult -> Referent
referent :: Referent
referent} -> Defns {$sel:terms:Defns :: Set Referent
terms = (Referent -> Set Referent
forall a. a -> Set a
Set.singleton Referent
referent), $sel:types:Defns :: Set Reference
types = Set Reference
forall a. Set a
Set.empty}

    DefnsF Set Reference Reference
dependencies <- Transaction (DefnsF Set Reference Reference)
-> Backend Transaction (DefnsF Set Reference Reference)
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 (DefnsF Set Reference Reference)
 -> Backend Transaction (DefnsF Set Reference Reference))
-> Transaction (DefnsF Set Reference Reference)
-> Backend Transaction (DefnsF Set Reference Reference)
forall a b. (a -> b) -> a -> b
$ Defns (Set Referent) (Set Reference)
-> Transaction (DefnsF Set Reference Reference)
Codebase.directDependencies Defns (Set Referent) (Set Reference)
defs
    (DefnsF Set Reference Reference, Names)
-> Backend Transaction (DefnsF Set Reference Reference, Names)
forall a. a -> Backend Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefnsF Set Reference Reference
dependencies, Names
names)

  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) Suffixifier
PPE.dontSuffixify
  Defns [DefinitionSearchResult] [DefinitionSearchResult]
definitionSearchResults <-
    DefnsF Set Reference Reference
dependencies
      DefnsF Set Reference Reference
-> (DefnsF Set Reference Reference
    -> Backend
         IO (Defns [DefinitionSearchResult] [DefinitionSearchResult]))
-> Backend
     IO (Defns [DefinitionSearchResult] [DefinitionSearchResult])
forall a b. a -> (a -> b) -> b
& (Set Reference -> Backend IO [DefinitionSearchResult])
-> (Set Reference -> Backend IO [DefinitionSearchResult])
-> DefnsF Set Reference Reference
-> Backend
     IO (Defns [DefinitionSearchResult] [DefinitionSearchResult])
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((Reference -> Backend IO (Maybe DefinitionSearchResult))
-> [Reference] -> Backend IO [DefinitionSearchResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither (PrettyPrintEnvDecl
-> Reference -> Backend IO (Maybe DefinitionSearchResult)
doTerm PrettyPrintEnvDecl
pped) ([Reference] -> Backend IO [DefinitionSearchResult])
-> (Set Reference -> [Reference])
-> Set Reference
-> Backend IO [DefinitionSearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList) ((Reference -> Backend IO (Maybe DefinitionSearchResult))
-> [Reference] -> Backend IO [DefinitionSearchResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither (PrettyPrintEnvDecl
-> Reference -> Backend IO (Maybe DefinitionSearchResult)
doType PrettyPrintEnvDecl
pped) ([Reference] -> Backend IO [DefinitionSearchResult])
-> (Set Reference -> [Reference])
-> Set Reference
-> Backend IO [DefinitionSearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList)
  Defns [DefinitionSearchResult] [DefinitionSearchResult]
definitionSearchResults
    Defns [DefinitionSearchResult] [DefinitionSearchResult]
-> (Defns [DefinitionSearchResult] [DefinitionSearchResult]
    -> [DefinitionSearchResult])
-> [DefinitionSearchResult]
forall a b. a -> (a -> b) -> b
& Defns [DefinitionSearchResult] [DefinitionSearchResult]
-> [DefinitionSearchResult]
forall m. Monoid m => Defns m m -> m
forall (p :: * -> * -> *) m. (Bifoldable p, Monoid m) => p m m -> m
bifold
    [DefinitionSearchResult]
-> ([DefinitionSearchResult] -> DefinitionSearchResults)
-> DefinitionSearchResults
forall a b. a -> (a -> b) -> b
& [DefinitionSearchResult] -> DefinitionSearchResults
DefinitionSearchResults
    DefinitionSearchResults
-> (DefinitionSearchResults -> APIHeaders DefinitionSearchResults)
-> APIHeaders DefinitionSearchResults
forall a b. a -> (a -> b) -> b
& DefinitionSearchResults -> APIHeaders DefinitionSearchResults
forall v. v -> APIHeaders v
setCacheControl
    APIHeaders DefinitionSearchResults
-> (APIHeaders DefinitionSearchResults
    -> Backend IO (APIHeaders DefinitionSearchResults))
-> Backend IO (APIHeaders DefinitionSearchResults)
forall a b. a -> (a -> b) -> b
& APIHeaders DefinitionSearchResults
-> Backend IO (APIHeaders DefinitionSearchResults)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    project :: ProjectName
project = ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch.project
    branchRef :: ProjectBranchName
branchRef = ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch.branch
    doTerm :: PPED.PrettyPrintEnvDecl -> Reference.TermReference -> Backend.Backend IO (Maybe DefinitionSearchResult)
    doTerm :: PrettyPrintEnvDecl
-> Reference -> Backend IO (Maybe DefinitionSearchResult)
doTerm PrettyPrintEnvDecl
pped Reference
reference = MaybeT (Backend IO) DefinitionSearchResult
-> Backend IO (Maybe DefinitionSearchResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
      let referent :: Referent
referent = Reference -> Referent
Referent.fromTermReference Reference
reference
      Name
fqn <- Maybe Name -> MaybeT (Backend IO) Name
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe Name -> MaybeT (Backend IO) Name)
-> Maybe Name -> MaybeT (Backend IO) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Maybe Name)
-> HashQualified Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Referent
referent
      TermSummary
summary <- Backend IO TermSummary -> MaybeT (Backend IO) TermSummary
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 TermSummary -> MaybeT (Backend IO) TermSummary)
-> Backend IO TermSummary -> MaybeT (Backend IO) TermSummary
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Referent
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TermSummary
Backend.termSummaryForReferent Codebase IO Symbol Ann
codebase Referent
referent Maybe Name
forall a. Maybe a
Nothing (\Set LabeledDependency
_ -> PrettyPrintEnvDecl -> Transaction PrettyPrintEnvDecl
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnvDecl
pped) Maybe Width
mayWidth
      DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a. a -> MaybeT (Backend IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionSearchResult
 -> MaybeT (Backend IO) DefinitionSearchResult)
-> DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a b. (a -> b) -> a -> b
$
        DefinitionSearchResult
          { Name
$sel:fqn:DefinitionSearchResult :: Name
fqn :: Name
fqn,
            $sel:summary:DefinitionSearchResult :: TermOrTypeSummary
summary = TermSummary -> TermOrTypeSummary
ToTTermSummary TermSummary
summary,
            ProjectName
$sel:project:DefinitionSearchResult :: ProjectName
project :: ProjectName
project,
            ProjectBranchName
$sel:branchRef:DefinitionSearchResult :: ProjectBranchName
branchRef :: ProjectBranchName
branchRef
          }

    doType :: PPED.PrettyPrintEnvDecl -> Reference.TypeReference -> Backend.Backend IO (Maybe DefinitionSearchResult)
    doType :: PrettyPrintEnvDecl
-> Reference -> Backend IO (Maybe DefinitionSearchResult)
doType PrettyPrintEnvDecl
pped Reference
reference = do
      MaybeT (Backend IO) DefinitionSearchResult
-> Backend IO (Maybe DefinitionSearchResult)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
        Name
fqn <- Maybe Name -> MaybeT (Backend IO) Name
forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe (Maybe Name -> MaybeT (Backend IO) Name)
-> Maybe Name -> MaybeT (Backend IO) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Maybe Name)
-> HashQualified Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped) Reference
reference
        TypeSummary
summary <- Backend IO TypeSummary -> MaybeT (Backend IO) TypeSummary
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 TypeSummary -> MaybeT (Backend IO) TypeSummary)
-> Backend IO TypeSummary -> MaybeT (Backend IO) TypeSummary
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Reference
-> Maybe Name
-> (Set LabeledDependency -> Transaction PrettyPrintEnvDecl)
-> Maybe Width
-> Backend IO TypeSummary
Backend.typeSummaryForReference Codebase IO Symbol Ann
codebase Reference
reference Maybe Name
forall a. Maybe a
Nothing (\Set LabeledDependency
_ -> PrettyPrintEnvDecl -> Transaction PrettyPrintEnvDecl
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrettyPrintEnvDecl
pped) Maybe Width
mayWidth
        DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a. a -> MaybeT (Backend IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionSearchResult
 -> MaybeT (Backend IO) DefinitionSearchResult)
-> DefinitionSearchResult
-> MaybeT (Backend IO) DefinitionSearchResult
forall a b. (a -> b) -> a -> b
$
          DefinitionSearchResult
            { Name
$sel:fqn:DefinitionSearchResult :: Name
fqn :: Name
fqn,
              $sel:summary:DefinitionSearchResult :: TermOrTypeSummary
summary = TypeSummary -> TermOrTypeSummary
ToTTypeSummary TypeSummary
summary,
              ProjectName
$sel:project:DefinitionSearchResult :: ProjectName
project :: ProjectName
project,
              ProjectBranchName
$sel:branchRef:DefinitionSearchResult :: ProjectBranchName
branchRef :: ProjectBranchName
branchRef
            }

getDefinitionsEndpoint ::
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  Maybe Path.Path ->
  [HQ.HashQualified Name] ->
  Maybe Width ->
  Maybe Suffixify ->
  Backend.Backend IO (APIHeaders DefinitionDisplayResults)
getDefinitionsEndpoint :: Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend IO (APIHeaders DefinitionDisplayResults)
getDefinitionsEndpoint Runtime Symbol
rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName Maybe Path
relativePath [HashQualified Name]
hqns Maybe Width
width Maybe Suffixify
suff = do
  CausalBranch Transaction
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
Backend.resolveProjectRoot Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
  DefinitionDisplayResults
r <-
    (HashQualified Name -> Backend IO DefinitionDisplayResults)
-> [HashQualified Name] -> Backend IO DefinitionDisplayResults
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM
      ( Absolute
-> CausalBranch Transaction
-> Maybe Width
-> Suffixify
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> HashQualified Name
-> Backend IO DefinitionDisplayResults
Local.prettyDefinitionsForHQName
          (Absolute -> (Path -> Absolute) -> Maybe Path -> Absolute
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Absolute
Path.Root Path -> Absolute
Path.Absolute Maybe Path
relativePath)
          CausalBranch Transaction
root
          Maybe Width
width
          (Suffixify -> Maybe Suffixify -> Suffixify
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Suffixify
Suffixify Bool
True) Maybe Suffixify
suff)
          Runtime Symbol
rt
          Codebase IO Symbol Ann
codebase
      )
      [HashQualified Name]
hqns
  APIHeaders DefinitionDisplayResults
-> Backend IO (APIHeaders DefinitionDisplayResults)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIHeaders DefinitionDisplayResults
 -> Backend IO (APIHeaders DefinitionDisplayResults))
-> APIHeaders DefinitionDisplayResults
-> Backend IO (APIHeaders DefinitionDisplayResults)
forall a b. (a -> b) -> a -> b
$ DefinitionDisplayResults -> APIHeaders DefinitionDisplayResults
forall v. v -> APIHeaders v
setCacheControl DefinitionDisplayResults
r

serveDefinitionsServer ::
  Runtime Symbol ->
  Codebase IO Symbol Ann ->
  ProjectAndBranch ProjectName ProjectBranchName ->
  ServerT DefinitionsAPI (Backend.Backend IO)
serveDefinitionsServer :: Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> ServerT DefinitionsAPI (Backend IO)
serveDefinitionsServer Runtime Symbol
rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch = do
  Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend IO (APIHeaders DefinitionDisplayResults)
getDefinitionsEndpoint Runtime Symbol
rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
    (Maybe Path
 -> [HashQualified Name]
 -> Maybe Width
 -> Maybe Suffixify
 -> Backend IO (APIHeaders DefinitionDisplayResults))
-> ((HashQualified Name
     -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
    :<|> (HashQualified Name
          -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults)))
-> (Maybe Path
    -> [HashQualified Name]
    -> Maybe Width
    -> Maybe Suffixify
    -> Backend IO (APIHeaders DefinitionDisplayResults))
   :<|> ((HashQualified Name
          -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
         :<|> (HashQualified Name
               -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults)))
forall a b. a -> b -> a :<|> b
:<|> Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> HashQualified Name
-> Maybe Width
-> Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependentsEndpoint Runtime Symbol
rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch
    (HashQualified Name
 -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
-> (HashQualified Name
    -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
-> (HashQualified Name
    -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
   :<|> (HashQualified Name
         -> Maybe Width -> Backend IO (APIHeaders DefinitionSearchResults))
forall a b. a -> b -> a :<|> b
:<|> Runtime Symbol
-> Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> HashQualified Name
-> Maybe Width
-> Backend IO (APIHeaders DefinitionSearchResults)
getDefinitionDependenciesEndpoint Runtime Symbol
rt Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch