{- ORMOLU_DISABLE -}
{- HLINT ignore -}
-- THIS IS A GENERATED FILE, DO NOT EDIT

{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Language.LSP.Protocol.Internal.Types.CompletionList where

import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import qualified Data.Aeson
import qualified Data.Aeson as Aeson
import qualified Data.Row as Row
import qualified Data.Row.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Data.Text
import qualified Language.LSP.Protocol.Internal.Types.CompletionItem
import qualified Language.LSP.Protocol.Internal.Types.InsertTextFormat
import qualified Language.LSP.Protocol.Internal.Types.InsertTextMode
import qualified Language.LSP.Protocol.Internal.Types.Range
import qualified Language.LSP.Protocol.Types.Common

{-|
Represents a collection of `CompletionItem` to be presented
in the editor.
-}
data CompletionList = CompletionList 
  { {-|
  This list it not complete. Further typing results in recomputing this list.

  Recomputed lists have all their items replaced (not appended) in the
  incomplete completion sessions.
  -}
  CompletionList -> Bool
_isIncomplete :: Bool
  , {-|
  In many cases the items of an actual completion result share the same
  value for properties like `commitCharacters` or the range of a text
  edit. A completion list can therefore define item defaults which will
  be used if a completion item itself doesn't specify the value.

  If a completion list specifies a default value and a completion item
  also specifies a corresponding value the one from the item is used.

  Servers are only allowed to return default values if the client
  signals support for this via the `completionList.itemDefaults`
  capability.

  @since 3.17.0
  -}
  CompletionList
-> Maybe
     (Rec
        (("commitCharacters" .== Maybe [Text])
         .+ (("editRange"
              .== Maybe
                    (Range
                     |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
             .+ (("insertTextFormat" .== Maybe InsertTextFormat)
                 .+ (("insertTextMode" .== Maybe InsertTextMode)
                     .+ (("data" .== Maybe Value) .+ Empty))))))
_itemDefaults :: (Maybe (Row.Rec ("commitCharacters" Row..== (Maybe [Data.Text.Text]) Row..+ ("editRange" Row..== (Maybe (Language.LSP.Protocol.Internal.Types.Range.Range Language.LSP.Protocol.Types.Common.|? (Row.Rec ("insert" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ ("replace" Row..== Language.LSP.Protocol.Internal.Types.Range.Range Row..+ Row.Empty))))) Row..+ ("insertTextFormat" Row..== (Maybe Language.LSP.Protocol.Internal.Types.InsertTextFormat.InsertTextFormat) Row..+ ("insertTextMode" Row..== (Maybe Language.LSP.Protocol.Internal.Types.InsertTextMode.InsertTextMode) Row..+ ("data" Row..== (Maybe Data.Aeson.Value) Row..+ Row.Empty)))))))
  , {-|
  The completion items.
  -}
  CompletionList -> [CompletionItem]
_items :: [Language.LSP.Protocol.Internal.Types.CompletionItem.CompletionItem]
  }
  deriving stock (Int -> CompletionList -> ShowS
[CompletionList] -> ShowS
CompletionList -> String
(Int -> CompletionList -> ShowS)
-> (CompletionList -> String)
-> ([CompletionList] -> ShowS)
-> Show CompletionList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionList -> ShowS
showsPrec :: Int -> CompletionList -> ShowS
$cshow :: CompletionList -> String
show :: CompletionList -> String
$cshowList :: [CompletionList] -> ShowS
showList :: [CompletionList] -> ShowS
Show, CompletionList -> CompletionList -> Bool
(CompletionList -> CompletionList -> Bool)
-> (CompletionList -> CompletionList -> Bool) -> Eq CompletionList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionList -> CompletionList -> Bool
== :: CompletionList -> CompletionList -> Bool
$c/= :: CompletionList -> CompletionList -> Bool
/= :: CompletionList -> CompletionList -> Bool
Eq, Eq CompletionList
Eq CompletionList =>
(CompletionList -> CompletionList -> Ordering)
-> (CompletionList -> CompletionList -> Bool)
-> (CompletionList -> CompletionList -> Bool)
-> (CompletionList -> CompletionList -> Bool)
-> (CompletionList -> CompletionList -> Bool)
-> (CompletionList -> CompletionList -> CompletionList)
-> (CompletionList -> CompletionList -> CompletionList)
-> Ord CompletionList
CompletionList -> CompletionList -> Bool
CompletionList -> CompletionList -> Ordering
CompletionList -> CompletionList -> CompletionList
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
$ccompare :: CompletionList -> CompletionList -> Ordering
compare :: CompletionList -> CompletionList -> Ordering
$c< :: CompletionList -> CompletionList -> Bool
< :: CompletionList -> CompletionList -> Bool
$c<= :: CompletionList -> CompletionList -> Bool
<= :: CompletionList -> CompletionList -> Bool
$c> :: CompletionList -> CompletionList -> Bool
> :: CompletionList -> CompletionList -> Bool
$c>= :: CompletionList -> CompletionList -> Bool
>= :: CompletionList -> CompletionList -> Bool
$cmax :: CompletionList -> CompletionList -> CompletionList
max :: CompletionList -> CompletionList -> CompletionList
$cmin :: CompletionList -> CompletionList -> CompletionList
min :: CompletionList -> CompletionList -> CompletionList
Ord, (forall x. CompletionList -> Rep CompletionList x)
-> (forall x. Rep CompletionList x -> CompletionList)
-> Generic CompletionList
forall x. Rep CompletionList x -> CompletionList
forall x. CompletionList -> Rep CompletionList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompletionList -> Rep CompletionList x
from :: forall x. CompletionList -> Rep CompletionList x
$cto :: forall x. Rep CompletionList x -> CompletionList
to :: forall x. Rep CompletionList x -> CompletionList
Generic)
  deriving anyclass (CompletionList -> ()
(CompletionList -> ()) -> NFData CompletionList
forall a. (a -> ()) -> NFData a
$crnf :: CompletionList -> ()
rnf :: CompletionList -> ()
NFData, Eq CompletionList
Eq CompletionList =>
(Int -> CompletionList -> Int)
-> (CompletionList -> Int) -> Hashable CompletionList
Int -> CompletionList -> Int
CompletionList -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> CompletionList -> Int
hashWithSalt :: Int -> CompletionList -> Int
$chash :: CompletionList -> Int
hash :: CompletionList -> Int
Hashable)
  deriving (forall ann. CompletionList -> Doc ann)
-> (forall ann. [CompletionList] -> Doc ann)
-> Pretty CompletionList
forall ann. [CompletionList] -> Doc ann
forall ann. CompletionList -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. CompletionList -> Doc ann
pretty :: forall ann. CompletionList -> Doc ann
$cprettyList :: forall ann. [CompletionList] -> Doc ann
prettyList :: forall ann. [CompletionList] -> Doc ann
Pretty via (ViaJSON CompletionList)

instance Aeson.ToJSON CompletionList where
  toJSON :: CompletionList -> Value
toJSON (CompletionList Bool
arg0 Maybe
  (Rec
     (("commitCharacters" .== Maybe [Text])
      .+ (("editRange"
           .== Maybe
                 (Range
                  |? Rec (("insert" .== Range) .+ (("replace" .== Range) .+ Empty))))
          .+ (("insertTextFormat" .== Maybe InsertTextFormat)
              .+ (("insertTextMode" .== Maybe InsertTextMode)
                  .+ (("data" .== Maybe Value) .+ Empty))))))
arg1 [CompletionItem]
arg2) = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pair]] -> [Pair]) -> [[Pair]] -> [Pair]
forall a b. (a -> b) -> a -> b
$  [[Key
"isIncomplete" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Bool
arg0]
    ,String
"itemDefaults" String
-> Maybe
     (Rec
        ('R
           '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
             "editRange"
             ':-> Maybe
                    (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
             "insertTextFormat" ':-> Maybe InsertTextFormat,
             "insertTextMode" ':-> Maybe InsertTextMode]))
-> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? 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]))
arg1
    ,[Key
"items" Key -> [CompletionItem] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [CompletionItem]
arg2]]

instance Aeson.FromJSON CompletionList where
  parseJSON :: Value -> Parser CompletionList
parseJSON = String
-> (Object -> Parser CompletionList)
-> Value
-> Parser CompletionList
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CompletionList" ((Object -> Parser CompletionList)
 -> Value -> Parser CompletionList)
-> (Object -> Parser CompletionList)
-> Value
-> Parser CompletionList
forall a b. (a -> b) -> a -> b
$ \Object
arg -> 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
Bool
-> Maybe
     (Rec
        ('R
           '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
             "editRange"
             ':-> Maybe
                    (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
             "insertTextFormat" ':-> Maybe InsertTextFormat,
             "insertTextMode" ':-> Maybe InsertTextMode]))
-> [CompletionItem]
-> CompletionList
CompletionList (Bool
 -> Maybe
      (Rec
         ('R
            '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
              "editRange"
              ':-> Maybe
                     (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
              "insertTextFormat" ':-> Maybe InsertTextFormat,
              "insertTextMode" ':-> Maybe InsertTextMode]))
 -> [CompletionItem]
 -> CompletionList)
-> Parser Bool
-> Parser
     (Maybe
        (Rec
           ('R
              '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
                "editRange"
                ':-> Maybe
                       (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
                "insertTextFormat" ':-> Maybe InsertTextFormat,
                "insertTextMode" ':-> Maybe InsertTextMode]))
      -> [CompletionItem] -> CompletionList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"isIncomplete" Parser
  (Maybe
     (Rec
        ('R
           '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
             "editRange"
             ':-> Maybe
                    (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
             "insertTextFormat" ':-> Maybe InsertTextFormat,
             "insertTextMode" ':-> Maybe InsertTextMode]))
   -> [CompletionItem] -> CompletionList)
-> Parser
     (Maybe
        (Rec
           ('R
              '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
                "editRange"
                ':-> Maybe
                       (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
                "insertTextFormat" ':-> Maybe InsertTextFormat,
                "insertTextMode" ':-> Maybe InsertTextMode])))
-> Parser ([CompletionItem] -> CompletionList)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object
-> Key
-> Parser
     (Maybe
        (Rec
           ('R
              '["commitCharacters" ':-> Maybe [Text], "data" ':-> Maybe Value,
                "editRange"
                ':-> Maybe
                       (Range |? Rec ('R '["insert" ':-> Range, "replace" ':-> Range])),
                "insertTextFormat" ':-> Maybe InsertTextFormat,
                "insertTextMode" ':-> Maybe InsertTextMode])))
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"itemDefaults" Parser ([CompletionItem] -> CompletionList)
-> Parser [CompletionItem] -> Parser CompletionList
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object -> Key -> Parser [CompletionItem]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"items"