{-# OPTIONS_GHC -Wno-orphans #-}

-- | Additional instances and utilities for 'MarkupContent'.
module Language.LSP.Protocol.Types.MarkupContent where

import Data.String
import Data.Text (Text)
import Data.Text qualified as T
import Language.LSP.Protocol.Internal.Types.MarkupContent
import Language.LSP.Protocol.Internal.Types.MarkupKind

-- | Create a 'MarkupContent' containing plain text.
mkPlainText :: Text -> MarkupContent
mkPlainText :: Text -> MarkupContent
mkPlainText = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_PlainText

-- | Create a 'MarkupContent' containing markdown.
mkMarkdown :: Text -> MarkupContent
mkMarkdown :: Text -> MarkupContent
mkMarkdown = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown

-- | Create a 'MarkupContent' containing a language-annotated code block only.
mkMarkdownCodeBlock :: Text -> Text -> MarkupContent
mkMarkdownCodeBlock :: Text -> Text -> MarkupContent
mkMarkdownCodeBlock Text
lang Text
quote =
  MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text
"\n```" forall a. Semigroup a => a -> a -> a
<> Text
lang forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
quote forall a. Semigroup a => a -> a -> a
<> Text
"\n```\n")

-- | 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Semigroup a => a -> a -> a
<> Text
"  ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

instance Semigroup MarkupContent where
  MarkupContent MarkupKind
MarkupKind_PlainText Text
s1 <> :: MarkupContent -> MarkupContent -> MarkupContent
<> MarkupContent MarkupKind
MarkupKind_PlainText Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_PlainText (Text
s1 forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
MarkupKind_Markdown Text
s1 <> MarkupContent MarkupKind
MarkupKind_Markdown Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text
s1 forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
MarkupKind_PlainText Text
s1 <> MarkupContent MarkupKind
MarkupKind_Markdown Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> Text
plainTextToMarkdown Text
s1 forall a. Monoid a => a -> a -> a
`mappend` Text
s2)
  MarkupContent MarkupKind
MarkupKind_Markdown Text
s1 <> MarkupContent MarkupKind
MarkupKind_PlainText Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text
s1 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
MarkupKind_PlainText Text
""

instance IsString MarkupContent where
  fromString :: String -> MarkupContent
fromString = Text -> MarkupContent
mkPlainText forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack