{-# 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 qualified Data.Text as T
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
_                    = String -> Parser MarkupKind
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"MarkupKind"

-- | 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"

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

-- | Given some plaintext, convert it into some equivalent markdown text.
-- This is not *quite* the identity function.
plainTextToMarkdown :: Text -> Text
-- Line breaks in markdown paragraphs are ignored unless the line ends with two spaces.
-- In order to respect the line breaks in the original plaintext, we stick two spaces on the end of every line.
plainTextToMarkdown :: Text -> Text
plainTextToMarkdown = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"  ") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

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
MkMarkdown 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
MkPlainText Text
s1 <> MarkupContent MarkupKind
MkMarkdown Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown  (Text -> Text
plainTextToMarkdown Text
s1 Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
MkMarkdown Text
s1 <> MarkupContent MarkupKind
MkPlainText Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown  (Text
s1 Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text -> Text
plainTextToMarkdown Text
s2)

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

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

-- | Client capabilities specific to the used markdown parser.
-- @since 3.16.0
data MarkdownClientCapabilities =
  MarkdownClientCapabilities
    { MarkdownClientCapabilities -> Text
_parser :: Text
    , MarkdownClientCapabilities -> Maybe Text
_version :: Maybe Text
    } deriving (Int -> MarkdownClientCapabilities -> ShowS
[MarkdownClientCapabilities] -> ShowS
MarkdownClientCapabilities -> String
(Int -> MarkdownClientCapabilities -> ShowS)
-> (MarkdownClientCapabilities -> String)
-> ([MarkdownClientCapabilities] -> ShowS)
-> Show MarkdownClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkdownClientCapabilities] -> ShowS
$cshowList :: [MarkdownClientCapabilities] -> ShowS
show :: MarkdownClientCapabilities -> String
$cshow :: MarkdownClientCapabilities -> String
showsPrec :: Int -> MarkdownClientCapabilities -> ShowS
$cshowsPrec :: Int -> MarkdownClientCapabilities -> ShowS
Show, ReadPrec [MarkdownClientCapabilities]
ReadPrec MarkdownClientCapabilities
Int -> ReadS MarkdownClientCapabilities
ReadS [MarkdownClientCapabilities]
(Int -> ReadS MarkdownClientCapabilities)
-> ReadS [MarkdownClientCapabilities]
-> ReadPrec MarkdownClientCapabilities
-> ReadPrec [MarkdownClientCapabilities]
-> Read MarkdownClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MarkdownClientCapabilities]
$creadListPrec :: ReadPrec [MarkdownClientCapabilities]
readPrec :: ReadPrec MarkdownClientCapabilities
$creadPrec :: ReadPrec MarkdownClientCapabilities
readList :: ReadS [MarkdownClientCapabilities]
$creadList :: ReadS [MarkdownClientCapabilities]
readsPrec :: Int -> ReadS MarkdownClientCapabilities
$creadsPrec :: Int -> ReadS MarkdownClientCapabilities
Read, MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool
(MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool)
-> (MarkdownClientCapabilities
    -> MarkdownClientCapabilities -> Bool)
-> Eq MarkdownClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool
$c/= :: MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool
== :: MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool
$c== :: MarkdownClientCapabilities -> MarkdownClientCapabilities -> Bool
Eq)

deriveJSON lspOptions ''MarkdownClientCapabilities