{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.LSP.Completion
  ( completionHandler,
    completionItemResolveHandler,
    namesToCompletionTree,
    -- Exported for transcript tests
    completionsForQuery,
  )
where

import Control.Comonad.Cofree
import Control.Lens hiding (List, (:<))
import Control.Monad.Reader
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.List.Extra (nubOrdOn)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Language.LSP.Protocol.Lens
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Text.Megaparsec qualified as Megaparsec
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LSP.FileAnalysis
import Unison.LSP.Queries qualified as LSPQ
import Unison.LSP.Types
import Unison.LSP.VFS qualified as VFS
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names (..))
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.IOSource qualified as IOSource
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
import Unison.Syntax.HashQualifiedPrime qualified as HQ' (toText)
import Unison.Syntax.Name qualified as Name (nameP, parseText, toText)
import Unison.Syntax.TypePrinter qualified as TypePrinter
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as Relation
import UnliftIO qualified

completionHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentCompletion -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentCompletion) -> Lsp ()) -> Lsp ()
completionHandler :: TRequestMessage 'Method_TextDocumentCompletion
-> (Either
      ResponseError (MessageResult 'Method_TextDocumentCompletion)
    -> Lsp ())
-> Lsp ()
completionHandler TRequestMessage 'Method_TextDocumentCompletion
m Either ResponseError (MessageResult 'Method_TextDocumentCompletion)
-> Lsp ()
respond =
  Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> Lsp ()
Either ResponseError (MessageResult 'Method_TextDocumentCompletion)
-> Lsp ()
respond (Either
   ResponseError ([CompletionItem] |? (CompletionList |? Null))
 -> Lsp ())
-> (Maybe CompletionList
    -> Either
         ResponseError ([CompletionItem] |? (CompletionList |? Null)))
-> Maybe CompletionList
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> (CompletionList
    -> Either
         ResponseError ([CompletionItem] |? (CompletionList |? Null)))
-> Maybe CompletionList
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([CompletionItem] |? (CompletionList |? Null))
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall a b. b -> Either a b
Right (([CompletionItem] |? (CompletionList |? Null))
 -> Either
      ResponseError ([CompletionItem] |? (CompletionList |? Null)))
-> ([CompletionItem] |? (CompletionList |? Null))
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> [CompletionItem] |? (CompletionList |? Null)
forall a b. a -> a |? b
InL [CompletionItem]
forall a. Monoid a => a
mempty) (([CompletionItem] |? (CompletionList |? Null))
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall a b. b -> Either a b
Right (([CompletionItem] |? (CompletionList |? Null))
 -> Either
      ResponseError ([CompletionItem] |? (CompletionList |? Null)))
-> (CompletionList -> [CompletionItem] |? (CompletionList |? Null))
-> CompletionList
-> Either
     ResponseError ([CompletionItem] |? (CompletionList |? Null))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompletionList |? Null)
-> [CompletionItem] |? (CompletionList |? Null)
forall a b. b -> a |? b
InR ((CompletionList |? Null)
 -> [CompletionItem] |? (CompletionList |? Null))
-> (CompletionList -> CompletionList |? Null)
-> CompletionList
-> [CompletionItem] |? (CompletionList |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletionList -> CompletionList |? Null
forall a b. a -> a |? b
InL) (Maybe CompletionList -> Lsp ())
-> Lsp (Maybe CompletionList) -> Lsp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT Lsp CompletionList -> Lsp (Maybe CompletionList)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let fileUri :: Uri
fileUri = (TRequestMessage 'Method_TextDocumentCompletion
m TRequestMessage 'Method_TextDocumentCompletion
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Uri CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const Uri (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const Uri CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const Uri (TRequestMessage 'Method_TextDocumentCompletion))
-> ((Uri -> Const Uri Uri)
    -> CompletionParams -> Const Uri CompletionParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CompletionParams -> Const Uri CompletionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CompletionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CompletionParams -> Const Uri CompletionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> CompletionParams
-> Const Uri CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
    (Range
range, Text
prefix) <- Uri -> Position -> MaybeT Lsp (Range, Text)
VFS.completionPrefix (TRequestMessage 'Method_TextDocumentCompletion
m TRequestMessage 'Method_TextDocumentCompletion
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Uri CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const Uri (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const Uri CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const Uri (TRequestMessage 'Method_TextDocumentCompletion))
-> ((Uri -> Const Uri Uri)
    -> CompletionParams -> Const Uri CompletionParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentCompletion) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CompletionParams -> Const Uri CompletionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CompletionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CompletionParams -> Const Uri CompletionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> CompletionParams
-> Const Uri CompletionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri) (TRequestMessage 'Method_TextDocumentCompletion
m TRequestMessage 'Method_TextDocumentCompletion
-> Getting
     Position (TRequestMessage 'Method_TextDocumentCompletion) Position
-> Position
forall s a. s -> Getting a s a -> a
^. (CompletionParams -> Const Position CompletionParams)
-> TRequestMessage 'Method_TextDocumentCompletion
-> Const Position (TRequestMessage 'Method_TextDocumentCompletion)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCompletion) CompletionParams
params ((CompletionParams -> Const Position CompletionParams)
 -> TRequestMessage 'Method_TextDocumentCompletion
 -> Const Position (TRequestMessage 'Method_TextDocumentCompletion))
-> ((Position -> Const Position Position)
    -> CompletionParams -> Const Position CompletionParams)
-> Getting
     Position (TRequestMessage 'Method_TextDocumentCompletion) Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const Position Position)
-> CompletionParams -> Const Position CompletionParams
forall s a. HasPosition s a => Lens' s a
Lens' CompletionParams Position
position)
    PrettyPrintEnv
ppe <- PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE (PrettyPrintEnvDecl -> PrettyPrintEnv)
-> MaybeT Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Lsp PrettyPrintEnvDecl
currentPPED
    CompletionTree
codebaseCompletions <- Lsp CompletionTree -> MaybeT Lsp CompletionTree
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Lsp CompletionTree
getCodebaseCompletions
    let (Bool
isIncomplete, [(Text, Name, LabeledDependency)]
matches) = CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)])
completionsForQuery CompletionTree
codebaseCompletions Text
prefix
    let defCompletionItems :: [CompletionItem]
defCompletionItems =
          [(Text, Name, LabeledDependency)]
matches
            [(Text, Name, LabeledDependency)]
-> ([(Text, Name, LabeledDependency)] -> [CompletionItem])
-> [CompletionItem]
forall a b. a -> (a -> b) -> b
& ((Text, Name, LabeledDependency) -> Maybe CompletionItem)
-> [(Text, Name, LabeledDependency)] -> [CompletionItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(Text
path, Name
fqn, LabeledDependency
dep) ->
              let biasedPPE :: PrettyPrintEnv
biasedPPE = [Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo [Name
fqn] PrettyPrintEnv
ppe
                  hqName :: Maybe (HashQualified Name)
hqName = (TypeReference -> Maybe (HashQualified Name))
-> (Referent -> Maybe (HashQualified Name))
-> LabeledDependency
-> Maybe (HashQualified Name)
forall a.
(TypeReference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold (PrettyPrintEnv -> TypeReference -> Maybe (HashQualified Name)
PPE.types PrettyPrintEnv
biasedPPE) (PrettyPrintEnv -> Referent -> Maybe (HashQualified Name)
PPE.terms PrettyPrintEnv
biasedPPE) LabeledDependency
dep
               in Maybe (HashQualified Name)
hqName Maybe (HashQualified Name)
-> (HashQualified Name -> CompletionItem) -> Maybe CompletionItem
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \HashQualified Name
hqName -> Uri
-> Range
-> Name
-> Name
-> Text
-> Text
-> LabeledDependency
-> CompletionItem
mkDefCompletionItem Uri
fileUri Range
range (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hqName) Name
fqn Text
path (HashQualified Name -> Text
HQ'.toText HashQualified Name
hqName) LabeledDependency
dep

    let itemDefaults :: Maybe a
itemDefaults = Maybe a
forall a. Maybe a
Nothing
    CompletionList -> MaybeT Lsp CompletionList
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionList -> MaybeT Lsp CompletionList)
-> ([CompletionItem] -> CompletionList)
-> [CompletionItem]
-> MaybeT Lsp CompletionList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Maybe
     (Rec
        (("commitCharacters" .== Maybe [Text])
         .+ (("editRange"
              .== Maybe
                    (Range
                     |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
             .+ (("insertTextFormat" .== Maybe InsertTextFormat)
                 .+ (("insertTextMode" .== Maybe InsertTextMode)
                     .+ (("data" .== Maybe Value) .+ Empty))))))
-> [CompletionItem]
-> CompletionList
CompletionList Bool
isIncomplete Maybe
  (Rec
     (("commitCharacters" .== Maybe [Text])
      .+ (("editRange"
           .== Maybe
                 (Range
                  |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
          .+ (("insertTextFormat" .== Maybe InsertTextFormat)
              .+ (("insertTextMode" .== Maybe InsertTextMode)
                  .+ (("data" .== Maybe Value) .+ Empty))))))
Maybe
  (Rec
     ('R
        '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
          "editRange"
          ':-> Maybe
                 (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
          "insertTextFormat" ':-> Maybe InsertTextFormat,
          "insertTextMode" ':-> Maybe InsertTextMode]))
itemDefaults ([CompletionItem] -> MaybeT Lsp CompletionList)
-> [CompletionItem] -> MaybeT Lsp CompletionList
forall a b. (a -> b) -> a -> b
$ [CompletionItem]
defCompletionItems
  where

completionsForQuery :: CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)])
completionsForQuery :: CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)])
completionsForQuery CompletionTree
codebaseCompletions Text
prefix =
  let defMatches :: [(Path, Name, LabeledDependency)]
defMatches = CompletionTree -> Text -> [(Path, Name, LabeledDependency)]
matchCompletions CompletionTree
codebaseCompletions Text
prefix
      (Bool
isIncomplete, [(Text, Name, LabeledDependency)]
defCompletions) =
        [(Path, Name, LabeledDependency)]
defMatches
          -- sort shorter names first
          [(Path, Name, LabeledDependency)]
-> ([(Path, Name, LabeledDependency)]
    -> [(Path, Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& ((Path, Name, LabeledDependency) -> (Int, Int, Name))
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Name -> (Int, Int, Name)
matchSortCriteria (Name -> (Int, Int, Name))
-> ((Path, Name, LabeledDependency) -> Name)
-> (Path, Name, LabeledDependency)
-> (Int, Int, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Name (Path, Name, LabeledDependency) Name
-> (Path, Name, LabeledDependency) -> Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Name (Path, Name, LabeledDependency) Name
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Path, Name, LabeledDependency)
  (Path, Name, LabeledDependency)
  Name
  Name
_2)
          [(Path, Name, LabeledDependency)]
-> ([(Path, Name, LabeledDependency)]
    -> [(Path, Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& ((Path, Name, LabeledDependency) -> (Path, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (\(Path
p, Name
_name, LabeledDependency
ref) -> (Path
p, LabeledDependency
ref))
          [(Path, Name, LabeledDependency)]
-> ([(Path, Name, LabeledDependency)]
    -> [(Text, Name, LabeledDependency)])
-> [(Text, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& ((Path, Name, LabeledDependency)
 -> (Text, Name, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
-> [(Text, Name, LabeledDependency)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter
  (Path, Name, LabeledDependency)
  (Text, Name, LabeledDependency)
  Path
  Text
-> (Path -> Text)
-> (Path, Name, LabeledDependency)
-> (Text, Name, LabeledDependency)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Path, Name, LabeledDependency)
  (Text, Name, LabeledDependency)
  Path
  Text
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Path, Name, LabeledDependency)
  (Text, Name, LabeledDependency)
  Path
  Text
_1 Path -> Text
Path.toText)
          [(Text, Name, LabeledDependency)]
-> ([(Text, Name, LabeledDependency)]
    -> (Bool, [(Text, Name, LabeledDependency)]))
-> (Bool, [(Text, Name, LabeledDependency)])
forall a b. a -> (a -> b) -> b
& (Bool
False,)
   in (Bool
isIncomplete, [(Text, Name, LabeledDependency)]
defCompletions)

-- Takes at most the specified number of completions, but also indicates with a boolean
-- whether there were more completions remaining so we can pass that along to the client.
-- takeCompletions :: Int -> [a] -> (Bool, [a])
-- takeCompletions 0 xs = (not $ null xs, [])
-- takeCompletions _ [] = (False, [])
-- takeCompletions n (x : xs) = second (x :) $ takeCompletions (pred n) xs

mkDefCompletionItem :: Uri -> Range -> Name -> Name -> Text -> Text -> LabeledDependency -> CompletionItem
mkDefCompletionItem :: Uri
-> Range
-> Name
-> Name
-> Text
-> Text
-> LabeledDependency
-> CompletionItem
mkDefCompletionItem Uri
fileUri Range
range Name
relativeName Name
fullyQualifiedName Text
path Text
suffixified LabeledDependency
dep =
  CompletionItem
    { $sel:_label:CompletionItem :: Text
_label = Text
lbl,
      $sel:_labelDetails:CompletionItem :: Maybe CompletionItemLabelDetails
_labelDetails = Maybe CompletionItemLabelDetails
forall a. Maybe a
Nothing,
      $sel:_kind:CompletionItem :: Maybe CompletionItemKind
_kind = case LabeledDependency
dep of
        LD.TypeReference TypeReference
_ref -> CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CompletionItemKind_Class
        LD.TermReferent Referent
ref -> case Referent
ref of
          Referent.Con {} -> CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CompletionItemKind_Constructor
          Referent.Ref {} -> CompletionItemKind -> Maybe CompletionItemKind
forall a. a -> Maybe a
Just CompletionItemKind
CompletionItemKind_Value,
      $sel:_tags:CompletionItem :: Maybe [CompletionItemTag]
_tags = Maybe [CompletionItemTag]
forall a. Maybe a
Nothing,
      $sel:_detail:CompletionItem :: Maybe Text
_detail = Text -> Maybe Text
forall a. a -> Maybe a
Just (Name -> Text
Name.toText Name
fullyQualifiedName),
      $sel:_documentation:CompletionItem :: Maybe (Text |? MarkupContent)
_documentation = Maybe (Text |? MarkupContent)
forall a. Maybe a
Nothing,
      $sel:_deprecated:CompletionItem :: Maybe Bool
_deprecated = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:_preselect:CompletionItem :: Maybe Bool
_preselect = Maybe Bool
forall a. Maybe a
Nothing,
      $sel:_sortText:CompletionItem :: Maybe Text
_sortText =
        let (Int
nls, Int
ns, Name
fn) = Name -> (Int, Int, Name)
matchSortCriteria Name
fullyQualifiedName
         in Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"|" [Int -> Text
paddedInt Int
nls, Int -> Text
paddedInt Int
ns, Name -> Text
Name.toText Name
fn],
      $sel:_filterText:CompletionItem :: Maybe Text
_filterText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
path,
      $sel:_insertText:CompletionItem :: Maybe Text
_insertText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_insertTextFormat:CompletionItem :: Maybe InsertTextFormat
_insertTextFormat = Maybe InsertTextFormat
forall a. Maybe a
Nothing,
      $sel:_insertTextMode:CompletionItem :: Maybe InsertTextMode
_insertTextMode = Maybe InsertTextMode
forall a. Maybe a
Nothing,
      $sel:_textEdit:CompletionItem :: Maybe (TextEdit |? InsertReplaceEdit)
_textEdit = (TextEdit |? InsertReplaceEdit)
-> Maybe (TextEdit |? InsertReplaceEdit)
forall a. a -> Maybe a
Just (TextEdit -> TextEdit |? InsertReplaceEdit
forall a b. a -> a |? b
InL (TextEdit -> TextEdit |? InsertReplaceEdit)
-> TextEdit -> TextEdit |? InsertReplaceEdit
forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
range Text
suffixified),
      $sel:_textEditText:CompletionItem :: Maybe Text
_textEditText = Maybe Text
forall a. Maybe a
Nothing,
      $sel:_additionalTextEdits:CompletionItem :: Maybe [TextEdit]
_additionalTextEdits = Maybe [TextEdit]
forall a. Maybe a
Nothing,
      $sel:_commitCharacters:CompletionItem :: Maybe [Text]
_commitCharacters = Maybe [Text]
forall a. Maybe a
Nothing,
      $sel:_command:CompletionItem :: Maybe Command
_command = Maybe Command
forall a. Maybe a
Nothing,
      $sel:_data_:CompletionItem :: Maybe Value
_data_ = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ CompletionItemDetails -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (CompletionItemDetails -> Value) -> CompletionItemDetails -> Value
forall a b. (a -> b) -> a -> b
$ CompletionItemDetails {LabeledDependency
dep :: LabeledDependency
$sel:dep:CompletionItemDetails :: LabeledDependency
dep, Name
relativeName :: Name
$sel:relativeName:CompletionItemDetails :: Name
relativeName, Name
fullyQualifiedName :: Name
$sel:fullyQualifiedName:CompletionItemDetails :: Name
fullyQualifiedName, Uri
fileUri :: Uri
$sel:fileUri:CompletionItemDetails :: Uri
fileUri}
    }
  where
    -- Pads an integer with zeroes so it sorts lexicographically in the right order
    --
    -- >>> paddedInt 1
    -- "00001"
    paddedInt :: Int -> Text
    paddedInt :: Int -> Text
paddedInt Int
n =
      Int -> Char -> Text -> Text
Text.justifyRight Int
5 Char
'0' ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
    -- We should generally show the longer of the path or suffixified name in the label,
    -- it helps the user understand the difference between options which may otherwise look
    -- the same.
    --
    -- E.g. if I type "ma" then the suffixied options might be: List.map, Bag.map, but the
    -- path matches are just "map" and "map" since the query starts at that segment, so we
    -- show the suffixified version to disambiguate.
    --
    -- However, if the user types "base.List.ma" then the matching path is "base.List.map" and
    -- the suffixification is just "List.map", so we use the path in this case because it more
    -- closely matches what the user actually typed.
    --
    -- This is what's felt best to me, anecdotally.
    lbl :: Text
lbl =
      if Text -> Int
Text.length Text
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
Text.length Text
suffixified
        then Text
path
        else Text
suffixified

-- | LSP clients sort completions using a text field, so we have to convert Unison's sort criteria to text.
matchSortCriteria :: Name -> (Int, Int, Name)
matchSortCriteria :: Name -> (Int, Int, Name)
matchSortCriteria Name
fqn =
  (Int
numLibSegments, Int
numSegments, Name
fqn)
  where
    numSegments :: Int
    numSegments :: Int
numSegments =
      Name -> Int
Name.countSegments Name
fqn
    numLibSegments :: Int
    numLibSegments :: Int
numLibSegments =
      Name -> NonEmpty NameSegment
Name.reverseSegments Name
fqn
        NonEmpty NameSegment
-> (NonEmpty NameSegment -> [NameSegment]) -> [NameSegment]
forall a b. a -> (a -> b) -> b
& NonEmpty NameSegment -> [NameSegment]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
        [NameSegment] -> ([NameSegment] -> [NameSegment]) -> [NameSegment]
forall a b. a -> (a -> b) -> b
& (NameSegment -> Bool) -> [NameSegment] -> [NameSegment]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.libSegment)
        [NameSegment] -> ([NameSegment] -> Int) -> Int
forall a b. a -> (a -> b) -> b
& [NameSegment] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length

-- | Generate a completion tree from a set of names.
-- A completion tree is a suffix tree over the path segments of each name it contains.
-- The goal is to allow fast completion of names by any partial path suffix.
--
-- The tree is generated by building a trie where all possible suffixes of a name are
-- reachable from the root of the trie, with sharing over subtrees to improve memory
-- residency.
--
-- Currently we don't "summarize" all of the children of a node in the node itself, and
-- instead you have to crawl all the children to get the actual completions.
--
-- TODO: Would it be worthwhile to perform compression or include child summaries on the suffix tree?
-- I suspect most namespace trees won't actually compress very well since each node is likely
-- to have terms/types at it.
--
-- E.g. From the names:
-- * alpha.beta.Nat
-- * alpha.Text
-- * foxtrot.Text
--
-- It will generate a tree like the following, where each bullet is a possible completion:
--
-- .
-- ├── foxtrot
-- │   └── Text
-- │       └── * foxtrot.Text (##Text)
-- ├── beta
-- │   └── Nat
-- │       └── * alpha.beta.Nat (##Nat)
-- ├── alpha
-- │   ├── beta
-- │   │   └── Nat
-- │   │       └── * alpha.beta.Nat (##Nat)
-- │   └── Text
-- │       └── * alpha.Text (##Text)
-- ├── Text
-- │   ├── * foxtrot.Text (##Text)
-- │   └── * alpha.Text (##Text)
-- └── Nat
--     └── * alpha.beta.Nat (##Nat)
namesToCompletionTree :: Names -> CompletionTree
namesToCompletionTree :: Names -> CompletionTree
namesToCompletionTree Names {Relation Name Referent
terms :: Relation Name Referent
$sel:terms:Names :: Names -> Relation Name Referent
terms, Relation Name TypeReference
types :: Relation Name TypeReference
$sel:types:Names :: Names -> Relation Name TypeReference
types} =
  let typeCompls :: Set (Name, LabeledDependency)
typeCompls =
        Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation Name TypeReference
types
          Map Name (Set TypeReference)
-> (Map Name (Set TypeReference) -> Set (Name, LabeledDependency))
-> Set (Name, LabeledDependency)
forall a b. a -> (a -> b) -> b
& (Name -> Set TypeReference -> Set (Name, LabeledDependency))
-> Map Name (Set TypeReference) -> Set (Name, LabeledDependency)
forall m a. Monoid m => (Name -> a -> m) -> Map Name a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap
            ( \Name
name Set TypeReference
refs ->
                Set TypeReference
refs
                  Set TypeReference
-> (Set TypeReference -> Set TypeReference) -> Set TypeReference
forall a b. a -> (a -> b) -> b
& Bool -> Set TypeReference -> Set TypeReference
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
isDefinitionDoc (Name -> Bool) -> Name -> Bool
forall a b. (a -> b) -> a -> b
$ Name
name)
                  Set TypeReference
-> (Set TypeReference -> Set (Name, LabeledDependency))
-> Set (Name, LabeledDependency)
forall a b. a -> (a -> b) -> b
& (TypeReference -> (Name, LabeledDependency))
-> Set TypeReference -> Set (Name, LabeledDependency)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map \TypeReference
ref -> (Name
name, TypeReference -> LabeledDependency
LD.typeRef TypeReference
ref)
            )
      termCompls :: Set (Name, LabeledDependency)
termCompls =
        Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Relation Name Referent
terms
          Map Name (Set Referent)
-> (Map Name (Set Referent) -> Set (Name, LabeledDependency))
-> Set (Name, LabeledDependency)
forall a b. a -> (a -> b) -> b
& (Name -> Set Referent -> Set (Name, LabeledDependency))
-> Map Name (Set Referent) -> Set (Name, LabeledDependency)
forall m a. Monoid m => (Name -> a -> m) -> Map Name a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap
            ( \Name
name Set Referent
refs ->
                Set Referent
refs
                  Set Referent -> (Set Referent -> Set Referent) -> Set Referent
forall a b. a -> (a -> b) -> b
& Bool -> Set Referent -> Set Referent
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Bool
isDefinitionDoc (Name -> Bool) -> Name -> Bool
forall a b. (a -> b) -> a -> b
$ Name
name)
                  Set Referent
-> (Set Referent -> Set (Name, LabeledDependency))
-> Set (Name, LabeledDependency)
forall a b. a -> (a -> b) -> b
& (Referent -> (Name, LabeledDependency))
-> Set Referent -> Set (Name, LabeledDependency)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map \Referent
ref -> (Name
name, Referent -> LabeledDependency
LD.referent Referent
ref)
            )
   in ((Name, LabeledDependency) -> CompletionTree)
-> Set (Name, LabeledDependency) -> CompletionTree
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Name -> LabeledDependency -> CompletionTree)
-> (Name, LabeledDependency) -> CompletionTree
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Name -> LabeledDependency -> CompletionTree
nameToCompletionTree) (Set (Name, LabeledDependency)
typeCompls Set (Name, LabeledDependency)
-> Set (Name, LabeledDependency) -> Set (Name, LabeledDependency)
forall a. Semigroup a => a -> a -> a
<> Set (Name, LabeledDependency)
termCompls)
  where
    -- It's  annoying to see _all_ the definition docs in autocomplete so we filter them out.
    -- Special docs like "README" will still appear since they're not named 'doc'
    isDefinitionDoc :: Name -> Bool
isDefinitionDoc Name
name =
      case Name -> NonEmpty NameSegment
Name.reverseSegments Name
name of
        (NameSegment
doc :| [NameSegment]
_) -> NameSegment
doc NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.docSegment

nameToCompletionTree :: Name -> LabeledDependency -> CompletionTree
nameToCompletionTree :: Name -> LabeledDependency -> CompletionTree
nameToCompletionTree Name
name LabeledDependency
ref =
  let (NameSegment
lastSegment :| [NameSegment]
prefix) = Name -> NonEmpty NameSegment
Name.reverseSegments Name
name
      complMap :: Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
complMap = Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> [NameSegment]
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
helper (NameSegment
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
forall k a. k -> a -> Map k a
Map.singleton NameSegment
lastSegment ((Name, LabeledDependency) -> Set (Name, LabeledDependency)
forall a. a -> Set a
Set.singleton (Name
name, LabeledDependency
ref) Set (Name, LabeledDependency)
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
forall a. Monoid a => a
mempty)) [NameSegment]
prefix
   in Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> CompletionTree
CompletionTree (Set (Name, LabeledDependency)
forall a. Monoid a => a
mempty Set (Name, LabeledDependency)
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
complMap)
  where
    -- We build the tree bottom-up rather than top-down so we can take 'share' submaps for
    -- improved memory residency, each  call is passed the submap that we built under the
    -- current reversed path prefix.
    helper ::
      Map
        NameSegment
        (Cofree (Map NameSegment) (Set (Name, LabeledDependency))) ->
      [NameSegment] ->
      Map
        NameSegment
        (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
    helper :: Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> [NameSegment]
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
helper Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
subMap [NameSegment]
revPrefix = case [NameSegment]
revPrefix of
      [] -> Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
subMap
      (NameSegment
ns : [NameSegment]
rest) ->
        Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
mergeSubmaps (Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> [NameSegment]
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
helper (NameSegment
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
forall k a. k -> a -> Map k a
Map.singleton NameSegment
ns (Set (Name, LabeledDependency)
forall a. Monoid a => a
mempty Set (Name, LabeledDependency)
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
subMap)) [NameSegment]
rest) Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
subMap
      where
        mergeSubmaps :: Map
  NameSegment
  (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
mergeSubmaps = (Cofree (Map NameSegment) (Set (Name, LabeledDependency))
 -> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
 -> Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> Map
     NameSegment
     (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\Cofree (Map NameSegment) (Set (Name, LabeledDependency))
a Cofree (Map NameSegment) (Set (Name, LabeledDependency))
b -> CompletionTree
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
unCompletionTree (CompletionTree
 -> Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
-> CompletionTree
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
forall a b. (a -> b) -> a -> b
$ Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> CompletionTree
CompletionTree Cofree (Map NameSegment) (Set (Name, LabeledDependency))
a CompletionTree -> CompletionTree -> CompletionTree
forall a. Semigroup a => a -> a -> a
<> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> CompletionTree
CompletionTree Cofree (Map NameSegment) (Set (Name, LabeledDependency))
b)

-- | Crawl the completion tree and return all valid prefix-based completions alongside their
-- Path from the provided prefix, and their full name.
--
-- E.g. if the term "alpha.beta.gamma.map (#abc)" exists in the completion map, and the query is "beta" the result would
-- be:
--
-- @@
-- [(["beta", "gamma", "map"], "alpha.beta.gamma.map", TermReferent #abc)]
-- @@
matchCompletions :: CompletionTree -> Text -> [(Path, Name, LabeledDependency)]
matchCompletions :: CompletionTree -> Text -> [(Path, Name, LabeledDependency)]
matchCompletions (CompletionTree Cofree (Map NameSegment) (Set (Name, LabeledDependency))
tree) Text
txt =
  case Parsec (Token ParseErr) [Char] Name
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] (Token ParseErr)) Name
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser (Parsec (Token ParseErr) [Char] Name
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
Name.nameP Parsec (Token ParseErr) [Char] Name
-> ParsecT (Token ParseErr) [Char] Identity ()
-> Parsec (Token ParseErr) [Char] Name
forall a b.
ParsecT (Token ParseErr) [Char] Identity a
-> ParsecT (Token ParseErr) [Char] Identity b
-> ParsecT (Token ParseErr) [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Token ParseErr) [Char] Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof) [Char]
"" (Text -> [Char]
Text.unpack Text
txt) of
    Left ParseErrorBundle [Char] (Token ParseErr)
_ -> []
    Right Name
name -> [NameSegment]
-> Cofree (Map NameSegment) [(Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
matchSegments (forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList @NonEmpty (Name -> NonEmpty NameSegment
Name.segments Name
name)) (Set (Name, LabeledDependency) -> [(Name, LabeledDependency)]
forall a. Set a -> [a]
Set.toList (Set (Name, LabeledDependency) -> [(Name, LabeledDependency)])
-> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
-> Cofree (Map NameSegment) [(Name, LabeledDependency)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cofree (Map NameSegment) (Set (Name, LabeledDependency))
tree)
  where
    matchSegments :: [NameSegment] -> Cofree (Map NameSegment) [(Name, LabeledDependency)] -> [(Path, Name, LabeledDependency)]
    matchSegments :: [NameSegment]
-> Cofree (Map NameSegment) [(Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
matchSegments [NameSegment]
xs ([(Name, LabeledDependency)]
currentMatches :< Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
subtreeMap) =
      case [NameSegment]
xs of
        [] ->
          let current :: [(Path, Name, LabeledDependency)]
current = [(Name, LabeledDependency)]
currentMatches [(Name, LabeledDependency)]
-> ((Name, LabeledDependency) -> (Path, Name, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Name
name, LabeledDependency
def) -> (Path
Path.empty, Name
name, LabeledDependency
def))
           in ([(Path, Name, LabeledDependency)]
current [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
forall a. Semigroup a => a -> a -> a
<> Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
mkDefMatches Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
subtreeMap)
        [NameSegment
prefix] ->
          (NameSegment -> Bool)
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
forall k a. (k -> Bool) -> Map k a -> Map k a
Map.dropWhileAntitone (NameSegment -> NameSegment -> Bool
forall a. Ord a => a -> a -> Bool
< NameSegment
prefix) Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
subtreeMap
            Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> (Map
      NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
    -> Map
         NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)]))
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
forall a b. a -> (a -> b) -> b
& (NameSegment -> Bool)
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
forall k a. (k -> Bool) -> Map k a -> Map k a
Map.takeWhileAntitone (Text -> Text -> Bool
Text.isPrefixOf (NameSegment -> Text
NameSegment.toUnescapedText NameSegment
prefix) (Text -> Bool) -> (NameSegment -> Text) -> NameSegment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toUnescapedText)
            Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> (Map
      NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
    -> [(Path, Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& \Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
matchingSubtrees ->
              let subMatches :: [(Path, Name, LabeledDependency)]
subMatches = (NameSegment
 -> Cofree (Map NameSegment) [(Name, LabeledDependency)]
 -> [(Path, Name, LabeledDependency)])
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall m a.
Monoid m =>
(NameSegment -> a -> m) -> Map NameSegment a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\NameSegment
ns Cofree (Map NameSegment) [(Name, LabeledDependency)]
subTree -> [NameSegment]
-> Cofree (Map NameSegment) [(Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
matchSegments [] Cofree (Map NameSegment) [(Name, LabeledDependency)]
subTree [(Path, Name, LabeledDependency)]
-> ([(Path, Name, LabeledDependency)]
    -> [(Path, Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& NameSegment
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
consPathPrefix NameSegment
ns) Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
matchingSubtrees
               in [(Path, Name, LabeledDependency)]
subMatches
        (NameSegment
ns : [NameSegment]
rest) ->
          (Cofree (Map NameSegment) [(Name, LabeledDependency)]
 -> [(Path, Name, LabeledDependency)])
-> Maybe (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([NameSegment]
-> Cofree (Map NameSegment) [(Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
matchSegments [NameSegment]
rest) (NameSegment
-> Map
     NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> Maybe (Cofree (Map NameSegment) [(Name, LabeledDependency)])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
ns Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
subtreeMap)
            [(Path, Name, LabeledDependency)]
-> ([(Path, Name, LabeledDependency)]
    -> [(Path, Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
forall a b. a -> (a -> b) -> b
& NameSegment
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
consPathPrefix NameSegment
ns
    consPathPrefix :: NameSegment -> ([(Path, Name, LabeledDependency)]) -> [(Path, Name, LabeledDependency)]
    consPathPrefix :: NameSegment
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
consPathPrefix NameSegment
ns = ASetter
  [(Path, Name, LabeledDependency)]
  [(Path, Name, LabeledDependency)]
  Path
  Path
-> (Path -> Path)
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Path, Name, LabeledDependency)
 -> Identity (Path, Name, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
-> Identity [(Path, Name, LabeledDependency)]
Setter
  [(Path, Name, LabeledDependency)]
  [(Path, Name, LabeledDependency)]
  (Path, Name, LabeledDependency)
  (Path, Name, LabeledDependency)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((Path, Name, LabeledDependency)
  -> Identity (Path, Name, LabeledDependency))
 -> [(Path, Name, LabeledDependency)]
 -> Identity [(Path, Name, LabeledDependency)])
-> ((Path -> Identity Path)
    -> (Path, Name, LabeledDependency)
    -> Identity (Path, Name, LabeledDependency))
-> ASetter
     [(Path, Name, LabeledDependency)]
     [(Path, Name, LabeledDependency)]
     Path
     Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Identity Path)
-> (Path, Name, LabeledDependency)
-> Identity (Path, Name, LabeledDependency)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Path, Name, LabeledDependency)
  (Path, Name, LabeledDependency)
  Path
  Path
_1) (NameSegment -> Path -> Path
Path.cons NameSegment
ns)
    mkDefMatches :: Map NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)]) -> [(Path, Name, LabeledDependency)]
    mkDefMatches :: Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
mkDefMatches Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
xs = do
      (NameSegment
ns, ([(Name, LabeledDependency)]
matches :< Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
rest)) <- Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(NameSegment,
     Cofree (Map NameSegment) [(Name, LabeledDependency)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
xs
      let childMatches :: [(Path, Name, LabeledDependency)]
childMatches = Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
-> [(Path, Name, LabeledDependency)]
mkDefMatches Map
  NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)])
rest [(Path, Name, LabeledDependency)]
-> ((Path, Name, LabeledDependency)
    -> (Path, Name, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((Path -> Identity Path)
 -> (Path, Name, LabeledDependency)
 -> Identity (Path, Name, LabeledDependency))
-> (Path -> Path)
-> (Path, Name, LabeledDependency)
-> (Path, Name, LabeledDependency)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Path -> Identity Path)
-> (Path, Name, LabeledDependency)
-> Identity (Path, Name, LabeledDependency)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Path, Name, LabeledDependency)
  (Path, Name, LabeledDependency)
  Path
  Path
_1 (NameSegment -> Path -> Path
Path.cons NameSegment
ns)
      let currentMatches :: [(Path, Name, LabeledDependency)]
currentMatches = [(Name, LabeledDependency)]
matches [(Name, LabeledDependency)]
-> ((Name, LabeledDependency) -> (Path, Name, LabeledDependency))
-> [(Path, Name, LabeledDependency)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Name
name, LabeledDependency
dep) -> (NameSegment -> Path
Path.singleton NameSegment
ns, Name
name, LabeledDependency
dep)
      [(Path, Name, LabeledDependency)]
currentMatches [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
-> [(Path, Name, LabeledDependency)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Name, LabeledDependency)]
childMatches

-- | Called to resolve additional details for a completion item that the user is considering.
completionItemResolveHandler :: Msg.TRequestMessage 'Msg.Method_CompletionItemResolve -> (Either Msg.ResponseError CompletionItem -> Lsp ()) -> Lsp ()
completionItemResolveHandler :: TRequestMessage 'Method_CompletionItemResolve
-> (Either ResponseError CompletionItem -> Lsp ()) -> Lsp ()
completionItemResolveHandler TRequestMessage 'Method_CompletionItemResolve
message Either ResponseError CompletionItem -> Lsp ()
respond = do
  let completion :: CompletionItem
      completion :: CompletionItem
completion = TRequestMessage 'Method_CompletionItemResolve
message TRequestMessage 'Method_CompletionItemResolve
-> Getting
     CompletionItem
     (TRequestMessage 'Method_CompletionItemResolve)
     CompletionItem
-> CompletionItem
forall s a. s -> Getting a s a -> a
^. Getting
  CompletionItem
  (TRequestMessage 'Method_CompletionItemResolve)
  CompletionItem
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_CompletionItemResolve) CompletionItem
params
  Either ResponseError CompletionItem -> Lsp ()
respond (Either ResponseError CompletionItem -> Lsp ())
-> (Maybe CompletionItem -> Either ResponseError CompletionItem)
-> Maybe CompletionItem
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError CompletionItem
-> (CompletionItem -> Either ResponseError CompletionItem)
-> Maybe CompletionItem
-> Either ResponseError CompletionItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CompletionItem -> Either ResponseError CompletionItem
forall a b. b -> Either a b
Right CompletionItem
completion) CompletionItem -> Either ResponseError CompletionItem
forall a b. b -> Either a b
Right (Maybe CompletionItem -> Lsp ())
-> Lsp (Maybe CompletionItem) -> Lsp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT Lsp CompletionItem -> Lsp (Maybe CompletionItem)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    case Value -> Result CompletionItemDetails
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON (Value -> Result CompletionItemDetails)
-> Maybe Value -> Maybe (Result CompletionItemDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompletionItem
completion CompletionItem
-> Getting (Maybe Value) CompletionItem (Maybe Value)
-> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CompletionItem (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CompletionItem (Maybe Value)
data_) of
      Just (Aeson.Success (CompletionItemDetails {LabeledDependency
$sel:dep:CompletionItemDetails :: CompletionItemDetails -> LabeledDependency
dep :: LabeledDependency
dep, Name
$sel:fullyQualifiedName:CompletionItemDetails :: CompletionItemDetails -> Name
fullyQualifiedName :: Name
fullyQualifiedName, Name
$sel:relativeName:CompletionItemDetails :: CompletionItemDetails -> Name
relativeName :: Name
relativeName, Uri
$sel:fileUri:CompletionItemDetails :: CompletionItemDetails -> Uri
fileUri :: Uri
fileUri})) -> do
        PrettyPrintEnvDecl
pped <- Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl)
-> Lsp PrettyPrintEnvDecl -> MaybeT Lsp PrettyPrintEnvDecl
forall a b. (a -> b) -> a -> b
$ Uri -> Lsp PrettyPrintEnvDecl
ppedForFile Uri
fileUri

        Async (TypecheckedUnisonFile Symbol Ann)
builtinsAsync <- IO (Async (TypecheckedUnisonFile Symbol Ann))
-> MaybeT Lsp (Async (TypecheckedUnisonFile Symbol Ann))
forall a. IO a -> MaybeT Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (TypecheckedUnisonFile Symbol Ann))
 -> MaybeT Lsp (Async (TypecheckedUnisonFile Symbol Ann)))
-> (IO (TypecheckedUnisonFile Symbol Ann)
    -> IO (Async (TypecheckedUnisonFile Symbol Ann)))
-> IO (TypecheckedUnisonFile Symbol Ann)
-> MaybeT Lsp (Async (TypecheckedUnisonFile Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (TypecheckedUnisonFile Symbol Ann)
-> IO (Async (TypecheckedUnisonFile Symbol Ann))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
UnliftIO.async (IO (TypecheckedUnisonFile Symbol Ann)
 -> MaybeT Lsp (Async (TypecheckedUnisonFile Symbol Ann)))
-> IO (TypecheckedUnisonFile Symbol Ann)
-> MaybeT Lsp (Async (TypecheckedUnisonFile Symbol Ann))
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> IO (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. MonadIO m => a -> m a
UnliftIO.evaluate TypecheckedUnisonFile Symbol Ann
IOSource.typecheckedFile
        MaybeT Lsp Bool
checkBuiltinsReady <- IO (MaybeT Lsp Bool) -> MaybeT Lsp (MaybeT Lsp Bool)
forall a. IO a -> MaybeT Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
          MaybeT Lsp Bool -> IO (MaybeT Lsp Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( Async (TypecheckedUnisonFile Symbol Ann)
-> MaybeT
     Lsp
     (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann)))
forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Maybe (Either SomeException a))
UnliftIO.poll Async (TypecheckedUnisonFile Symbol Ann)
builtinsAsync
                MaybeT
  Lsp
  (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann)))
-> (Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann))
    -> Bool)
-> MaybeT Lsp Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \case
                        Maybe (Either SomeException (TypecheckedUnisonFile Symbol Ann))
Nothing -> Bool
False
                        Just (Left {}) -> Bool
False
                        Just (Right {}) -> Bool
True
                    )
            )
        [Text]
renderedDocs <-
          -- We don't want to block the type signature hover info if the docs are taking a long time to render;
          -- We know it's also possible to write docs that eval forever, so the timeout helps
          -- protect against that.
          Lsp (Maybe [Text]) -> MaybeT Lsp (Maybe [Text])
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Lsp [Text] -> Lsp (Maybe [Text])
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
UnliftIO.timeout Int
2_000_000 (Uri -> HashQualified Name -> Lsp [Text]
LSPQ.markdownDocsForFQN Uri
fileUri (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
fullyQualifiedName)))
            MaybeT Lsp (Maybe [Text])
-> (Maybe [Text] -> MaybeT Lsp [Text]) -> MaybeT Lsp [Text]
forall a b. MaybeT Lsp a -> (a -> MaybeT Lsp b) -> MaybeT Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
                    Maybe [Text]
Nothing ->
                      MaybeT Lsp Bool
checkBuiltinsReady MaybeT Lsp Bool -> (Bool -> MaybeT Lsp [Text]) -> MaybeT Lsp [Text]
forall a b. MaybeT Lsp a -> (a -> MaybeT Lsp b) -> MaybeT Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Bool
False -> [Text] -> MaybeT Lsp [Text]
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"\n---\n🔜 Doc renderer is initializing, try again in a few seconds."]
                        Bool
True -> [Text] -> MaybeT Lsp [Text]
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"\n---\n⏳ Timeout evaluating docs"]
                    Just [] -> [Text] -> MaybeT Lsp [Text]
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                    -- Add some space from the type signature
                    Just xs :: [Text]
xs@(Text
_ : [Text]
_) -> [Text] -> MaybeT Lsp [Text]
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"\n---\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)
                )
        case LabeledDependency
dep of
          LD.TermReferent Referent
ref -> do
            Type Symbol Ann
typ <- Uri -> Referent -> MaybeT Lsp (Type Symbol Ann)
LSPQ.getTypeOfReferent Uri
fileUri Referent
ref
            let renderedType :: Text
renderedType = Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Width -> PrettyPrintEnv -> Type Symbol Ann -> [Char]
forall v a.
Var v =>
Maybe Width -> PrettyPrintEnv -> Type v a -> [Char]
TypePrinter.prettyStr (Width -> Maybe Width
forall a. a -> Maybe a
Just Width
typeWidth) (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped) Type Symbol Ann
typ)
            let doc :: Text |? MarkupContent
doc = Text -> Text |? MarkupContent
forall {a}. Text -> a |? MarkupContent
toMarkup ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
"``` unison", Name -> Text
Name.toText Name
fullyQualifiedName, Text
"```"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
renderedDocs)
            pure $ (CompletionItem
completion {_detail = Just renderedType, _documentation = Just doc} :: CompletionItem)
          LD.TypeReference TypeReference
ref ->
            case TypeReference
ref of
              Reference.Builtin {} -> do
                let renderedBuiltin :: Text
renderedBuiltin = Text
": <builtin>"
                let doc :: Text |? MarkupContent
doc = Text -> Text |? MarkupContent
forall {a}. Text -> a |? MarkupContent
toMarkup ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
"``` unison", Name -> Text
Name.toText Name
fullyQualifiedName, Text
"```"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
renderedDocs)
                CompletionItem -> MaybeT Lsp CompletionItem
forall a. a -> MaybeT Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CompletionItem -> MaybeT Lsp CompletionItem)
-> CompletionItem -> MaybeT Lsp CompletionItem
forall a b. (a -> b) -> a -> b
$ (CompletionItem
completion {_detail = Just renderedBuiltin, _documentation = Just doc} :: CompletionItem)
              Reference.DerivedId Id' Hash
refId -> do
                Decl Symbol Ann
decl <- Uri -> Id' Hash -> MaybeT Lsp (Decl Symbol Ann)
LSPQ.getTypeDeclaration Uri
fileUri Id' Hash
refId
                let renderedDecl :: Text
renderedDecl = Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
Text.pack ([Char] -> Text)
-> (Pretty SyntaxText -> [Char]) -> Pretty SyntaxText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> [Char]
Pretty.toPlain Width
typeWidth (Pretty ColorText -> [Char])
-> (Pretty SyntaxText -> Pretty ColorText)
-> Pretty SyntaxText
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty SyntaxText -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pretty.syntaxToColor (Pretty SyntaxText -> Text) -> Pretty SyntaxText -> Text
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl
-> TypeReference
-> HashQualified Name
-> Decl Symbol Ann
-> Pretty SyntaxText
forall v a.
Var v =>
PrettyPrintEnvDecl
-> TypeReference
-> HashQualified Name
-> Decl v a
-> Pretty SyntaxText
DeclPrinter.prettyDecl PrettyPrintEnvDecl
pped TypeReference
ref (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
relativeName) Decl Symbol Ann
decl)
                let doc :: Text |? MarkupContent
doc = Text -> Text |? MarkupContent
forall {a}. Text -> a |? MarkupContent
toMarkup ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
"``` unison", Name -> Text
Name.toText Name
fullyQualifiedName, Text
"```"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
renderedDocs)
                pure $ (CompletionItem
completion {_detail = Just renderedDecl, _documentation = Just doc} :: CompletionItem)
      Maybe (Result CompletionItemDetails)
_ -> MaybeT Lsp CompletionItem
forall a. MaybeT Lsp a
forall (f :: * -> *) a. Alternative f => f a
empty
  where
    toMarkup :: Text -> a |? MarkupContent
toMarkup Text
txt = MarkupContent -> a |? MarkupContent
forall a b. b -> a |? b
InR (MarkupContent -> a |? MarkupContent)
-> MarkupContent -> a |? MarkupContent
forall a b. (a -> b) -> a -> b
$ MarkupContent {$sel:_kind:MarkupContent :: MarkupKind
_kind = MarkupKind
MarkupKind_Markdown, $sel:_value:MarkupContent :: Text
_value = Text
txt}
    -- Completion windows can be very small, so this seems like a good default
    typeWidth :: Width
typeWidth = Int -> Width
Pretty.Width Int
20

-- | Data which will be provided back to us in the completion resolve handler when the user considers this completion.
data CompletionItemDetails = CompletionItemDetails
  { CompletionItemDetails -> LabeledDependency
dep :: LD.LabeledDependency,
    CompletionItemDetails -> Name
relativeName :: Name,
    CompletionItemDetails -> Name
fullyQualifiedName :: Name,
    CompletionItemDetails -> Uri
fileUri :: Uri
  }

instance Aeson.ToJSON CompletionItemDetails where
  toJSON :: CompletionItemDetails -> Value
toJSON CompletionItemDetails {LabeledDependency
$sel:dep:CompletionItemDetails :: CompletionItemDetails -> LabeledDependency
dep :: LabeledDependency
dep, Name
$sel:relativeName:CompletionItemDetails :: CompletionItemDetails -> Name
relativeName :: Name
relativeName, Name
$sel:fullyQualifiedName:CompletionItemDetails :: CompletionItemDetails -> Name
fullyQualifiedName :: Name
fullyQualifiedName, Uri
$sel:fileUri:CompletionItemDetails :: CompletionItemDetails -> Uri
fileUri :: Uri
fileUri} =
    [Pair] -> Value
Aeson.object
      [ Key
"relativeName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Name -> Text
Name.toText Name
relativeName,
        Key
"fullyQualifiedName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Name -> Text
Name.toText Name
fullyQualifiedName,
        Key
"fileUri" Key -> Uri -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Uri
fileUri,
        Key
"dep" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= LabeledDependency -> Value
ldJSON LabeledDependency
dep
      ]
    where
      ldJSON :: LD.LabeledDependency -> Aeson.Value
      ldJSON :: LabeledDependency -> Value
ldJSON = \case
        LD.TypeReference TypeReference
ref -> [Pair] -> Value
Aeson.object [Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= (Text
"type" :: Text), Key
"ref" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= TypeReference -> Text
Reference.toText TypeReference
ref]
        LD.TermReferent Referent
ref -> [Pair] -> Value
Aeson.object [Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= (Text
"term" :: Text), Key
"ref" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Referent -> Text
Referent.toText Referent
ref]

instance Aeson.FromJSON CompletionItemDetails where
  parseJSON :: Value -> Parser CompletionItemDetails
parseJSON = [Char]
-> (Object -> Parser CompletionItemDetails)
-> Value
-> Parser CompletionItemDetails
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"CompletionItemDetails" \Object
obj -> do
    LabeledDependency
dep <- ((Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"dep") Parser Value
-> (Value -> Parser LabeledDependency) -> Parser LabeledDependency
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser LabeledDependency
ldParser)
    Name
relativeName <- (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"relativeName" Parser Text -> (Text -> Parser Name) -> Parser Name
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Name -> (Name -> Parser Name) -> Maybe Name -> Parser Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser Name
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid name in CompletionItemDetails") Name -> Parser Name
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> Parser Name)
-> (Text -> Maybe Name) -> Text -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Name
Name.parseText)
    Name
fullyQualifiedName <- (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"fullyQualifiedName" Parser Text -> (Text -> Parser Name) -> Parser Name
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Name -> (Name -> Parser Name) -> Maybe Name -> Parser Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser Name
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid name in CompletionItemDetails") Name -> Parser Name
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> Parser Name)
-> (Text -> Maybe Name) -> Text -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Name
Name.parseText)
    Uri
fileUri <- Object
obj Object -> Key -> Parser Uri
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"fileUri"
    pure $ CompletionItemDetails {Name
LabeledDependency
Uri
$sel:dep:CompletionItemDetails :: LabeledDependency
$sel:relativeName:CompletionItemDetails :: Name
$sel:fullyQualifiedName:CompletionItemDetails :: Name
$sel:fileUri:CompletionItemDetails :: Uri
dep :: LabeledDependency
relativeName :: Name
fullyQualifiedName :: Name
fileUri :: Uri
..}
    where
      ldParser :: Aeson.Value -> Aeson.Parser LD.LabeledDependency
      ldParser :: Value -> Parser LabeledDependency
ldParser = [Char]
-> (Object -> Parser LabeledDependency)
-> Value
-> Parser LabeledDependency
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"LabeledDependency" \Object
obj -> do
        Text
kind <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"kind"
        case Text
kind of
          (Text
"type" :: Text) -> TypeReference -> LabeledDependency
LD.TypeReference (TypeReference -> LabeledDependency)
-> Parser TypeReference -> Parser LabeledDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"ref" Parser Text
-> (Text -> Parser TypeReference) -> Parser TypeReference
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Parser TypeReference)
-> (TypeReference -> Parser TypeReference)
-> Either [Char] TypeReference
-> Parser TypeReference
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser TypeReference -> [Char] -> Parser TypeReference
forall a b. a -> b -> a
const (Parser TypeReference -> [Char] -> Parser TypeReference)
-> Parser TypeReference -> [Char] -> Parser TypeReference
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser TypeReference
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Reference in LabeledDependency") TypeReference -> Parser TypeReference
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] TypeReference -> Parser TypeReference)
-> (Text -> Either [Char] TypeReference)
-> Text
-> Parser TypeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] TypeReference
Reference.fromText)
          (Text
"term" :: Text) -> Referent -> LabeledDependency
LD.TermReferent (Referent -> LabeledDependency)
-> Parser Referent -> Parser LabeledDependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"ref" Parser Text -> (Text -> Parser Referent) -> Parser Referent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Referent
-> (Referent -> Parser Referent)
-> Maybe Referent
-> Parser Referent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser Referent
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid Referent in LabeledDependency") Referent -> Parser Referent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Referent -> Parser Referent)
-> (Text -> Maybe Referent) -> Text -> Parser Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Referent
Referent.fromText)
          Text
_ -> [Char] -> Parser LabeledDependency
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid LabeledDependency kind"