{- 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.Command 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 Data.Text
import qualified Language.LSP.Protocol.Types.Common

{-|
Represents a reference to a command. Provides a title which
will be used to represent a command in the UI and, optionally,
an array of arguments which will be passed to the command handler
function when invoked.
-}
data Command = Command 
  { {-|
  Title of the command, like `save`.
  -}
  Command -> Text
_title :: Data.Text.Text
  , {-|
  The identifier of the actual command handler.
  -}
  Command -> Text
_command :: Data.Text.Text
  , {-|
  Arguments that the command handler should be
  invoked with.
  -}
  Command -> Maybe [Value]
_arguments :: (Maybe [Data.Aeson.Value])
  }
  deriving stock (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
/= :: Command -> Command -> Bool
Eq, Eq Command
Eq Command =>
(Command -> Command -> Ordering)
-> (Command -> Command -> Bool)
-> (Command -> Command -> Bool)
-> (Command -> Command -> Bool)
-> (Command -> Command -> Bool)
-> (Command -> Command -> Command)
-> (Command -> Command -> Command)
-> Ord Command
Command -> Command -> Bool
Command -> Command -> Ordering
Command -> Command -> Command
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 :: Command -> Command -> Ordering
compare :: Command -> Command -> Ordering
$c< :: Command -> Command -> Bool
< :: Command -> Command -> Bool
$c<= :: Command -> Command -> Bool
<= :: Command -> Command -> Bool
$c> :: Command -> Command -> Bool
> :: Command -> Command -> Bool
$c>= :: Command -> Command -> Bool
>= :: Command -> Command -> Bool
$cmax :: Command -> Command -> Command
max :: Command -> Command -> Command
$cmin :: Command -> Command -> Command
min :: Command -> Command -> Command
Ord, (forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Command -> Rep Command x
from :: forall x. Command -> Rep Command x
$cto :: forall x. Rep Command x -> Command
to :: forall x. Rep Command x -> Command
Generic)
  deriving anyclass (Command -> ()
(Command -> ()) -> NFData Command
forall a. (a -> ()) -> NFData a
$crnf :: Command -> ()
rnf :: Command -> ()
NFData, Eq Command
Eq Command =>
(Int -> Command -> Int) -> (Command -> Int) -> Hashable Command
Int -> Command -> Int
Command -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Command -> Int
hashWithSalt :: Int -> Command -> Int
$chash :: Command -> Int
hash :: Command -> Int
Hashable)
  deriving (forall ann. Command -> Doc ann)
-> (forall ann. [Command] -> Doc ann) -> Pretty Command
forall ann. [Command] -> Doc ann
forall ann. Command -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. Command -> Doc ann
pretty :: forall ann. Command -> Doc ann
$cprettyList :: forall ann. [Command] -> Doc ann
prettyList :: forall ann. [Command] -> Doc ann
Pretty via (ViaJSON Command)

instance Aeson.ToJSON Command where
  toJSON :: Command -> Value
toJSON (Command Text
arg0 Text
arg1 Maybe [Value]
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
"title" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg0]
    ,[Key
"command" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg1]
    ,String
"arguments" String -> Maybe [Value] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe [Value]
arg2]

instance Aeson.FromJSON Command where
  parseJSON :: Value -> Parser Command
parseJSON = String -> (Object -> Parser Command) -> Value -> Parser Command
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Command" ((Object -> Parser Command) -> Value -> Parser Command)
-> (Object -> Parser Command) -> Value -> Parser Command
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Text -> Text -> Maybe [Value] -> Command
Command (Text -> Text -> Maybe [Value] -> Command)
-> Parser Text -> Parser (Text -> Maybe [Value] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"title" Parser (Text -> Maybe [Value] -> Command)
-> Parser Text -> Parser (Maybe [Value] -> Command)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"command" Parser (Maybe [Value] -> Command)
-> Parser (Maybe [Value]) -> Parser Command
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 [Value])
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"arguments"