module Unison.Server.Doc.Markdown.Types where

import Control.Lens (imap)
import Data.Char qualified as Char
import Data.Char qualified as Text
import Data.Text qualified as Text
import Unison.Prelude

-- | Custom type for converting Docs into Markdown.
-- I tried using the existing cmark-gfm library for this, but we have too many edge-cases
-- for it to work well.
data Markdown
  = -- | E.g. '---'
    ThematicBreak
  | Paragraph [Markdown]
  | BlockQuote [Markdown]
  | -- lang, contents
    CodeBlock Text Text
  | Heading Int [Markdown]
  | OrderedList Int [[Markdown]]
  | UnorderedList [[Markdown]]
  | Txt Text
  | Linebreak
  | InlineCode Text
  | Italics [Markdown]
  | Strong [Markdown]
  | Strikethrough [Markdown]
  | -- label, uri
    Link [Markdown] Text
  | -- label, uri
    Image [Markdown] Text
  | -- Header, cells
    Table (Maybe [[Markdown]]) [[[Markdown]]]
  deriving (Int -> Markdown -> ShowS
[Markdown] -> ShowS
Markdown -> String
(Int -> Markdown -> ShowS)
-> (Markdown -> String) -> ([Markdown] -> ShowS) -> Show Markdown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Markdown -> ShowS
showsPrec :: Int -> Markdown -> ShowS
$cshow :: Markdown -> String
show :: Markdown -> String
$cshowList :: [Markdown] -> ShowS
showList :: [Markdown] -> ShowS
Show)

-- | Render the markdown datatype to markdown text
toText :: [Markdown] -> Text
toText :: [Markdown] -> Text
toText = Markdown -> Text
toText' (Markdown -> Text)
-> ([Markdown] -> Markdown) -> [Markdown] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markdown] -> Markdown
Paragraph
  where
    toText' :: Markdown -> Text
    toText' :: Markdown -> Text
toText' =
      \case
        Markdown
ThematicBreak -> Text
"\n---"
        Paragraph [Markdown]
m -> [Markdown] -> Text
flattenParagraph [Markdown]
m
        BlockQuote [Markdown]
m -> Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenParagraph [Markdown]
m
        CodeBlock Text
lang Text
contents ->
          Text
"```"
            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
contents
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n```\n\n"
        Heading Int
n [Markdown]
contents ->
          (Int -> Text -> Text
Text.replicate Int
n Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Markdown] -> Text
flattenInline [Markdown]
contents)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        -- TODO: Nested lists
        OrderedList Int
startNum [[Markdown]]
items ->
          [[Markdown]]
items
            [[Markdown]] -> ([[Markdown]] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Int -> [Markdown] -> Text) -> [[Markdown]] -> [Text]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap
              ( \Int
n [Markdown]
item ->
                  Int -> Text
forall a. Show a => a -> Text
tShow (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
startNum) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
item
              )
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
Text.unlines
            Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
        UnorderedList [[Markdown]]
items ->
          [[Markdown]]
items
            [[Markdown]] -> ([[Markdown]] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ([Markdown] -> Text) -> [[Markdown]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              ( \[Markdown]
item ->
                  Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
item
              )
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
Text.unlines
            Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
        Txt Text
txt -> Text
txt
        Markdown
Linebreak -> Text
"\n\n"
        InlineCode Text
txt -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
        Italics [Markdown]
md -> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
md Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
        Strong [Markdown]
md -> Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
md Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"
        Strikethrough [Markdown]
md -> Text
"~~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
md Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"~~"
        -- label, uri
        Link [Markdown]
label Text
uri ->
          Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Markdown] -> Text
flattenInline [Markdown]
label) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        Image [Markdown]
label Text
uri -> Text
"![" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Markdown] -> Text
flattenInline [Markdown]
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        Table Maybe [[Markdown]]
_headers [[[Markdown]]]
_rows -> Text
forall a. Monoid a => a
mempty -- TODO
      where
        flattenInline :: [Markdown] -> Text
        flattenInline :: [Markdown] -> Text
flattenInline [Markdown]
m =
          (Markdown -> Text
toText' (Markdown -> Text) -> [Markdown] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markdown]
m)
            [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> Text -> Bool
Text.any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Text.isSpace))
            [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
Text.unwords
        flattenParagraph :: [Markdown] -> Text
        flattenParagraph :: [Markdown] -> Text
flattenParagraph [Markdown]
m =
          let go :: Maybe Text -> Text -> Maybe Text
              go :: Maybe Text -> Text -> Maybe Text
go Maybe Text
Nothing Text
next = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
next
              go (Just Text
acc) Text
next = case (Text -> Maybe (Text, Char)
Text.unsnoc Text
acc, Text -> Maybe (Char, Text)
Text.uncons Text
next) of
                (Maybe (Text, Char)
Nothing, Maybe (Char, Text)
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
next
                (Maybe (Text, Char)
_, Maybe (Char, Text)
Nothing) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                (Just (Text
_, Char
lastChar), Just (Char
firstChar, Text
_))
                  | Char -> Bool
Char.isSpace Char
lastChar Bool -> Bool -> Bool
|| Char -> Bool
Char.isSpace Char
firstChar -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
next
                  | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text
acc, Text
next]
           in case (Maybe Text -> Text -> Maybe Text)
-> Maybe Text -> [Text] -> Maybe Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe Text -> Text -> Maybe Text
go Maybe Text
forall a. Maybe a
Nothing (Markdown -> Text
toText' (Markdown -> Text) -> [Markdown] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markdown]
m) of
                Maybe Text
Nothing -> Text
""
                Just Text
x -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"