{- 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.CodeLens 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.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Language.LSP.Protocol.Internal.Types.Command
import qualified Language.LSP.Protocol.Internal.Types.Range
import qualified Language.LSP.Protocol.Types.Common

{-|
A code lens represents a `Command` that should be shown along with
source text, like the number of references, a way to run tests, etc.

A code lens is _unresolved_ when no command is associated to it. For performance
reasons the creation of a code lens and resolving should be done in two stages.
-}
data CodeLens = CodeLens 
  { {-|
  The range in which this code lens is valid. Should only span a single line.
  -}
  CodeLens -> Range
_range :: Language.LSP.Protocol.Internal.Types.Range.Range
  , {-|
  The command this code lens represents.
  -}
  CodeLens -> Maybe Command
_command :: (Maybe Language.LSP.Protocol.Internal.Types.Command.Command)
  , {-|
  A data entry field that is preserved on a code lens item between
  a `CodeLensRequest` and a `CodeLensResolveRequest`
  -}
  CodeLens -> Maybe Value
_data_ :: (Maybe Data.Aeson.Value)
  }
  deriving stock (Int -> CodeLens -> ShowS
[CodeLens] -> ShowS
CodeLens -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeLens] -> ShowS
$cshowList :: [CodeLens] -> ShowS
show :: CodeLens -> String
$cshow :: CodeLens -> String
showsPrec :: Int -> CodeLens -> ShowS
$cshowsPrec :: Int -> CodeLens -> ShowS
Show, CodeLens -> CodeLens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeLens -> CodeLens -> Bool
$c/= :: CodeLens -> CodeLens -> Bool
== :: CodeLens -> CodeLens -> Bool
$c== :: CodeLens -> CodeLens -> Bool
Eq, Eq CodeLens
CodeLens -> CodeLens -> Bool
CodeLens -> CodeLens -> Ordering
CodeLens -> CodeLens -> CodeLens
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 :: CodeLens -> CodeLens -> CodeLens
$cmin :: CodeLens -> CodeLens -> CodeLens
max :: CodeLens -> CodeLens -> CodeLens
$cmax :: CodeLens -> CodeLens -> CodeLens
>= :: CodeLens -> CodeLens -> Bool
$c>= :: CodeLens -> CodeLens -> Bool
> :: CodeLens -> CodeLens -> Bool
$c> :: CodeLens -> CodeLens -> Bool
<= :: CodeLens -> CodeLens -> Bool
$c<= :: CodeLens -> CodeLens -> Bool
< :: CodeLens -> CodeLens -> Bool
$c< :: CodeLens -> CodeLens -> Bool
compare :: CodeLens -> CodeLens -> Ordering
$ccompare :: CodeLens -> CodeLens -> Ordering
Ord, forall x. Rep CodeLens x -> CodeLens
forall x. CodeLens -> Rep CodeLens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CodeLens x -> CodeLens
$cfrom :: forall x. CodeLens -> Rep CodeLens x
Generic)
  deriving anyclass (CodeLens -> ()
forall a. (a -> ()) -> NFData a
rnf :: CodeLens -> ()
$crnf :: CodeLens -> ()
NFData, Eq CodeLens
Int -> CodeLens -> Int
CodeLens -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: CodeLens -> Int
$chash :: CodeLens -> Int
hashWithSalt :: Int -> CodeLens -> Int
$chashWithSalt :: Int -> CodeLens -> Int
Hashable)
  deriving forall ann. [CodeLens] -> Doc ann
forall ann. CodeLens -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [CodeLens] -> Doc ann
$cprettyList :: forall ann. [CodeLens] -> Doc ann
pretty :: forall ann. CodeLens -> Doc ann
$cpretty :: forall ann. CodeLens -> Doc ann
Pretty via (ViaJSON CodeLens)

instance Aeson.ToJSON CodeLens where
  toJSON :: CodeLens -> Value
toJSON (CodeLens Range
arg0 Maybe Command
arg1 Maybe Value
arg2) = [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$  [[Key
"range" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Range
arg0]
    ,String
"command" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Command
arg1
    ,String
"data" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Value
arg2]

instance Aeson.FromJSON CodeLens where
  parseJSON :: Value -> Parser CodeLens
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CodeLens" forall a b. (a -> b) -> a -> b
$ \Object
arg -> Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"range" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"command" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"data"