{- 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.InsertTextMode where

import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import qualified Data.Aeson as Aeson
import qualified Data.Row.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Data.Set
import qualified Data.String
import qualified Language.LSP.Protocol.Types.Common
import qualified Language.LSP.Protocol.Types.LspEnum

{-|
How whitespace and indentation is handled during completion
item insertion.

@since 3.16.0
-}
data InsertTextMode = 
    {-|
  The insertion or replace strings is taken as it is. If the
  value is multi line the lines below the cursor will be
  inserted using the indentation defined in the string value.
  The client will not apply any kind of adjustments to the
  string.
  -}
  InsertTextMode_AsIs
  | {-|
  The editor adjusts leading whitespace of new lines so that
  they match the indentation up to the cursor of the line for
  which the item is accepted.

  Consider a line like this: <2tabs><cursor><3tabs>foo. Accepting a
  multi line completion item is indented using 2 tabs and all
  following lines inserted will be indented using 2 tabs as well.
  -}
  InsertTextMode_AdjustIndentation
  deriving stock (Int -> InsertTextMode -> ShowS
[InsertTextMode] -> ShowS
InsertTextMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertTextMode] -> ShowS
$cshowList :: [InsertTextMode] -> ShowS
show :: InsertTextMode -> String
$cshow :: InsertTextMode -> String
showsPrec :: Int -> InsertTextMode -> ShowS
$cshowsPrec :: Int -> InsertTextMode -> ShowS
Show, InsertTextMode -> InsertTextMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertTextMode -> InsertTextMode -> Bool
$c/= :: InsertTextMode -> InsertTextMode -> Bool
== :: InsertTextMode -> InsertTextMode -> Bool
$c== :: InsertTextMode -> InsertTextMode -> Bool
Eq, Eq InsertTextMode
InsertTextMode -> InsertTextMode -> Bool
InsertTextMode -> InsertTextMode -> Ordering
InsertTextMode -> InsertTextMode -> InsertTextMode
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 :: InsertTextMode -> InsertTextMode -> InsertTextMode
$cmin :: InsertTextMode -> InsertTextMode -> InsertTextMode
max :: InsertTextMode -> InsertTextMode -> InsertTextMode
$cmax :: InsertTextMode -> InsertTextMode -> InsertTextMode
>= :: InsertTextMode -> InsertTextMode -> Bool
$c>= :: InsertTextMode -> InsertTextMode -> Bool
> :: InsertTextMode -> InsertTextMode -> Bool
$c> :: InsertTextMode -> InsertTextMode -> Bool
<= :: InsertTextMode -> InsertTextMode -> Bool
$c<= :: InsertTextMode -> InsertTextMode -> Bool
< :: InsertTextMode -> InsertTextMode -> Bool
$c< :: InsertTextMode -> InsertTextMode -> Bool
compare :: InsertTextMode -> InsertTextMode -> Ordering
$ccompare :: InsertTextMode -> InsertTextMode -> Ordering
Ord, forall x. Rep InsertTextMode x -> InsertTextMode
forall x. InsertTextMode -> Rep InsertTextMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InsertTextMode x -> InsertTextMode
$cfrom :: forall x. InsertTextMode -> Rep InsertTextMode x
Generic)
  deriving anyclass (InsertTextMode -> ()
forall a. (a -> ()) -> NFData a
rnf :: InsertTextMode -> ()
$crnf :: InsertTextMode -> ()
NFData, Eq InsertTextMode
Int -> InsertTextMode -> Int
InsertTextMode -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InsertTextMode -> Int
$chash :: InsertTextMode -> Int
hashWithSalt :: Int -> InsertTextMode -> Int
$chashWithSalt :: Int -> InsertTextMode -> Int
Hashable)
  deriving ( [InsertTextMode] -> Encoding
[InsertTextMode] -> Value
InsertTextMode -> Encoding
InsertTextMode -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InsertTextMode] -> Encoding
$ctoEncodingList :: [InsertTextMode] -> Encoding
toJSONList :: [InsertTextMode] -> Value
$ctoJSONList :: [InsertTextMode] -> Value
toEncoding :: InsertTextMode -> Encoding
$ctoEncoding :: InsertTextMode -> Encoding
toJSON :: InsertTextMode -> Value
$ctoJSON :: InsertTextMode -> Value
Aeson.ToJSON
  , Value -> Parser [InsertTextMode]
Value -> Parser InsertTextMode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InsertTextMode]
$cparseJSONList :: Value -> Parser [InsertTextMode]
parseJSON :: Value -> Parser InsertTextMode
$cparseJSON :: Value -> Parser InsertTextMode
Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum InsertTextMode Language.LSP.Protocol.Types.Common.UInt)
  deriving forall ann. [InsertTextMode] -> Doc ann
forall ann. InsertTextMode -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [InsertTextMode] -> Doc ann
$cprettyList :: forall ann. [InsertTextMode] -> Doc ann
pretty :: forall ann. InsertTextMode -> Doc ann
$cpretty :: forall ann. InsertTextMode -> Doc ann
Pretty via (ViaJSON InsertTextMode)

instance Language.LSP.Protocol.Types.LspEnum.LspEnum InsertTextMode where
  knownValues :: Set InsertTextMode
knownValues = forall a. Ord a => [a] -> Set a
Data.Set.fromList [InsertTextMode
InsertTextMode_AsIs
    ,InsertTextMode
InsertTextMode_AdjustIndentation]
  type EnumBaseType InsertTextMode = Language.LSP.Protocol.Types.Common.UInt
  toEnumBaseType :: InsertTextMode -> EnumBaseType InsertTextMode
toEnumBaseType InsertTextMode
InsertTextMode_AsIs = UInt
1
  toEnumBaseType InsertTextMode
InsertTextMode_AdjustIndentation = UInt
2
  fromEnumBaseType :: EnumBaseType InsertTextMode -> Maybe InsertTextMode
fromEnumBaseType EnumBaseType InsertTextMode
1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertTextMode
InsertTextMode_AsIs
  fromEnumBaseType EnumBaseType InsertTextMode
2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertTextMode
InsertTextMode_AdjustIndentation
  fromEnumBaseType EnumBaseType InsertTextMode
_ = forall a. Maybe a
Nothing