-- | Render Unison.Server.Doc as plain markdown, used in the LSP
module Unison.Server.Doc.Markdown.Render (toMarkdown) where

import Control.Monad.Reader
import Data.Foldable
import Data.Text qualified as Text
import Unison.Codebase.Editor.DisplayObject (DisplayObject (..))
import Unison.Prelude
import Unison.Server.Doc
import Unison.Server.Doc qualified as Doc
import Unison.Server.Doc.Markdown.Types qualified as Md
import Unison.Server.Syntax (SyntaxText)
import Unison.Server.Syntax qualified as Syntax
import Unison.Util.Monoid (foldMapM)

data EmbeddedSource
  = EmbeddedSource SyntaxText SyntaxText
  | Builtin SyntaxText

embeddedSource :: Ref (UnisonHash, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource :: Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource Ref (Text, DisplayObject SyntaxText Src)
ref =
  let embeddedSource' :: (a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (a
_, DisplayObject SyntaxText Src
displayObj) =
        case DisplayObject SyntaxText Src
displayObj of
          BuiltinObject SyntaxText
s -> EmbeddedSource -> Maybe EmbeddedSource
forall a. a -> Maybe a
Just (SyntaxText -> EmbeddedSource
Builtin SyntaxText
s)
          UserObject (Src SyntaxText
sum SyntaxText
det) -> EmbeddedSource -> Maybe EmbeddedSource
forall a. a -> Maybe a
Just (SyntaxText -> SyntaxText -> EmbeddedSource
EmbeddedSource SyntaxText
sum SyntaxText
det)
          MissingObject ShortHash
_ -> Maybe EmbeddedSource
forall a. Maybe a
Nothing
   in case Ref (Text, DisplayObject SyntaxText Src)
ref of
        Term (Text, DisplayObject SyntaxText Src)
s -> (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
forall {a}.
(a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (Text, DisplayObject SyntaxText Src)
s
        Type (Text, DisplayObject SyntaxText Src)
s -> (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
forall {a}.
(a, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource' (Text, DisplayObject SyntaxText Src)
s

normalizeHref :: [Md.Markdown] -> Doc -> MarkdownM [Md.Markdown]
normalizeHref :: [Markdown] -> Doc -> MarkdownM [Markdown]
normalizeHref [Markdown]
label = \case
  Word Text
w -> [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Text -> Markdown
Md.Link [Markdown]
label Text
w]
  Group Doc
d ->
    [Markdown] -> Doc -> MarkdownM [Markdown]
normalizeHref [Markdown]
label Doc
d
  j :: Doc
j@Join {} -> do
    let uri :: Text
uri = Doc -> Text
toRawText Doc
j
    [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Text -> Markdown
Md.Link [Markdown]
label Text
uri]
  Special (Link {}) -> do
    -- We don't support cross-doc links in Markdown (yet)
    [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
label
  Doc
_ -> [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
label

embeddedSourceToMarkdown :: EmbeddedSource -> [Md.Markdown]
embeddedSourceToMarkdown :: EmbeddedSource -> [Markdown]
embeddedSourceToMarkdown EmbeddedSource
source =
  case EmbeddedSource
source of
    Builtin SyntaxText
summary ->
      [ Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (SyntaxText -> Text
Syntax.toPlainText SyntaxText
summary),
        Text -> Markdown
Md.Txt Text
"Built-in provided by the Unison runtime"
      ]
    EmbeddedSource SyntaxText
_summary SyntaxText
details ->
      [Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Text
Syntax.toPlainText SyntaxText
details]

-- | Used when a contained block is expected to be raw text. E.g. inside a CodeBlock.
-- Other renderers may need to handle links and things in code blocks, but for Markdown we don't.
toRawText :: Doc -> Text
toRawText :: Doc -> Text
toRawText Doc
doc =
  case Doc
doc of
    Paragraph [Doc]
ds -> [Doc] -> Text
listToText [Doc]
ds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
    Group Doc
d -> Doc -> Text
toRawText Doc
d
    Join [Doc]
ds -> [Doc] -> Text
listToText [Doc]
ds
    Bold Doc
d -> Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"** "
    Italic Doc
d -> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_ "
    Strikethrough Doc
d -> Text
"~~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"~~ "
    Blockquote Doc
d -> Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Section Doc
d [Doc]
ds ->
      [Text] -> Text
Text.unlines
        [ Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
d,
          [Doc] -> Text
listToText [Doc]
ds
        ]
    UntitledSection [Doc]
ds -> [Doc] -> Text
listToText [Doc]
ds
    Column [Doc]
ds -> [Doc] -> Text
listToText [Doc]
ds
    Word Text
w -> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Code Doc
code -> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
toRawText Doc
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` "
    CodeBlock Text
lang Doc
code ->
      [Text] -> Text
Text.unlines
        [ Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang,
          Doc -> Text
toRawText Doc
code,
          Text
"```\n"
        ]
    Style {} -> Text
""
    Anchor {} -> Text
""
    Doc
Blankline -> Text
"\n\n"
    Doc
Linebreak -> Text
"\n"
    Doc
SectionBreak -> Text
"---\n"
    Tooltip {} -> Text
""
    Aside {} -> Text
""
    Callout {} -> Text
""
    -- Most other things shouldn't appear anywhere inside links and such
    Doc
_ -> Text
""
  where
    listToText :: [Doc] -> Text
listToText [Doc]
xs =
      [Doc]
xs
        [Doc] -> ([Doc] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Doc -> Text) -> [Doc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
toRawText
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
Text.unwords

data MarkdownEnv = MarkdownEnv
  { MarkdownEnv -> Nat
section :: Word64
  }

-- | Tracks the current section level
type MarkdownM = Reader MarkdownEnv

-- | Renders a Doc to a list of Markdown blocks
toMarkdown :: Doc -> [Md.Markdown]
toMarkdown :: Doc -> [Markdown]
toMarkdown Doc
doc = (MarkdownM [Markdown] -> MarkdownEnv -> [Markdown]
forall r a. Reader r a -> r -> a
runReader (Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
doc) MarkdownEnv
env)
  where
    env :: MarkdownEnv
    env :: MarkdownEnv
env = (MarkdownEnv {$sel:section:MarkdownEnv :: Nat
section = Nat
1})

toMarkdown_ :: Doc -> MarkdownM [Md.Markdown]
toMarkdown_ :: Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
doc =
  case Doc
doc of
    Tooltip {} ->
      -- We don't render tooltips in markdown for now
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
forall a. Monoid a => a
mempty
    Word Text
word -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.Txt Text
word]
    Code (Word Text
txt) -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode Text
txt]
    Code Doc
contents -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode (Doc -> Text
toRawText Doc
contents)]
    CodeBlock Text
lang (Word Text
txt) -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Text -> Markdown
Md.CodeBlock Text
lang Text
txt]
    CodeBlock Text
lang Doc
contents -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Text -> Markdown
Md.CodeBlock Text
lang (Doc -> Text
toRawText Doc
contents)]
    Bold Doc
d -> do
      [Markdown]
result <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.Strong [Markdown]
result]
    Italic Doc
d -> do
      [Markdown]
result <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.Italics [Markdown]
result]
    Strikethrough Doc
d -> do
      [Markdown]
result <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.Strikethrough [Markdown]
result]
    Style {} -> [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
forall a. Monoid a => a
mempty
    Anchor Text
uri Doc
d -> do
      [Markdown]
label <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Text -> Markdown
Md.Link [Markdown]
label Text
uri]
    Blockquote Doc
d -> do
      [Markdown]
contents <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.BlockQuote [Markdown]
contents]
    Doc
Blankline ->
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown
Md.Linebreak, Markdown
Md.Linebreak]
    Doc
Linebreak ->
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown
Md.Linebreak]
    Doc
SectionBreak -> do
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown
Md.ThematicBreak]
    Aside Doc
d -> do
      [Markdown]
contents <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
d
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.BlockQuote [Markdown]
contents]
    Callout Maybe Doc
icon Doc
content -> do
      [Markdown]
contents <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
content
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Markdown
Md.BlockQuote ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ [Text -> Markdown
Md.Txt Text
ico, Markdown
Md.Linebreak] [Markdown] -> [Markdown] -> [Markdown]
forall a. Semigroup a => a -> a -> a
<> [Markdown]
contents]
      where
        (Text
ico :: Text) =
          case Maybe Doc
icon of
            Just Doc
emoji ->
              ( Doc -> Text
toRawText (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ Doc
emoji
              )
            Maybe Doc
Nothing -> (Text
"")
    Table [[Doc]]
rows -> do
      [[[Markdown]]]
renderedRows <- ([Doc] -> ReaderT MarkdownEnv Identity [[Markdown]])
-> [[Doc]] -> ReaderT MarkdownEnv Identity [[[Markdown]]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Doc -> MarkdownM [Markdown])
-> [Doc] -> ReaderT MarkdownEnv Identity [[Markdown]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Doc -> MarkdownM [Markdown]
toMarkdown_) [[Doc]]
rows
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Maybe [[Markdown]] -> [[[Markdown]]] -> Markdown
Md.Table Maybe [[Markdown]]
forall a. Maybe a
Nothing [[[Markdown]]]
renderedRows]
    Folded Bool
_isFolded Doc
_summary Doc
details -> do
      -- We don't fold anything in Markdown
      Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
details
    Paragraph [Doc]
docs -> do
      [[Markdown]]
rendered <- [Doc]
-> (Doc -> MarkdownM [Markdown])
-> ReaderT MarkdownEnv Identity [[Markdown]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Doc]
docs Doc -> MarkdownM [Markdown]
toMarkdown_
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Markdown] -> MarkdownM [Markdown])
-> [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ [[Markdown]] -> [Markdown]
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[Markdown]]
rendered [Markdown] -> [Markdown] -> [Markdown]
forall a. Semigroup a => a -> a -> a
<> [Markdown
Md.Linebreak]
    BulletedList [Doc]
items -> do
      [[Markdown]]
rendered <- [Doc]
-> (Doc -> MarkdownM [Markdown])
-> ReaderT MarkdownEnv Identity [[Markdown]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Doc]
items Doc -> MarkdownM [Markdown]
toMarkdown_
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[[Markdown]] -> Markdown
Md.UnorderedList [[Markdown]]
rendered]
    NumberedList Nat
startNum [Doc]
items -> do
      [[Markdown]]
rendered <- [Doc]
-> (Doc -> MarkdownM [Markdown])
-> ReaderT MarkdownEnv Identity [[Markdown]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Doc]
items Doc -> MarkdownM [Markdown]
toMarkdown_
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int -> [[Markdown]] -> Markdown
Md.OrderedList (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
startNum) [[Markdown]]
rendered]
    Section Doc
title [Doc]
docs -> do
      Nat
sectionLevel <- (MarkdownEnv -> Nat) -> ReaderT MarkdownEnv Identity Nat
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MarkdownEnv -> Nat
section
      [Markdown]
renderedTitle <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
title
      [Markdown]
body <- (MarkdownEnv -> MarkdownEnv)
-> MarkdownM [Markdown] -> MarkdownM [Markdown]
forall a.
(MarkdownEnv -> MarkdownEnv)
-> ReaderT MarkdownEnv Identity a -> ReaderT MarkdownEnv Identity a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\MarkdownEnv
env -> MarkdownEnv
env {section = section env + 1}) (MarkdownM [Markdown] -> MarkdownM [Markdown])
-> MarkdownM [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ (Doc -> MarkdownM [Markdown]) -> [Doc] -> MarkdownM [Markdown]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM Doc -> MarkdownM [Markdown]
toMarkdown_ [Doc]
docs
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Markdown] -> MarkdownM [Markdown])
-> [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ [Int -> [Markdown] -> Markdown
Md.Heading (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
sectionLevel) [Markdown]
renderedTitle] [Markdown] -> [Markdown] -> [Markdown]
forall a. Semigroup a => a -> a -> a
<> [Markdown]
body
    NamedLink Doc
label Doc
url -> do
      [Markdown]
renderedLabel <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
label
      [Markdown] -> Doc -> MarkdownM [Markdown]
normalizeHref [Markdown]
renderedLabel Doc
url
    Image Doc
altText Doc
src Maybe Doc
caption -> do
      [Markdown]
renderedAltText <- Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
altText
      Maybe [Markdown]
renderedCaption <- (Doc -> MarkdownM [Markdown])
-> Maybe Doc -> ReaderT MarkdownEnv Identity (Maybe [Markdown])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Doc -> MarkdownM [Markdown]
toMarkdown_ Maybe Doc
caption
      let srcText :: Text
srcText = Doc -> Text
toRawText Doc
src
      [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Markdown] -> MarkdownM [Markdown])
-> [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ [[Markdown] -> Text -> Markdown
Md.Image [Markdown]
renderedAltText Text
srcText] [Markdown] -> [Markdown] -> [Markdown]
forall a. Semigroup a => a -> a -> a
<> ([Markdown] -> Maybe [Markdown] -> [Markdown]
forall a. a -> Maybe a -> a
fromMaybe [Markdown]
forall a. Monoid a => a
mempty Maybe [Markdown]
renderedCaption)
    Special RenderedSpecialForm
specialForm -> do
      case RenderedSpecialForm
specialForm of
        Source [Ref (Text, DisplayObject SyntaxText Src)]
sources -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Markdown] -> MarkdownM [Markdown])
-> [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ (Ref (Text, DisplayObject SyntaxText Src) -> [Markdown])
-> [Ref (Text, DisplayObject SyntaxText Src)] -> [Markdown]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((EmbeddedSource -> [Markdown])
-> Maybe EmbeddedSource -> [Markdown]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap EmbeddedSource -> [Markdown]
embeddedSourceToMarkdown (Maybe EmbeddedSource -> [Markdown])
-> (Ref (Text, DisplayObject SyntaxText Src)
    -> Maybe EmbeddedSource)
-> Ref (Text, DisplayObject SyntaxText Src)
-> [Markdown]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource) [Ref (Text, DisplayObject SyntaxText Src)]
sources
        FoldedSource [Ref (Text, DisplayObject SyntaxText Src)]
sources -> do
          -- We can't fold in markdown
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Markdown] -> MarkdownM [Markdown])
-> [Markdown] -> MarkdownM [Markdown]
forall a b. (a -> b) -> a -> b
$ (Ref (Text, DisplayObject SyntaxText Src) -> [Markdown])
-> [Ref (Text, DisplayObject SyntaxText Src)] -> [Markdown]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((EmbeddedSource -> [Markdown])
-> Maybe EmbeddedSource -> [Markdown]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap EmbeddedSource -> [Markdown]
embeddedSourceToMarkdown (Maybe EmbeddedSource -> [Markdown])
-> (Ref (Text, DisplayObject SyntaxText Src)
    -> Maybe EmbeddedSource)
-> Ref (Text, DisplayObject SyntaxText Src)
-> [Markdown]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (Text, DisplayObject SyntaxText Src) -> Maybe EmbeddedSource
embeddedSource) [Ref (Text, DisplayObject SyntaxText Src)]
sources
        Example SyntaxText
syntax -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode (SyntaxText -> Text
Syntax.toPlainText SyntaxText
syntax)]
        ExampleBlock SyntaxText
syntax -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (SyntaxText -> Text
Syntax.toPlainText SyntaxText
syntax)]
        Link SyntaxText
syntax -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode (SyntaxText -> Text
Syntax.toPlainText SyntaxText
syntax)]
        Signature [SyntaxText]
signatures -> do
          [SyntaxText]
signatures
            [SyntaxText] -> ([SyntaxText] -> [Markdown]) -> [Markdown]
forall a b. a -> (a -> b) -> b
& (SyntaxText -> [Markdown]) -> [SyntaxText] -> [Markdown]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure @[] (Markdown -> [Markdown])
-> (SyntaxText -> Markdown) -> SyntaxText -> [Markdown]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (Text -> Markdown)
-> (SyntaxText -> Text) -> SyntaxText -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxText -> Text
Syntax.toPlainText)
            [Markdown]
-> ([Markdown] -> MarkdownM [Markdown]) -> MarkdownM [Markdown]
forall a b. a -> (a -> b) -> b
& [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        SignatureInline SyntaxText
sig -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Text
Syntax.toPlainText SyntaxText
sig]
        Eval SyntaxText
source SyntaxText
result -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ Text -> Text -> Markdown
Md.CodeBlock
                Text
"unison"
                ( [Text] -> Text
Text.unlines
                    [ SyntaxText -> Text
Syntax.toPlainText SyntaxText
source,
                      Text
"⧨",
                      SyntaxText -> Text
Syntax.toPlainText SyntaxText
result
                    ]
                )
            ]
        EvalInline SyntaxText
source SyntaxText
result -> do
          --  I'm not sure of a good way to express this 'inline' in markdown
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            [ Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$
                [Text] -> Text
Text.unlines
                  [ SyntaxText -> Text
Syntax.toPlainText SyntaxText
source,
                    Text
"⧨",
                    SyntaxText -> Text
Syntax.toPlainText SyntaxText
result
                  ]
            ]
        Video [MediaSource]
sources Map Text Text
_attrs -> do
          case [MediaSource]
sources of
            [] -> [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
forall a. Monoid a => a
mempty
            (MediaSource Text
src Maybe Text
_ : [MediaSource]
_) -> do
              [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Markdown] -> Text -> Markdown
Md.Image [Markdown]
forall a. Monoid a => a
mempty Text
src]
        Doc.FrontMatter {} -> [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markdown]
forall a. Monoid a => a
mempty
        LaTeXInline Text
latex -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Text -> Markdown
Md.CodeBlock Text
"latex" Text
latex]
        Svg {} -> do [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.Txt Text
"{inline svg}"]
        Embed SyntaxText
syntax -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Text -> Markdown
Md.CodeBlock Text
"unison" (SyntaxText -> Text
Syntax.toPlainText SyntaxText
syntax)]
        EmbedInline SyntaxText
syntax -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.InlineCode (SyntaxText -> Text
Syntax.toPlainText SyntaxText
syntax)]
        RenderError (InvalidTerm SyntaxText
err) -> do
          [Markdown] -> MarkdownM [Markdown]
forall a. a -> ReaderT MarkdownEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Markdown
Md.Txt (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ SyntaxText -> Text
Syntax.toPlainText SyntaxText
err]
    Join [Doc]
docs -> do
      (Doc -> MarkdownM [Markdown]) -> [Doc] -> MarkdownM [Markdown]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM Doc -> MarkdownM [Markdown]
toMarkdown_ [Doc]
docs
    UntitledSection [Doc]
docs -> do
      (Doc -> MarkdownM [Markdown]) -> [Doc] -> MarkdownM [Markdown]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM Doc -> MarkdownM [Markdown]
toMarkdown_ [Doc]
docs
    Column [Doc]
docs -> do
      (Doc -> MarkdownM [Markdown]) -> [Doc] -> MarkdownM [Markdown]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM Doc -> MarkdownM [Markdown]
toMarkdown_ [Doc]
docs
    Group Doc
content -> do
      Doc -> MarkdownM [Markdown]
toMarkdown_ Doc
content