{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedLabels   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE CPP                #-}
module Development.IDE.Plugin.Completions.Types (
  module Development.IDE.Plugin.Completions.Types
) where

import           Control.DeepSeq
import qualified Data.Map                     as Map
import qualified Data.Text                    as T

import           Data.Aeson
import           Data.Aeson.Types
import           Data.Hashable                (Hashable)
import           Data.Text                    (Text)
import           Data.Typeable                (Typeable)
import           Development.IDE.GHC.Compat
import           Development.IDE.Graph        (RuleResult)
import           Development.IDE.Spans.Common
import           GHC.Generics                 (Generic)
import           Ide.Plugin.Properties
import           Language.LSP.Types           (CompletionItemKind (..), Uri)
import qualified Language.LSP.Types           as J
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Types.Name.Occurrence as Occ
#else
import qualified OccName as Occ
#endif

-- | Produce completions info for a file
type instance RuleResult LocalCompletions = CachedCompletions
type instance RuleResult NonLocalCompletions = CachedCompletions

data LocalCompletions = LocalCompletions
    deriving (LocalCompletions -> LocalCompletions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCompletions -> LocalCompletions -> Bool
$c/= :: LocalCompletions -> LocalCompletions -> Bool
== :: LocalCompletions -> LocalCompletions -> Bool
$c== :: LocalCompletions -> LocalCompletions -> Bool
Eq, Int -> LocalCompletions -> ShowS
[LocalCompletions] -> ShowS
LocalCompletions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalCompletions] -> ShowS
$cshowList :: [LocalCompletions] -> ShowS
show :: LocalCompletions -> String
$cshow :: LocalCompletions -> String
showsPrec :: Int -> LocalCompletions -> ShowS
$cshowsPrec :: Int -> LocalCompletions -> ShowS
Show, Typeable, forall x. Rep LocalCompletions x -> LocalCompletions
forall x. LocalCompletions -> Rep LocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalCompletions x -> LocalCompletions
$cfrom :: forall x. LocalCompletions -> Rep LocalCompletions x
Generic)
instance Hashable LocalCompletions
instance NFData   LocalCompletions

data NonLocalCompletions = NonLocalCompletions
    deriving (NonLocalCompletions -> NonLocalCompletions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c/= :: NonLocalCompletions -> NonLocalCompletions -> Bool
== :: NonLocalCompletions -> NonLocalCompletions -> Bool
$c== :: NonLocalCompletions -> NonLocalCompletions -> Bool
Eq, Int -> NonLocalCompletions -> ShowS
[NonLocalCompletions] -> ShowS
NonLocalCompletions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonLocalCompletions] -> ShowS
$cshowList :: [NonLocalCompletions] -> ShowS
show :: NonLocalCompletions -> String
$cshow :: NonLocalCompletions -> String
showsPrec :: Int -> NonLocalCompletions -> ShowS
$cshowsPrec :: Int -> NonLocalCompletions -> ShowS
Show, Typeable, forall x. Rep NonLocalCompletions x -> NonLocalCompletions
forall x. NonLocalCompletions -> Rep NonLocalCompletions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonLocalCompletions x -> NonLocalCompletions
$cfrom :: forall x. NonLocalCompletions -> Rep NonLocalCompletions x
Generic)
instance Hashable NonLocalCompletions
instance NFData   NonLocalCompletions

-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs

data Backtick = Surrounded | LeftSide
  deriving (Backtick -> Backtick -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backtick -> Backtick -> Bool
$c/= :: Backtick -> Backtick -> Bool
== :: Backtick -> Backtick -> Bool
$c== :: Backtick -> Backtick -> Bool
Eq, Eq Backtick
Backtick -> Backtick -> Bool
Backtick -> Backtick -> Ordering
Backtick -> Backtick -> Backtick
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Backtick -> Backtick -> Backtick
$cmin :: Backtick -> Backtick -> Backtick
max :: Backtick -> Backtick -> Backtick
$cmax :: Backtick -> Backtick -> Backtick
>= :: Backtick -> Backtick -> Bool
$c>= :: Backtick -> Backtick -> Bool
> :: Backtick -> Backtick -> Bool
$c> :: Backtick -> Backtick -> Bool
<= :: Backtick -> Backtick -> Bool
$c<= :: Backtick -> Backtick -> Bool
< :: Backtick -> Backtick -> Bool
$c< :: Backtick -> Backtick -> Bool
compare :: Backtick -> Backtick -> Ordering
$ccompare :: Backtick -> Backtick -> Ordering
Ord, Int -> Backtick -> ShowS
[Backtick] -> ShowS
Backtick -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backtick] -> ShowS
$cshowList :: [Backtick] -> ShowS
show :: Backtick -> String
$cshow :: Backtick -> String
showsPrec :: Int -> Backtick -> ShowS
$cshowsPrec :: Int -> Backtick -> ShowS
Show)

extendImportCommandId :: Text
extendImportCommandId :: Text
extendImportCommandId = Text
"extendImport"

properties :: Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties :: Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties = Properties '[]
emptyProperties
  forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty forall a. IsLabel "snippetsOn" a => a
#snippetsOn
    Text
"Inserts snippets when using code completions"
    Bool
True
  forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty forall a. IsLabel "autoExtendOn" a => a
#autoExtendOn
    Text
"Extends the import list automatically when completing a out-of-scope identifier"
    Bool
True


data CompletionsConfig = CompletionsConfig {
  CompletionsConfig -> Bool
enableSnippets   :: Bool,
  CompletionsConfig -> Bool
enableAutoExtend :: Bool,
  CompletionsConfig -> Int
maxCompletions   :: Int
}

data ExtendImport = ExtendImport
  { ExtendImport -> Uri
doc         :: !Uri,
    ExtendImport -> Text
newThing    :: !T.Text,
    ExtendImport -> Maybe Text
thingParent :: !(Maybe T.Text),
    ExtendImport -> Text
importName  :: !T.Text,
    ExtendImport -> Maybe Text
importQual  :: !(Maybe T.Text)
  }
  deriving (ExtendImport -> ExtendImport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendImport -> ExtendImport -> Bool
$c/= :: ExtendImport -> ExtendImport -> Bool
== :: ExtendImport -> ExtendImport -> Bool
$c== :: ExtendImport -> ExtendImport -> Bool
Eq, Int -> ExtendImport -> ShowS
[ExtendImport] -> ShowS
ExtendImport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendImport] -> ShowS
$cshowList :: [ExtendImport] -> ShowS
show :: ExtendImport -> String
$cshow :: ExtendImport -> String
showsPrec :: Int -> ExtendImport -> ShowS
$cshowsPrec :: Int -> ExtendImport -> ShowS
Show, forall x. Rep ExtendImport x -> ExtendImport
forall x. ExtendImport -> Rep ExtendImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtendImport x -> ExtendImport
$cfrom :: forall x. ExtendImport -> Rep ExtendImport x
Generic)
  deriving anyclass (Value -> Parser [ExtendImport]
Value -> Parser ExtendImport
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExtendImport]
$cparseJSONList :: Value -> Parser [ExtendImport]
parseJSON :: Value -> Parser ExtendImport
$cparseJSON :: Value -> Parser ExtendImport
FromJSON, [ExtendImport] -> Encoding
[ExtendImport] -> Value
ExtendImport -> Encoding
ExtendImport -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExtendImport] -> Encoding
$ctoEncodingList :: [ExtendImport] -> Encoding
toJSONList :: [ExtendImport] -> Value
$ctoJSONList :: [ExtendImport] -> Value
toEncoding :: ExtendImport -> Encoding
$ctoEncoding :: ExtendImport -> Encoding
toJSON :: ExtendImport -> Value
$ctoJSON :: ExtendImport -> Value
ToJSON)

data Provenance
    = ImportedFrom Text
    | DefinedIn Text
    | Local SrcSpan
    deriving (Provenance -> Provenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c== :: Provenance -> Provenance -> Bool
Eq, Eq Provenance
Provenance -> Provenance -> Bool
Provenance -> Provenance -> Ordering
Provenance -> Provenance -> Provenance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Provenance -> Provenance -> Provenance
$cmin :: Provenance -> Provenance -> Provenance
max :: Provenance -> Provenance -> Provenance
$cmax :: Provenance -> Provenance -> Provenance
>= :: Provenance -> Provenance -> Bool
$c>= :: Provenance -> Provenance -> Bool
> :: Provenance -> Provenance -> Bool
$c> :: Provenance -> Provenance -> Bool
<= :: Provenance -> Provenance -> Bool
$c<= :: Provenance -> Provenance -> Bool
< :: Provenance -> Provenance -> Bool
$c< :: Provenance -> Provenance -> Bool
compare :: Provenance -> Provenance -> Ordering
$ccompare :: Provenance -> Provenance -> Ordering
Ord, Int -> Provenance -> ShowS
[Provenance] -> ShowS
Provenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provenance] -> ShowS
$cshowList :: [Provenance] -> ShowS
show :: Provenance -> String
$cshow :: Provenance -> String
showsPrec :: Int -> Provenance -> ShowS
$cshowsPrec :: Int -> Provenance -> ShowS
Show)

data CompItem = CI
  { CompItem -> CompletionItemKind
compKind            :: CompletionItemKind
  , CompItem -> Text
insertText          :: T.Text         -- ^ Snippet for the completion
  , CompItem -> Provenance
provenance          :: Provenance     -- ^ From where this item is imported from.
  , CompItem -> Text
label               :: T.Text         -- ^ Label to display to the user.
  , CompItem -> Maybe Text
typeText            :: Maybe T.Text
  , CompItem -> Maybe Backtick
isInfix             :: Maybe Backtick -- ^ Did the completion happen
                                   -- in the context of an infix notation.
  , CompItem -> Bool
isTypeCompl         :: Bool
  , CompItem -> Maybe ExtendImport
additionalTextEdits :: Maybe ExtendImport
  , CompItem -> Maybe NameDetails
nameDetails         :: Maybe NameDetails -- ^ For resolving purposes
  , CompItem -> Bool
isLocalCompletion   :: Bool              -- ^ Is it from this module?
  }
  deriving (CompItem -> CompItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompItem -> CompItem -> Bool
$c/= :: CompItem -> CompItem -> Bool
== :: CompItem -> CompItem -> Bool
$c== :: CompItem -> CompItem -> Bool
Eq, Int -> CompItem -> ShowS
[CompItem] -> ShowS
CompItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompItem] -> ShowS
$cshowList :: [CompItem] -> ShowS
show :: CompItem -> String
$cshow :: CompItem -> String
showsPrec :: Int -> CompItem -> ShowS
$cshowsPrec :: Int -> CompItem -> ShowS
Show)

-- Associates a module's qualifier with its members
newtype QualCompls
  = QualCompls { QualCompls -> Map Text [CompItem]
getQualCompls :: Map.Map T.Text [CompItem] }
  deriving Int -> QualCompls -> ShowS
[QualCompls] -> ShowS
QualCompls -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualCompls] -> ShowS
$cshowList :: [QualCompls] -> ShowS
show :: QualCompls -> String
$cshow :: QualCompls -> String
showsPrec :: Int -> QualCompls -> ShowS
$cshowsPrec :: Int -> QualCompls -> ShowS
Show
instance Semigroup QualCompls where
  (QualCompls Map Text [CompItem]
a) <> :: QualCompls -> QualCompls -> QualCompls
<> (QualCompls Map Text [CompItem]
b) = Map Text [CompItem] -> QualCompls
QualCompls forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. [a] -> [a] -> [a]
(++) Map Text [CompItem]
a Map Text [CompItem]
b
instance Monoid QualCompls where
  mempty :: QualCompls
mempty = Map Text [CompItem] -> QualCompls
QualCompls forall k a. Map k a
Map.empty
  mappend :: QualCompls -> QualCompls -> QualCompls
mappend = forall a. Semigroup a => a -> a -> a
(Prelude.<>)

-- | End result of the completions
data CachedCompletions = CC
  { CachedCompletions -> [Text]
allModNamesAsNS   :: [T.Text] -- ^ All module names in scope.
                                -- Prelude is a single module
  , CachedCompletions -> [CompItem]
unqualCompls      :: [CompItem]  -- ^ Unqualified completion items
  , CachedCompletions -> QualCompls
qualCompls        :: QualCompls    -- ^ Completion items associated to
                                -- to a specific module name.
  , CachedCompletions -> [Maybe Text -> CompItem]
anyQualCompls     :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier
  , CachedCompletions -> [Text]
importableModules :: [T.Text] -- ^ All modules that may be imported.
  }

instance Show CachedCompletions where show :: CachedCompletions -> String
show CachedCompletions
_ = String
"<cached completions>"

instance NFData CachedCompletions where
    rnf :: CachedCompletions -> ()
rnf = forall a. a -> ()
rwhnf

instance Monoid CachedCompletions where
    mempty :: CachedCompletions
mempty = [Text]
-> [CompItem]
-> QualCompls
-> [Maybe Text -> CompItem]
-> [Text]
-> CachedCompletions
CC forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Semigroup CachedCompletions where
    CC [Text]
a [CompItem]
b QualCompls
c [Maybe Text -> CompItem]
d [Text]
e <> :: CachedCompletions -> CachedCompletions -> CachedCompletions
<> CC [Text]
a' [CompItem]
b' QualCompls
c' [Maybe Text -> CompItem]
d' [Text]
e' =
        [Text]
-> [CompItem]
-> QualCompls
-> [Maybe Text -> CompItem]
-> [Text]
-> CachedCompletions
CC ([Text]
aforall a. Semigroup a => a -> a -> a
<>[Text]
a') ([CompItem]
bforall a. Semigroup a => a -> a -> a
<>[CompItem]
b') (QualCompls
cforall a. Semigroup a => a -> a -> a
<>QualCompls
c') ([Maybe Text -> CompItem]
dforall a. Semigroup a => a -> a -> a
<>[Maybe Text -> CompItem]
d') ([Text]
eforall a. Semigroup a => a -> a -> a
<>[Text]
e')


-- | Describes the line at the current cursor position
data PosPrefixInfo = PosPrefixInfo
  { PosPrefixInfo -> Text
fullLine    :: !T.Text
    -- ^ The full contents of the line the cursor is at

  , PosPrefixInfo -> Text
prefixScope :: !T.Text
    -- ^ If any, the module name that was typed right before the cursor position.
    --  For example, if the user has typed "Data.Maybe.from", then this property
    --  will be "Data.Maybe"
    -- If OverloadedRecordDot is enabled, "Shape.rect.width" will be
    -- "Shape.rect"

  , PosPrefixInfo -> Text
prefixText  :: !T.Text
    -- ^ The word right before the cursor position, after removing the module part.
    -- For example if the user has typed "Data.Maybe.from",
    -- then this property will be "from"
  , PosPrefixInfo -> Position
cursorPos   :: !J.Position
    -- ^ The cursor position
  } deriving (Int -> PosPrefixInfo -> ShowS
[PosPrefixInfo] -> ShowS
PosPrefixInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PosPrefixInfo] -> ShowS
$cshowList :: [PosPrefixInfo] -> ShowS
show :: PosPrefixInfo -> String
$cshow :: PosPrefixInfo -> String
showsPrec :: Int -> PosPrefixInfo -> ShowS
$cshowsPrec :: Int -> PosPrefixInfo -> ShowS
Show,PosPrefixInfo -> PosPrefixInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PosPrefixInfo -> PosPrefixInfo -> Bool
$c/= :: PosPrefixInfo -> PosPrefixInfo -> Bool
== :: PosPrefixInfo -> PosPrefixInfo -> Bool
$c== :: PosPrefixInfo -> PosPrefixInfo -> Bool
Eq)


-- | This is a JSON serialisable representation of a GHC Name that we include in
-- completion responses so that we can recover the original name corresponding
-- to the completion item. This is used to resolve additional details on demand
-- about the item like its type and documentation.
data NameDetails
  = NameDetails Module OccName
  deriving (NameDetails -> NameDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameDetails -> NameDetails -> Bool
$c/= :: NameDetails -> NameDetails -> Bool
== :: NameDetails -> NameDetails -> Bool
$c== :: NameDetails -> NameDetails -> Bool
Eq)

-- NameSpace is abstract so need these
nsJSON :: NameSpace -> Value
nsJSON :: NameSpace -> Value
nsJSON NameSpace
ns
  | NameSpace -> Bool
isVarNameSpace NameSpace
ns = Text -> Value
String Text
"v"
  | NameSpace -> Bool
isDataConNameSpace NameSpace
ns = Text -> Value
String Text
"c"
  | NameSpace -> Bool
isTcClsNameSpace NameSpace
ns  = Text -> Value
String Text
"t"
  | NameSpace -> Bool
isTvNameSpace NameSpace
ns = Text -> Value
String Text
"z"
  | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"namespace not recognized"

parseNs :: Value -> Parser NameSpace
parseNs :: Value -> Parser NameSpace
parseNs (String Text
"v") = forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSpace
Occ.varName
parseNs (String Text
"c") = forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSpace
dataName
parseNs (String Text
"t") = forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSpace
tcClsName
parseNs (String Text
"z") = forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSpace
tvName
parseNs Value
_ = forall a. Monoid a => a
mempty

instance FromJSON NameDetails where
  parseJSON :: Value -> Parser NameDetails
parseJSON v :: Value
v@(Array Array
_)
    = do
      [Value
modname,Value
modid,Value
namesp,Value
occname] <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      String
mn  <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
modname
      String
mid <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
modid
      NameSpace
ns <- Value -> Parser NameSpace
parseNs Value
namesp
      String
occn <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
occname
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Module -> OccName -> NameDetails
NameDetails (forall u. u -> ModuleName -> GenModule u
mkModule (String -> GenUnit UnitId
stringToUnit String
mid) (String -> ModuleName
mkModuleName String
mn)) (NameSpace -> String -> OccName
mkOccName NameSpace
ns String
occn)
  parseJSON Value
_ = forall a. Monoid a => a
mempty
instance ToJSON NameDetails where
  toJSON :: NameDetails -> Value
toJSON (NameDetails Module
mdl OccName
occ) = forall a. ToJSON a => a -> Value
toJSON [forall a. ToJSON a => a -> Value
toJSON String
mname,forall a. ToJSON a => a -> Value
toJSON String
mid,NameSpace -> Value
nsJSON NameSpace
ns,forall a. ToJSON a => a -> Value
toJSON String
occs]
    where
      mname :: String
mname = ModuleName -> String
moduleNameString forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mdl
      mid :: String
mid = UnitId -> String
unitIdString forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId Module
mdl
      ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
      occs :: String
occs = OccName -> String
occNameString OccName
occ
instance Show NameDetails where
  show :: NameDetails -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON

-- | The data that is acutally sent for resolve support
-- We need the URI to be able to reconstruct the GHC environment
-- in the file the completion was triggered in.
data CompletionResolveData = CompletionResolveData
  { CompletionResolveData -> Uri
itemFile :: Uri
  , CompletionResolveData -> Bool
itemNeedsType :: Bool -- ^ Do we need to lookup a type for this item?
  , CompletionResolveData -> NameDetails
itemName :: NameDetails
  }
  deriving stock forall x. Rep CompletionResolveData x -> CompletionResolveData
forall x. CompletionResolveData -> Rep CompletionResolveData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompletionResolveData x -> CompletionResolveData
$cfrom :: forall x. CompletionResolveData -> Rep CompletionResolveData x
Generic
  deriving anyclass (Value -> Parser [CompletionResolveData]
Value -> Parser CompletionResolveData
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CompletionResolveData]
$cparseJSONList :: Value -> Parser [CompletionResolveData]
parseJSON :: Value -> Parser CompletionResolveData
$cparseJSON :: Value -> Parser CompletionResolveData
FromJSON, [CompletionResolveData] -> Encoding
[CompletionResolveData] -> Value
CompletionResolveData -> Encoding
CompletionResolveData -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CompletionResolveData] -> Encoding
$ctoEncodingList :: [CompletionResolveData] -> Encoding
toJSONList :: [CompletionResolveData] -> Value
$ctoJSONList :: [CompletionResolveData] -> Value
toEncoding :: CompletionResolveData -> Encoding
$ctoEncoding :: CompletionResolveData -> Encoding
toJSON :: CompletionResolveData -> Value
$ctoJSON :: CompletionResolveData -> Value
ToJSON)