{-# LANGUAGE RecordWildCards #-}

module Heist.Extra.Splices.Pandoc.Render (
  renderPandocWith,
  rpBlock,
  rpInline,
  rpBlock',
  rpInline',
) where

import Data.Map.Strict qualified as Map
import Data.Map.Syntax ((##))
import Data.Text qualified as T
import Heist qualified as H
import Heist.Extra (runCustomNode)
import Heist.Extra.Splices.Pandoc.Attr (concatAttr, rpAttr)
import Heist.Extra.Splices.Pandoc.Ctx (
  RenderCtx (..),
  rewriteClass,
 )
import Heist.Extra.Splices.Pandoc.TaskList qualified as TaskList
import Heist.Interpreted qualified as HI
import Text.Pandoc.Builder qualified as B
import Text.Pandoc.Definition (Pandoc (..))
import Text.Pandoc.Walk as W
import Text.XmlHtml qualified as X

renderPandocWith :: RenderCtx -> Pandoc -> HI.Splice Identity
renderPandocWith :: RenderCtx -> Pandoc -> Splice Identity
renderPandocWith RenderCtx
ctx (Pandoc Meta
_meta [Block]
blocks) =
  forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
blocks

rpBlock :: RenderCtx -> B.Block -> HI.Splice Identity
rpBlock :: RenderCtx -> Block -> Splice Identity
rpBlock ctx :: RenderCtx
ctx@RenderCtx {Maybe Node
Map Text Text
Block -> Maybe (Splice Identity)
Block -> Attr
Inline -> Maybe (Splice Identity)
Inline -> Attr
inlineSplice :: RenderCtx -> Inline -> Maybe (Splice Identity)
blockSplice :: RenderCtx -> Block -> Maybe (Splice Identity)
classMap :: RenderCtx -> Map Text Text
iAttr :: RenderCtx -> Inline -> Attr
bAttr :: RenderCtx -> Block -> Attr
rootNode :: RenderCtx -> Maybe Node
inlineSplice :: Inline -> Maybe (Splice Identity)
blockSplice :: Block -> Maybe (Splice Identity)
classMap :: Map Text Text
iAttr :: Inline -> Attr
bAttr :: Block -> Attr
rootNode :: Maybe Node
..} Block
b = do
  forall a. a -> Maybe a -> a
fromMaybe (RenderCtx -> Block -> Splice Identity
rpBlock' RenderCtx
ctx Block
b) forall a b. (a -> b) -> a -> b
$ Block -> Maybe (Splice Identity)
blockSplice Block
b

-- | Render using user override in pandoc.tpl, falling back to default HTML.
withTplTag :: RenderCtx -> Text -> H.Splices (HI.Splice Identity) -> HI.Splice Identity -> HI.Splice Identity
withTplTag :: RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx {Maybe Node
Map Text Text
Block -> Maybe (Splice Identity)
Block -> Attr
Inline -> Maybe (Splice Identity)
Inline -> Attr
inlineSplice :: Inline -> Maybe (Splice Identity)
blockSplice :: Block -> Maybe (Splice Identity)
classMap :: Map Text Text
iAttr :: Inline -> Attr
bAttr :: Block -> Attr
rootNode :: Maybe Node
inlineSplice :: RenderCtx -> Inline -> Maybe (Splice Identity)
blockSplice :: RenderCtx -> Block -> Maybe (Splice Identity)
classMap :: RenderCtx -> Map Text Text
iAttr :: RenderCtx -> Inline -> Attr
bAttr :: RenderCtx -> Block -> Attr
rootNode :: RenderCtx -> Maybe Node
..} Text
name Splices (Splice Identity)
splices Splice Identity
default_ =
  case Text -> Node -> Maybe Node
X.childElementTag Text
name forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Node
rootNode of
    Maybe Node
Nothing -> Splice Identity
default_
    Just Node
node -> Node -> Splices (Splice Identity) -> Splice Identity
runCustomNode Node
node Splices (Splice Identity)
splices

rpBlock' :: RenderCtx -> B.Block -> HI.Splice Identity
rpBlock' :: RenderCtx -> Block -> Splice Identity
rpBlock' ctx :: RenderCtx
ctx@RenderCtx {Maybe Node
Map Text Text
Block -> Maybe (Splice Identity)
Block -> Attr
Inline -> Maybe (Splice Identity)
Inline -> Attr
inlineSplice :: Inline -> Maybe (Splice Identity)
blockSplice :: Block -> Maybe (Splice Identity)
classMap :: Map Text Text
iAttr :: Inline -> Attr
bAttr :: Block -> Attr
rootNode :: Maybe Node
inlineSplice :: RenderCtx -> Inline -> Maybe (Splice Identity)
blockSplice :: RenderCtx -> Block -> Maybe (Splice Identity)
classMap :: RenderCtx -> Map Text Text
iAttr :: RenderCtx -> Inline -> Attr
bAttr :: RenderCtx -> Block -> Attr
rootNode :: RenderCtx -> Maybe Node
..} Block
b = case Block
b of
  B.Plain [Inline]
is ->
    RenderCtx -> [Inline] -> Splice Identity
rpInlineWithTasks RenderCtx
ctx [Inline]
is
  B.Para [Inline]
is -> do
    let innerSplice :: Splice Identity
innerSplice = RenderCtx -> [Inline] -> Splice Identity
rpInlineWithTasks RenderCtx
ctx [Inline]
is
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"Para" (Text
"inlines" forall k v. k -> v -> MapSyntax k v
## Splice Identity
innerSplice) forall a b. (a -> b) -> a -> b
$
      forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"p" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Splice Identity
innerSplice
  B.LineBlock [[Inline]]
iss ->
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [[Inline]]
iss forall a b. (a -> b) -> a -> b
$ \[Inline]
is ->
      forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Text -> Node
X.TextNode Text
"\n"]
  B.CodeBlock (Text
id', forall {a}. (IsString a, Semigroup a) => [a] -> [a]
mkLangClass -> [Text]
classes, [(Text, Text)]
attrs) Text
s -> do
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"div" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Block -> Attr
bAttr Block
b) forall a b. (a -> b) -> a -> b
$
        forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"pre" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
          forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"code" (Attr -> [(Text, Text)]
rpAttr (Text
id', [Text]
classes, [(Text, Text)]
attrs)) forall a b. (a -> b) -> a -> b
$
            forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Node
X.TextNode Text
s
  B.RawBlock (B.Format Text
fmt) Text
s -> do
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Text
fmt of
      Text
"html" ->
        Text -> Text -> [Node]
rawNode Text
"div" Text
s
      Text
"video" ->
        -- HACK format. TODO: replace with ![[foo.mp4]]
        forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"video" [(Text
"autoplay", Text
""), (Text
"loop", Text
""), (Text
"muted", Text
"")] forall a b. (a -> b) -> a -> b
$
          forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"source" [(Text
"src", Text -> Text
T.strip Text
s)] forall a b. (a -> b) -> a -> b
$
            forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"p" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
              [ Text -> Node
X.TextNode Text
"Your browser doesn't support HTML5 video. Here is a "
              , Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"a" [(Text
"href", Text -> Text
T.strip Text
s)] forall a b. (a -> b) -> a -> b
$
                  forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
"link to the video"
              , Text -> Node
X.TextNode Text
" instead."
              ]
      Text
_ ->
        forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"pre" [(Text
"class", Text
"pandoc-raw-" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
fmt)] forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
s
  B.BlockQuote [Block]
bs ->
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"BlockQuote" (Text
"blocks" forall k v. k -> v -> MapSyntax k v
## RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [Block]
bs) forall a b. (a -> b) -> a -> b
$
      forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"blockquote" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
bs
  B.OrderedList ListAttributes
_ [[Block]]
bss ->
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"OrderedList" (Text -> [[Block]] -> Splices (Splice Identity)
pandocListSplices Text
"OrderedList" [[Block]]
bss) forall a b. (a -> b) -> a -> b
$ do
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"ol" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Block -> Attr
bAttr Block
b)) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [[Block]]
bss forall a b. (a -> b) -> a -> b
$
          forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"li" forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx)
  B.BulletList [[Block]]
bss ->
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"BulletList" (Text -> [[Block]] -> Splices (Splice Identity)
pandocListSplices Text
"BulletList" [[Block]]
bss) forall a b. (a -> b) -> a -> b
$ do
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"ul" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Block -> Attr
bAttr Block
b)) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [[Block]]
bss forall a b. (a -> b) -> a -> b
$
          forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"li" forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx)
  B.DefinitionList [([Inline], [[Block]])]
defs ->
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"DefinitionList" ([([Inline], [[Block]])] -> Splices (Splice Identity)
definitionListSplices [([Inline], [[Block]])]
defs) forall a b. (a -> b) -> a -> b
$
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"dl" forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [([Inline], [[Block]])]
defs forall a b. (a -> b) -> a -> b
$ \([Inline]
term, [[Block]]
descList) -> do
          [Node]
a <- forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
term
          [Node]
as <-
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [[Block]]
descList forall a b. (a -> b) -> a -> b
$
              forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"dd" forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx)
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Node]
a forall a. Semigroup a => a -> a -> a
<> [Node]
as
  B.Header Int
level Attr
attr [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element (HasCallStack => Int -> Text
headerTag Int
level) (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Attr -> Attr -> Attr
concatAttr Attr
attr forall a b. (a -> b) -> a -> b
$ Block -> Attr
bAttr Block
b)
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  Block
B.HorizontalRule ->
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"HorizontalRule" forall a. Monoid a => a
mempty (forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"hr" forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
  B.Table Attr
attr Caption
_captions [ColSpec]
_colSpec (B.TableHead Attr
_ [Row]
hrows) [TableBody]
tbodys TableFoot
_tfoot -> do
    -- TODO: Move tailwind styles to pandoc.tpl
    let borderStyle :: Text
borderStyle = Text
"border-gray-300"
        rowStyle :: [(Text, Text)]
rowStyle = [(Text
"class", Text
"border-b-2 border-t-2 " forall a. Semigroup a => a -> a -> a
<> Text
borderStyle)]
        cellStyle :: [(Text, Text)]
cellStyle = [(Text
"class", Text
"py-2 px-2 align-top border-r-2 border-l-2 " forall a. Semigroup a => a -> a -> a
<> Text
borderStyle)]
        tableAttr :: Attr
tableAttr = (Text
"", [Text
"mb-3"], forall a. Monoid a => a
mempty)
    -- TODO: Apply captions, colSpec, etc.
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"table" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Attr -> Attr -> Attr
concatAttr Attr
attr Attr
tableAttr)) forall a b. (a -> b) -> a -> b
$ do
      [Node]
thead <- forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"thead" forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [Row]
hrows forall a b. (a -> b) -> a -> b
$ \(B.Row Attr
_ [Cell]
cells) ->
          forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"tr" [(Text, Text)]
rowStyle) forall a b. (a -> b) -> a -> b
$
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [Cell]
cells forall a b. (a -> b) -> a -> b
$ \(B.Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
_ [Block]
blks) ->
              forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"th" [(Text, Text)]
cellStyle forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
blks
      [Node]
tbody <- forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"tbody" forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$
        forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [TableBody]
tbodys forall a b. (a -> b) -> a -> b
$ \(B.TableBody Attr
_ RowHeadColumns
_ [Row]
_ [Row]
rows) ->
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [Row]
rows forall a b. (a -> b) -> a -> b
$ \(B.Row Attr
_ [Cell]
cells) ->
            forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"tr" [(Text, Text)]
rowStyle) forall a b. (a -> b) -> a -> b
$
              forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM [Cell]
cells forall a b. (a -> b) -> a -> b
$ \(B.Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
_ [Block]
blks) ->
                forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"td" [(Text, Text)]
cellStyle forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
blks
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Node]
thead forall a. Semigroup a => a -> a -> a
<> [Node]
tbody
  B.Div Attr
attr [Block]
bs ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element (forall {k} {b} {a} {b}.
(Ord k, IsString k) =>
b -> (a, b, [(k, b)]) -> b
getTag Text
"div" Attr
attr) (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ RenderCtx -> Attr -> Attr
rewriteClass RenderCtx
ctx Attr
attr)
      forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
bs
  Block
B.Null ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
  where
    getTag :: b -> (a, b, [(k, b)]) -> b
getTag b
defaultTag (a
_, b
_, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList -> Map k b
attrs) =
      forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"tag" Map k b
attrs forall a b. a -> (a -> b) -> b
& forall a. a -> Maybe a -> a
fromMaybe b
defaultTag
    mkLangClass :: [a] -> [a]
mkLangClass [a]
classes' =
      -- Tag code block with "foo language-foo" classes, if the user specified
      -- "foo" as the language identifier. This enables external syntax
      -- highlighters to detect the language.
      --
      -- If no language is specified, use "language-none" as the language This
      -- works at least on prism.js,[1] in that - syntax highlighting is turned
      -- off all the while background styling is applied, to be consistent with
      -- code blocks with language set.
      --
      -- [1] https://github.com/PrismJS/prism/pull/2738
      forall a. a -> Maybe a -> a
fromMaybe [a
"language-none"] forall a b. (a -> b) -> a -> b
$ do
        NonEmpty a
classes <- forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [a]
classes'
        let lang :: a
lang = forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty a
classes
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a
lang forall a. a -> [a] -> [a]
: (a
"language-" forall a. Semigroup a => a -> a -> a
<> a
lang) forall a. a -> [a] -> [a]
: forall (f :: Type -> Type) a.
IsNonEmpty f a [a] "tail" =>
f a -> [a]
tail NonEmpty a
classes

    definitionListSplices :: [([B.Inline], [[B.Block]])] -> H.Splices (HI.Splice Identity)
    definitionListSplices :: [([Inline], [[Block]])] -> Splices (Splice Identity)
definitionListSplices [([Inline], [[Block]])]
defs = do
      Text
"DefinitionList:Items" forall k v. k -> v -> MapSyntax k v
## (forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Inline] -> [[Block]] -> Splices (Splice Identity)
itemsSplices) forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [([Inline], [[Block]])]
defs
      where
        itemsSplices :: [B.Inline] -> [[B.Block]] -> H.Splices (HI.Splice Identity)
        itemsSplices :: [Inline] -> [[Block]] -> Splices (Splice Identity)
itemsSplices [Inline]
term [[Block]]
descriptions = do
          Text
"DefinitionList:Item:Term" forall k v. k -> v -> MapSyntax k v
## forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
term
          Text
"DefinitionList:Item:DescList" forall k v. k -> v -> MapSyntax k v
## (forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Splices (Splice Identity)
descListSplices) forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [[Block]]
descriptions
        descListSplices :: [B.Block] -> H.Splices (HI.Splice Identity)
        descListSplices :: [Block] -> Splices (Splice Identity)
descListSplices [Block]
bs = Text
"DefinitionList:Item:Desc" forall k v. k -> v -> MapSyntax k v
## RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [Block]
bs

    pandocListSplices :: Text -> [[B.Block]] -> H.Splices (HI.Splice Identity)
    pandocListSplices :: Text -> [[Block]] -> Splices (Splice Identity)
pandocListSplices Text
tagPrefix [[Block]]
bss =
      (Text
tagPrefix forall a. Semigroup a => a -> a -> a
<> Text
":Items") forall k v. k -> v -> MapSyntax k v
## (forall (n :: Type -> Type).
Monad n =>
Splices (Splice n) -> Splice n
HI.runChildrenWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Splices (Splice Identity)
itemsSplices) forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [[Block]]
bss
      where
        itemsSplices :: [B.Block] -> H.Splices (HI.Splice Identity)
        itemsSplices :: [Block] -> Splices (Splice Identity)
itemsSplices [Block]
bs = do
          (Text
tagPrefix forall a. Semigroup a => a -> a -> a
<> Text
":Item") forall k v. k -> v -> MapSyntax k v
## forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Block -> Splice Identity
rpBlock RenderCtx
ctx) [Block]
bs

headerTag :: HasCallStack => Int -> Text
headerTag :: HasCallStack => Int -> Text
headerTag Int
n =
  if Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
6
    then Text
"h" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
n
    else forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Invalid pandoc header level"

rpInline :: RenderCtx -> B.Inline -> HI.Splice Identity
rpInline :: RenderCtx -> Inline -> Splice Identity
rpInline ctx :: RenderCtx
ctx@RenderCtx {Maybe Node
Map Text Text
Block -> Maybe (Splice Identity)
Block -> Attr
Inline -> Maybe (Splice Identity)
Inline -> Attr
inlineSplice :: Inline -> Maybe (Splice Identity)
blockSplice :: Block -> Maybe (Splice Identity)
classMap :: Map Text Text
iAttr :: Inline -> Attr
bAttr :: Block -> Attr
rootNode :: Maybe Node
inlineSplice :: RenderCtx -> Inline -> Maybe (Splice Identity)
blockSplice :: RenderCtx -> Block -> Maybe (Splice Identity)
classMap :: RenderCtx -> Map Text Text
iAttr :: RenderCtx -> Inline -> Attr
bAttr :: RenderCtx -> Block -> Attr
rootNode :: RenderCtx -> Maybe Node
..} Inline
i = do
  forall a. a -> Maybe a -> a
fromMaybe (RenderCtx -> Inline -> Splice Identity
rpInline' RenderCtx
ctx Inline
i) forall a b. (a -> b) -> a -> b
$ Inline -> Maybe (Splice Identity)
inlineSplice Inline
i

rpInline' :: RenderCtx -> B.Inline -> HI.Splice Identity
rpInline' :: RenderCtx -> Inline -> Splice Identity
rpInline' ctx :: RenderCtx
ctx@RenderCtx {Maybe Node
Map Text Text
Block -> Maybe (Splice Identity)
Block -> Attr
Inline -> Maybe (Splice Identity)
Inline -> Attr
inlineSplice :: Inline -> Maybe (Splice Identity)
blockSplice :: Block -> Maybe (Splice Identity)
classMap :: Map Text Text
iAttr :: Inline -> Attr
bAttr :: Block -> Attr
rootNode :: Maybe Node
inlineSplice :: RenderCtx -> Inline -> Maybe (Splice Identity)
blockSplice :: RenderCtx -> Block -> Maybe (Splice Identity)
classMap :: RenderCtx -> Map Text Text
iAttr :: RenderCtx -> Inline -> Attr
bAttr :: RenderCtx -> Block -> Attr
rootNode :: RenderCtx -> Maybe Node
..} Inline
i = case Inline
i of
  B.Str Text
s ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
s
  B.Emph [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"em" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Strong [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"strong" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Underline [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"u" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Strikeout [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"s" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Superscript [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"sup" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Subscript [Inline]
is ->
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"sub" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Quoted QuoteType
qt [Inline]
is ->
    forall a b c. (a -> b -> c) -> b -> a -> c
flip Splice Identity -> QuoteType -> Splice Identity
inQuotes QuoteType
qt forall a b. (a -> b) -> a -> b
$ forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Code Attr
attr Text
s ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"code" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ Attr -> Attr -> Attr
concatAttr Attr
attr forall a b. (a -> b) -> a -> b
$ Inline -> Attr
iAttr Inline
i) forall a b. (a -> b) -> a -> b
$
        forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
s
  Inline
B.Space -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
" "
  Inline
B.SoftBreak -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
" "
  Inline
B.LineBreak ->
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"br" forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
  B.RawInline (B.Format Text
fmt) Text
s ->
    if Text
fmt forall a. Eq a => a -> a -> Bool
== Text
"html"
      then forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Node]
rawNode Text
"span" Text
s
      else
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"pre" [(Text
"class", Text
"pandoc-raw-" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Text
fmt)] forall a b. (a -> b) -> a -> b
$
            forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
s
  B.Math MathType
mathType Text
s ->
    case MathType
mathType of
      MathType
B.InlineMath ->
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"span" [(Text
"class", Text
"math inline")] forall a b. (a -> b) -> a -> b
$
            forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
"\\(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\\)"
      MathType
B.DisplayMath ->
        forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"span" [(Text
"class", Text
"math display")] forall a b. (a -> b) -> a -> b
$
            forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
"$$" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"$$"
  B.Link Attr
attr [Inline]
is (Text
url, Text
tit) -> do
    let attrs :: [(Text, Text)]
attrs =
          forall a. [Maybe a] -> [a]
catMaybes [forall a. a -> Maybe a
Just (Text
"href", Text
url), forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
tit) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
"title", Text
tit)]
            forall a. Semigroup a => a -> a -> a
<> Attr -> [(Text, Text)]
rpAttr (Attr -> Attr -> Attr
concatAttr Attr
attr forall a b. (a -> b) -> a -> b
$ Inline -> Attr
iAttr Inline
i)
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"a" [(Text, Text)]
attrs forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Image Attr
attr [Inline]
is (Text
url, Text
tit) -> do
    let attrs :: [(Text, Text)]
attrs =
          forall a. [Maybe a] -> [a]
catMaybes
            [ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
"src", Text
url)
            , forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
tit) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
"title", Text
tit)
            , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text
"alt", [Inline] -> Text
plainify [Inline]
is)
            ]
            forall a. Semigroup a => a -> a -> a
<> Attr -> [(Text, Text)]
rpAttr (RenderCtx -> Attr -> Attr
rewriteClass RenderCtx
ctx Attr
attr)
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"img" [(Text, Text)]
attrs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
  B.Note [Block]
_bs -> do
    -- Footnotes are to be handled separately; see Footenotes.hs
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"sup" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ Text -> Node
X.TextNode Text
"*"
  B.Span Attr
attr [Inline]
is -> do
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"span" (Attr -> [(Text, Text)]
rpAttr forall a b. (a -> b) -> a -> b
$ RenderCtx -> Attr -> Attr
rewriteClass RenderCtx
ctx Attr
attr) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.SmallCaps [Inline]
is ->
    forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  B.Cite [Citation]
_citations [Inline]
is ->
    -- TODO: What to do with _citations here?
    RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag RenderCtx
ctx Text
"Cite" (Text
"inlines" forall k v. k -> v -> MapSyntax k v
## RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [Inline]
is) forall a b. (a -> b) -> a -> b
$
      forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
"cite" forall a. Monoid a => a
mempty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
foldMapM (RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx) [Inline]
is
  where
    inQuotes :: HI.Splice Identity -> B.QuoteType -> HI.Splice Identity
    inQuotes :: Splice Identity -> QuoteType -> Splice Identity
inQuotes Splice Identity
w = \case
      QuoteType
B.SingleQuote ->
        Splice Identity
w forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Node]
nodes ->
          [Text -> Node
X.TextNode Text
"‘"] forall a. Semigroup a => a -> a -> a
<> [Node]
nodes forall a. Semigroup a => a -> a -> a
<> [Text -> Node
X.TextNode Text
"’"]
      QuoteType
B.DoubleQuote ->
        Splice Identity
w forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Node]
nodes ->
          [Text -> Node
X.TextNode Text
"“"] forall a. Semigroup a => a -> a -> a
<> [Node]
nodes forall a. Semigroup a => a -> a -> a
<> [Text -> Node
X.TextNode Text
"”"]

-- | Like rpInline', but supports task checkbox in the given inlines.
rpInlineWithTasks :: RenderCtx -> [B.Inline] -> HI.Splice Identity
rpInlineWithTasks :: RenderCtx -> [Inline] -> Splice Identity
rpInlineWithTasks RenderCtx
ctx [Inline]
is =
  RenderCtx -> [Inline] -> Splice Identity -> Splice Identity
rpTask RenderCtx
ctx [Inline]
is forall a b. (a -> b) -> a -> b
$
    RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [Inline]
is

rpTask :: RenderCtx -> [B.Inline] -> HI.Splice Identity -> HI.Splice Identity
rpTask :: RenderCtx -> [Inline] -> Splice Identity -> Splice Identity
rpTask RenderCtx
ctx [Inline]
is Splice Identity
default_ =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Splice Identity
default_ (Bool, [Inline]) -> Splice Identity
render ([Inline] -> Maybe (Bool, [Inline])
TaskList.parseTaskFromInlines [Inline]
is)
  where
    render :: (Bool, [Inline]) -> Splice Identity
render (Bool
checked, [Inline]
taskInlines) = do
      let tag :: Text
tag = forall a. a -> a -> Bool -> a
bool Text
"Task:Unchecked" Text
"Task:Checked" Bool
checked
      RenderCtx
-> Text
-> Splices (Splice Identity)
-> Splice Identity
-> Splice Identity
withTplTag
        RenderCtx
ctx
        Text
tag
        (Text
"inlines" forall k v. k -> v -> MapSyntax k v
## RenderCtx -> Inline -> Splice Identity
rpInline RenderCtx
ctx forall b (m :: Type -> Type) (f :: Type -> Type) a.
(Monoid b, Monad m, Foldable f) =>
(a -> m b) -> f a -> m b
`foldMapM` [Inline]
taskInlines)
        Splice Identity
default_

rawNode :: Text -> Text -> [X.Node]
rawNode :: Text -> Text -> [Node]
rawNode Text
wrapperTag Text
s =
  forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
wrapperTag (forall x. One x => OneItem x -> x
one (Text
"xmlhtmlRaw", Text
"")) forall a b. (a -> b) -> a -> b
$
    forall x. One x => OneItem x -> x
one forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
X.TextNode forall a b. (a -> b) -> a -> b
$ Text
s

-- | Convert Pandoc AST inlines to raw text.
plainify :: [B.Inline] -> Text
plainify :: [Inline] -> Text
plainify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
W.query forall a b. (a -> b) -> a -> b
$ \case
  B.Str Text
x -> Text
x
  B.Code Attr
_attr Text
x -> Text
x
  Inline
B.Space -> Text
" "
  Inline
B.SoftBreak -> Text
" "
  Inline
B.LineBreak -> Text
" "
  -- TODO: if fmt is html, we should strip the html tags
  B.RawInline Format
_fmt Text
s -> Text
s
  -- Ignore "wrapper" inlines like span.
  B.Span Attr
_ [Inline]
_ -> Text
""
  -- TODO: How to wrap math stuff here?
  B.Math MathType
_mathTyp Text
s -> Text
s
  Inline
_ -> Text
""