{- 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.MarkupContent 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.Text
import qualified Language.LSP.Protocol.Internal.Types.MarkupKind
import qualified Language.LSP.Protocol.Types.Common

{-|
A `MarkupContent` literal represents a string value which content is interpreted base on its
kind flag. Currently the protocol supports `plaintext` and `markdown` as markup kinds.

If the kind is `markdown` then the value can contain fenced code blocks like in GitHub issues.
See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting

Here is an example how such a string can be constructed using JavaScript / TypeScript:
```ts
let markdown: MarkdownContent = {
 kind: MarkupKind.Markdown,
 value: [
   '# Header',
   'Some text',
   '```typescript',
   'someCode();',
   '```'
 ].join('\n')
};
```

*Please Note* that clients might sanitize the return markdown. A client could decide to
remove HTML from the markdown to avoid script execution.
-}
data MarkupContent = MarkupContent 
  { {-|
  The type of the Markup
  -}
  MarkupContent -> MarkupKind
_kind :: Language.LSP.Protocol.Internal.Types.MarkupKind.MarkupKind
  , {-|
  The content itself
  -}
  MarkupContent -> Text
_value :: Data.Text.Text
  }
  deriving stock (Int -> MarkupContent -> ShowS
[MarkupContent] -> ShowS
MarkupContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkupContent] -> ShowS
$cshowList :: [MarkupContent] -> ShowS
show :: MarkupContent -> String
$cshow :: MarkupContent -> String
showsPrec :: Int -> MarkupContent -> ShowS
$cshowsPrec :: Int -> MarkupContent -> ShowS
Show, MarkupContent -> MarkupContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkupContent -> MarkupContent -> Bool
$c/= :: MarkupContent -> MarkupContent -> Bool
== :: MarkupContent -> MarkupContent -> Bool
$c== :: MarkupContent -> MarkupContent -> Bool
Eq, Eq MarkupContent
MarkupContent -> MarkupContent -> Bool
MarkupContent -> MarkupContent -> Ordering
MarkupContent -> MarkupContent -> MarkupContent
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 :: MarkupContent -> MarkupContent -> MarkupContent
$cmin :: MarkupContent -> MarkupContent -> MarkupContent
max :: MarkupContent -> MarkupContent -> MarkupContent
$cmax :: MarkupContent -> MarkupContent -> MarkupContent
>= :: MarkupContent -> MarkupContent -> Bool
$c>= :: MarkupContent -> MarkupContent -> Bool
> :: MarkupContent -> MarkupContent -> Bool
$c> :: MarkupContent -> MarkupContent -> Bool
<= :: MarkupContent -> MarkupContent -> Bool
$c<= :: MarkupContent -> MarkupContent -> Bool
< :: MarkupContent -> MarkupContent -> Bool
$c< :: MarkupContent -> MarkupContent -> Bool
compare :: MarkupContent -> MarkupContent -> Ordering
$ccompare :: MarkupContent -> MarkupContent -> Ordering
Ord, forall x. Rep MarkupContent x -> MarkupContent
forall x. MarkupContent -> Rep MarkupContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkupContent x -> MarkupContent
$cfrom :: forall x. MarkupContent -> Rep MarkupContent x
Generic)
  deriving anyclass (MarkupContent -> ()
forall a. (a -> ()) -> NFData a
rnf :: MarkupContent -> ()
$crnf :: MarkupContent -> ()
NFData, Eq MarkupContent
Int -> MarkupContent -> Int
MarkupContent -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MarkupContent -> Int
$chash :: MarkupContent -> Int
hashWithSalt :: Int -> MarkupContent -> Int
$chashWithSalt :: Int -> MarkupContent -> Int
Hashable)
  deriving forall ann. [MarkupContent] -> Doc ann
forall ann. MarkupContent -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [MarkupContent] -> Doc ann
$cprettyList :: forall ann. [MarkupContent] -> Doc ann
pretty :: forall ann. MarkupContent -> Doc ann
$cpretty :: forall ann. MarkupContent -> Doc ann
Pretty via (ViaJSON MarkupContent)

instance Aeson.ToJSON MarkupContent where
  toJSON :: MarkupContent -> Value
toJSON (MarkupContent MarkupKind
arg0 Text
arg1) = [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
"kind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= MarkupKind
arg0]
    ,[Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg1]]

instance Aeson.FromJSON MarkupContent where
  parseJSON :: Value -> Parser MarkupContent
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"MarkupContent" forall a b. (a -> b) -> a -> b
$ \Object
arg -> MarkupKind -> Text -> MarkupContent
MarkupContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"kind" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"value"