module Unison.Codebase.Editor.HandleInput.Signature
  ( handleSignature,
  )
where

import Control.Monad.Reader (ask)
import Data.List.NonEmpty (NonEmpty)
import Data.Set qualified as Set
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.Output
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.NamesWithHistory qualified as Names
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Reference qualified as Reference
import Unison.Server.Backend qualified as Backend
import Unison.Server.NameSearch.FromNames qualified as NameSearch
import Unison.Server.QueryResult (QueryResult (..))
import Unison.Server.SearchResultPrime qualified as SR'
import Unison.Syntax.NamePrinter qualified as NP
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Util.Pretty qualified as P

handleSignature :: NonEmpty (HQ.HashQualified Name) -> Cli ()
handleSignature :: NonEmpty (HashQualified Name) -> Cli ()
handleSignature NonEmpty (HashQualified Name)
hqNames = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  names <- Cli.currentNames
  hashLength <- Cli.runTransaction Codebase.hashLength
  let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLength Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  let nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
NameSearch.makeNameSearch Int
hashLength Names
names
  let query = [HashQualified Name] -> Set (HashQualified Name)
forall a. Ord a => [a] -> Set a
Set.fromList (NonEmpty (HashQualified Name) -> [HashQualified Name]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (HashQualified Name)
hqNames)
  (misses, results) <- Cli.runTransaction do
    QueryResult {misses, hits} <- Backend.hqNameQuery codebase nameSearch Names.IncludeSuffixes query
    results <- Backend.loadSearchResults codebase hits
    pure (misses, results)
  let renderEntry = \case
        SR'.Tm HashQualified Name
name (Just Type Symbol Ann
typ) Referent
_ Set (HashQualified Name)
_ ->
          let namePretty :: Pretty ColorText
namePretty = Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (HashQualified Name -> Pretty (SyntaxText' Reference)
NP.prettyHashQualified HashQualified Name
name)
              typePretty :: Pretty ColorText
typePretty = PrettyPrintEnv -> Type Symbol Ann -> Pretty ColorText
forall v a. Var v => PrettyPrintEnv -> Type v a -> Pretty ColorText
TypePrinter.pretty PrettyPrintEnv
suffixifiedPPE Type Symbol Ann
typ
           in Pretty ColorText
namePretty Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
": " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
typePretty)
        SR'.Tp' (SR'.TypeResult' HashQualified Name
name DisplayObject () (Decl Symbol Ann)
_ Reference
r Set (HashQualified Name)
_) ->
          let namePretty :: Pretty ColorText
namePretty = Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
P.syntaxToColor (HashQualified Name -> Pretty (SyntaxText' Reference)
NP.prettyHashQualified HashQualified Name
name)
              tag :: Pretty ColorText
tag = case Reference
r of
                Reference.Builtin {} -> ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(builtin type)"
                Reference.DerivedId {} -> ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit ColorText
"(type)"
           in Pretty ColorText
namePretty Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 Pretty ColorText
tag
        SearchResult' Symbol Ann
_ -> Pretty ColorText
forall a. Monoid a => a
mempty
  let sigs = (SearchResult' Symbol Ann -> Pretty ColorText)
-> [SearchResult' Symbol Ann] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map SearchResult' Symbol Ann -> Pretty ColorText
renderEntry ((SearchResult' Symbol Ann -> Bool)
-> [SearchResult' Symbol Ann] -> [SearchResult' Symbol Ann]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SearchResult' Symbol Ann -> Bool)
-> SearchResult' Symbol Ann
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult' Symbol Ann -> Bool
forall {v} {a}. SearchResult' v a -> Bool
isMissing) [SearchResult' Symbol Ann]
results)
  when (not (null misses)) (Cli.respond (SearchTermsNotFound misses))
  Cli.respond . DisplayDefinitions $ P.sep P.newline sigs
  where
    isMissing :: SearchResult' v a -> Bool
isMissing = \case
      SR'.Tm HashQualified Name
_ Maybe (Type v a)
Nothing Referent
_ Set (HashQualified Name)
_ -> Bool
True
      SearchResult' v a
_ -> Bool
False