{-# 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```" 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")

-- | 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 a b. (a -> b) -> [a] -> [b]
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
MarkupKind_PlainText Text
s1 <> :: MarkupContent -> MarkupContent -> MarkupContent
<> MarkupContent MarkupKind
MarkupKind_PlainText Text
s2 = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_PlainText (Text
s1 Text -> Text -> Text
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 Text -> Text -> Text
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 Text -> Text -> Text
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 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
MarkupKind_PlainText Text
""

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