{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

-- | A MarkupContent literal represents a string value which content can
-- be represented in different formats.
-- Currently plaintext and markdown are supported formats.
-- A MarkupContent is usually used in documentation properties of result
-- literals like CompletionItem or SignatureInformation.
module Language.LSP.Types.MarkupContent where

import           Data.Aeson
import           Data.Aeson.TH
import           Data.Text                                      (Text)
import           Language.LSP.Types.Utils

-- |  Describes the content type that a client supports in various
-- result literals like `Hover`, `ParameterInfo` or `CompletionItem`.
data MarkupKind = MkPlainText -- ^ Plain text is supported as a content format
                | MkMarkdown -- ^ Markdown is supported as a content format
  deriving (ReadPrec [MarkupKind]
ReadPrec MarkupKind
Int -> ReadS MarkupKind
ReadS [MarkupKind]
(Int -> ReadS MarkupKind)
-> ReadS [MarkupKind]
-> ReadPrec MarkupKind
-> ReadPrec [MarkupKind]
-> Read MarkupKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MarkupKind]
$creadListPrec :: ReadPrec [MarkupKind]
readPrec :: ReadPrec MarkupKind
$creadPrec :: ReadPrec MarkupKind
readList :: ReadS [MarkupKind]
$creadList :: ReadS [MarkupKind]
readsPrec :: Int -> ReadS MarkupKind
$creadsPrec :: Int -> ReadS MarkupKind
Read, Int -> MarkupKind -> ShowS
[MarkupKind] -> ShowS
MarkupKind -> String
(Int -> MarkupKind -> ShowS)
-> (MarkupKind -> String)
-> ([MarkupKind] -> ShowS)
-> Show MarkupKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkupKind] -> ShowS
$cshowList :: [MarkupKind] -> ShowS
show :: MarkupKind -> String
$cshow :: MarkupKind -> String
showsPrec :: Int -> MarkupKind -> ShowS
$cshowsPrec :: Int -> MarkupKind -> ShowS
Show, MarkupKind -> MarkupKind -> Bool
(MarkupKind -> MarkupKind -> Bool)
-> (MarkupKind -> MarkupKind -> Bool) -> Eq MarkupKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkupKind -> MarkupKind -> Bool
$c/= :: MarkupKind -> MarkupKind -> Bool
== :: MarkupKind -> MarkupKind -> Bool
$c== :: MarkupKind -> MarkupKind -> Bool
Eq)

instance ToJSON MarkupKind where
  toJSON :: MarkupKind -> Value
toJSON MarkupKind
MkPlainText = Text -> Value
String Text
"plaintext"
  toJSON MarkupKind
MkMarkdown  = Text -> Value
String Text
"markdown"

instance FromJSON MarkupKind where
  parseJSON :: Value -> Parser MarkupKind
parseJSON (String Text
"plaintext") = MarkupKind -> Parser MarkupKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure MarkupKind
MkPlainText
  parseJSON (String Text
"markdown")  = MarkupKind -> Parser MarkupKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure MarkupKind
MkMarkdown
  parseJSON Value
_                    = Parser MarkupKind
forall a. Monoid a => a
mempty

-- | 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
    { MarkupContent -> MarkupKind
_kind  :: MarkupKind -- ^ The type of the Markup
    , MarkupContent -> Text
_value :: Text -- ^ The content itself
    }
  deriving (ReadPrec [MarkupContent]
ReadPrec MarkupContent
Int -> ReadS MarkupContent
ReadS [MarkupContent]
(Int -> ReadS MarkupContent)
-> ReadS [MarkupContent]
-> ReadPrec MarkupContent
-> ReadPrec [MarkupContent]
-> Read MarkupContent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MarkupContent]
$creadListPrec :: ReadPrec [MarkupContent]
readPrec :: ReadPrec MarkupContent
$creadPrec :: ReadPrec MarkupContent
readList :: ReadS [MarkupContent]
$creadList :: ReadS [MarkupContent]
readsPrec :: Int -> ReadS MarkupContent
$creadsPrec :: Int -> ReadS MarkupContent
Read, Int -> MarkupContent -> ShowS
[MarkupContent] -> ShowS
MarkupContent -> String
(Int -> MarkupContent -> ShowS)
-> (MarkupContent -> String)
-> ([MarkupContent] -> ShowS)
-> Show MarkupContent
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
(MarkupContent -> MarkupContent -> Bool)
-> (MarkupContent -> MarkupContent -> Bool) -> Eq MarkupContent
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)

deriveJSON lspOptions ''MarkupContent

-- ---------------------------------------------------------------------

-- | Create a 'MarkupContent' containing a quoted language string only.
markedUpContent :: Text -> Text -> MarkupContent
markedUpContent :: Text -> Text -> MarkupContent
markedUpContent Text
lang Text
quote
 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown (Text
"\n```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n```\n")

-- ---------------------------------------------------------------------

-- | Create a 'MarkupContent' containing unquoted text
unmarkedUpContent :: Text -> MarkupContent
unmarkedUpContent :: Text -> MarkupContent
unmarkedUpContent Text
str = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkPlainText Text
str

-- ---------------------------------------------------------------------

-- | Markdown for a section separator in Markdown, being a horizontal line
sectionSeparator :: Text
sectionSeparator :: Text
sectionSeparator = Text
"* * *\n"

-- ---------------------------------------------------------------------

instance Semigroup MarkupContent where
  MarkupContent MarkupKind
MkPlainText Text
s1 <> :: MarkupContent -> MarkupContent -> MarkupContent
<> MarkupContent MarkupKind
MkPlainText Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkPlainText (Text
s1 Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
MkMarkdown  Text
s1 <> MarkupContent MarkupKind
_           Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown  (Text
s1 Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
_           Text
s1 <> MarkupContent MarkupKind
MkMarkdown  Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown  (Text
s1 Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
s2)

instance Monoid MarkupContent where
  mempty :: MarkupContent
mempty = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkPlainText Text
""

-- ---------------------------------------------------------------------