{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE OverloadedLabels   #-}
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           SrcLoc

import           Data.Aeson                   (FromJSON, ToJSON)
import           Data.Text                    (Text)
import           Development.IDE.Spans.Common
import           GHC.Generics                 (Generic)
import           Ide.Plugin.Config            (Config)
import           Ide.Plugin.Properties
import           Ide.PluginUtils              (usePropertyLsp)
import           Ide.Types                    (PluginId)
import           Language.LSP.Server          (MonadLsp)
import           Language.LSP.Types           (CompletionItemKind, Uri)

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

data Backtick = Surrounded | LeftSide
  deriving (Backtick -> Backtick -> Bool
(Backtick -> Backtick -> Bool)
-> (Backtick -> Backtick -> Bool) -> Eq Backtick
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
Eq Backtick
-> (Backtick -> Backtick -> Ordering)
-> (Backtick -> Backtick -> Bool)
-> (Backtick -> Backtick -> Bool)
-> (Backtick -> Backtick -> Bool)
-> (Backtick -> Backtick -> Bool)
-> (Backtick -> Backtick -> Backtick)
-> (Backtick -> Backtick -> Backtick)
-> Ord 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
$cp1Ord :: Eq Backtick
Ord, Int -> Backtick -> ShowS
[Backtick] -> ShowS
Backtick -> String
(Int -> Backtick -> ShowS)
-> (Backtick -> String) -> ([Backtick] -> ShowS) -> Show Backtick
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
  Properties '[]
-> (Properties '[]
    -> Properties '[ 'PropertyKey "snippetsOn" 'TBoolean])
-> Properties '[ 'PropertyKey "snippetsOn" 'TBoolean]
forall a b. a -> (a -> b) -> b
& KeyNameProxy "snippetsOn"
-> Text
-> Bool
-> Properties '[]
-> Properties '[ 'PropertyKey "snippetsOn" 'TBoolean]
forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty IsLabel "snippetsOn" (KeyNameProxy "snippetsOn")
KeyNameProxy "snippetsOn"
#snippetsOn
    Text
"Inserts snippets when using code completions"
    Bool
True
  Properties '[ 'PropertyKey "snippetsOn" 'TBoolean]
-> (Properties '[ 'PropertyKey "snippetsOn" 'TBoolean]
    -> Properties
         '[ 'PropertyKey "autoExtendOn" 'TBoolean,
            'PropertyKey "snippetsOn" 'TBoolean])
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
forall a b. a -> (a -> b) -> b
& KeyNameProxy "autoExtendOn"
-> Text
-> Bool
-> Properties '[ 'PropertyKey "snippetsOn" 'TBoolean]
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty IsLabel "autoExtendOn" (KeyNameProxy "autoExtendOn")
KeyNameProxy "autoExtendOn"
#autoExtendOn
    Text
"Extends the import list automatically when completing a out-of-scope identifier"
    Bool
True

getCompletionsConfig :: (MonadLsp Config m) => PluginId -> m CompletionsConfig
getCompletionsConfig :: PluginId -> m CompletionsConfig
getCompletionsConfig PluginId
pId =
  Bool -> Bool -> CompletionsConfig
CompletionsConfig
    (Bool -> Bool -> CompletionsConfig)
-> m Bool -> m (Bool -> CompletionsConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyNameProxy "snippetsOn"
-> PluginId
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
-> m (ToHsType 'TBoolean)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp IsLabel "snippetsOn" (KeyNameProxy "snippetsOn")
KeyNameProxy "snippetsOn"
#snippetsOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties
    m (Bool -> CompletionsConfig) -> m Bool -> m CompletionsConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyNameProxy "autoExtendOn"
-> PluginId
-> Properties
     '[ 'PropertyKey "autoExtendOn" 'TBoolean,
        'PropertyKey "snippetsOn" 'TBoolean]
-> m (ToHsType 'TBoolean)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp IsLabel "autoExtendOn" (KeyNameProxy "autoExtendOn")
KeyNameProxy "autoExtendOn"
#autoExtendOn PluginId
pId Properties
  '[ 'PropertyKey "autoExtendOn" 'TBoolean,
     'PropertyKey "snippetsOn" 'TBoolean]
properties


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

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
(ExtendImport -> ExtendImport -> Bool)
-> (ExtendImport -> ExtendImport -> Bool) -> Eq ExtendImport
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
(Int -> ExtendImport -> ShowS)
-> (ExtendImport -> String)
-> ([ExtendImport] -> ShowS)
-> Show ExtendImport
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. ExtendImport -> Rep ExtendImport x)
-> (forall x. Rep ExtendImport x -> ExtendImport)
-> Generic ExtendImport
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
(Value -> Parser ExtendImport)
-> (Value -> Parser [ExtendImport]) -> FromJSON 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
(ExtendImport -> Value)
-> (ExtendImport -> Encoding)
-> ([ExtendImport] -> Value)
-> ([ExtendImport] -> Encoding)
-> ToJSON ExtendImport
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 CompItem = CI
  { CompItem -> CompletionItemKind
compKind            :: CompletionItemKind
  , CompItem -> Text
insertText          :: T.Text         -- ^ Snippet for the completion
  , CompItem -> Either SrcSpan Text
importedFrom        :: Either SrcSpan T.Text         -- ^ From where this item is imported from.
  , CompItem -> Maybe Text
typeText            :: Maybe T.Text   -- ^ Available type information.
  , CompItem -> Text
label               :: T.Text         -- ^ Label to display to the user.
  , CompItem -> Maybe Backtick
isInfix             :: Maybe Backtick -- ^ Did the completion happen
                                   -- in the context of an infix notation.
  , CompItem -> SpanDoc
docs                :: SpanDoc        -- ^ Available documentation.
  , CompItem -> Bool
isTypeCompl         :: Bool
  , CompItem -> Maybe ExtendImport
additionalTextEdits :: Maybe ExtendImport
  }
  deriving (CompItem -> CompItem -> Bool
(CompItem -> CompItem -> Bool)
-> (CompItem -> CompItem -> Bool) -> Eq CompItem
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
(Int -> CompItem -> ShowS)
-> (CompItem -> String) -> ([CompItem] -> ShowS) -> Show CompItem
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
(Int -> QualCompls -> ShowS)
-> (QualCompls -> String)
-> ([QualCompls] -> ShowS)
-> Show QualCompls
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 (Map Text [CompItem] -> QualCompls)
-> Map Text [CompItem] -> QualCompls
forall a b. (a -> b) -> a -> b
$ ([CompItem] -> [CompItem] -> [CompItem])
-> Map Text [CompItem]
-> Map Text [CompItem]
-> Map Text [CompItem]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [CompItem] -> [CompItem] -> [CompItem]
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 Map Text [CompItem]
forall k a. Map k a
Map.empty
  mappend :: QualCompls -> QualCompls -> QualCompls
mappend = QualCompls -> QualCompls -> QualCompls
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]  -- ^ All Possible completion items
  , CachedCompletions -> QualCompls
qualCompls        :: QualCompls    -- ^ Completion items associated to
                                -- to a specific module name.
  , CachedCompletions -> [Text]
importableModules :: [T.Text] -- ^ All modules that may be imported.
  } deriving Int -> CachedCompletions -> ShowS
[CachedCompletions] -> ShowS
CachedCompletions -> String
(Int -> CachedCompletions -> ShowS)
-> (CachedCompletions -> String)
-> ([CachedCompletions] -> ShowS)
-> Show CachedCompletions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachedCompletions] -> ShowS
$cshowList :: [CachedCompletions] -> ShowS
show :: CachedCompletions -> String
$cshow :: CachedCompletions -> String
showsPrec :: Int -> CachedCompletions -> ShowS
$cshowsPrec :: Int -> CachedCompletions -> ShowS
Show

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

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

instance Semigroup CachedCompletions where
    CC [Text]
a [CompItem]
b QualCompls
c [Text]
d <> :: CachedCompletions -> CachedCompletions -> CachedCompletions
<> CC [Text]
a' [CompItem]
b' QualCompls
c' [Text]
d' =
        [Text] -> [CompItem] -> QualCompls -> [Text] -> CachedCompletions
CC ([Text]
a[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>[Text]
a') ([CompItem]
b[CompItem] -> [CompItem] -> [CompItem]
forall a. Semigroup a => a -> a -> a
<>[CompItem]
b') (QualCompls
cQualCompls -> QualCompls -> QualCompls
forall a. Semigroup a => a -> a -> a
<>QualCompls
c') ([Text]
d[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>[Text]
d')