{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE Strict #-}
module Djot.Html
  ( inlinesToByteString
  , renderHtml
  , RenderOptions(..)
  )
where

import Djot.AST
import Data.Tuple (swap)
import Djot.Parse (strToUtf8)
import Djot.Options (RenderOptions(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.ByteString.Builder (Builder, byteString, word8, intDec)
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.List (sort)
import Control.Monad.State
import qualified Data.Foldable as F

renderHtml :: RenderOptions -> Doc -> Builder
renderHtml :: RenderOptions -> Doc -> Builder
renderHtml RenderOptions
opts Doc
doc = State BState Builder -> BState -> Builder
forall s a. State s a -> s -> a
evalState
                          ( Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> State BState Builder
-> StateT BState Identity (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Doc -> Blocks
docBlocks Doc
doc)
                                 StateT BState Identity (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall a b.
StateT BState Identity (a -> b)
-> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State BState Builder
toNotes )
                         BState{ noteMap :: NoteMap
noteMap = Doc -> NoteMap
docFootnotes Doc
doc
                               , noteRefs :: Map ByteString Int
noteRefs = Map ByteString Int
forall a. Monoid a => a
mempty
                               , renderedNotes :: Map ByteString Builder
renderedNotes = Map ByteString Builder
forall a. Monoid a => a
mempty
                               , referenceMap :: ReferenceMap
referenceMap = Doc -> ReferenceMap
docReferences Doc
doc
                                             ReferenceMap -> ReferenceMap -> ReferenceMap
forall a. Semigroup a => a -> a -> a
<> Doc -> ReferenceMap
docAutoReferences Doc
doc
                               , options :: RenderOptions
options = RenderOptions
opts
                               }

toNotes :: State BState Builder
toNotes :: State BState Builder
toNotes = do
  BState
st <- StateT BState Identity BState
forall s (m :: * -> *). MonadState s m => m s
get
  let noterefs :: Map ByteString Int
noterefs = BState -> Map ByteString Int
noteRefs BState
st
  let numnotes :: Int
numnotes = Map ByteString Int -> Int
forall k a. Map k a -> Int
M.size Map ByteString Int
noterefs
  let revnoterefs :: [(Int, ByteString)]
revnoterefs = [(Int, ByteString)] -> [(Int, ByteString)]
forall a. Ord a => [a] -> [a]
sort ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ ((ByteString, Int) -> (Int, ByteString))
-> [(ByteString, Int)] -> [(Int, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Int) -> (Int, ByteString)
forall a b. (a, b) -> (b, a)
swap ([(ByteString, Int)] -> [(Int, ByteString)])
-> [(ByteString, Int)] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ Map ByteString Int -> [(ByteString, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map ByteString Int
noterefs
  let toNote :: (a, ByteString) -> Builder
toNote (a
num, ByteString
lab) =
        let num' :: ByteString
num' = String -> ByteString
B8.pack (a -> String
forall a. Show a => a -> String
show a
num)
        in  ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"li" Pos
NoPos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"id", ByteString
"fn" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
num')])
              (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Maybe Builder -> Builder
forall a. a -> Maybe a -> a
fromMaybe Builder
forall a. Monoid a => a
mempty (ByteString -> Map ByteString Builder -> Maybe Builder
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
lab (BState -> Map ByteString Builder
renderedNotes BState
st)))
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
  if Int
numnotes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
     then Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
     else Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$
           ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"section" Pos
NoPos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"role", ByteString
"doc-endnotes")])
            (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Pos -> Attr -> Builder
singleTag ByteString
"hr" Pos
NoPos Attr
forall a. Monoid a => a
mempty Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"ol" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Int, ByteString) -> Builder) -> [(Int, ByteString)] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, ByteString) -> Builder
forall {a}. Show a => (a, ByteString) -> Builder
toNote [(Int, ByteString)]
revnoterefs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n")
             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

addBackref :: ByteString -> Blocks -> Blocks
addBackref :: ByteString -> Blocks -> Blocks
addBackref ByteString
num (Many Seq (Node Block)
bls) =
    Seq (Node Block) -> Blocks
forall a. Seq a -> Many a
Many (Seq (Node Block) -> Blocks) -> Seq (Node Block) -> Blocks
forall a b. (a -> b) -> a -> b
$
      case Seq (Node Block) -> ViewR (Node Block)
forall a. Seq a -> ViewR a
Seq.viewr Seq (Node Block)
bls of
          Seq (Node Block)
rest Seq.:> Node Pos
pos Attr
attr (Para Inlines
ils) ->
            Seq (Node Block)
rest Seq (Node Block) -> Node Block -> Seq (Node Block)
forall a. Seq a -> a -> Seq a
Seq.|> Pos -> Attr -> Block -> Node Block
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr (Inlines -> Block
Para (Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
backlink))
          ViewR (Node Block)
_ -> Seq (Node Block)
bls Seq (Node Block) -> Node Block -> Seq (Node Block)
forall a. Seq a -> a -> Seq a
Seq.|> Pos -> Attr -> Block -> Node Block
forall a. Pos -> Attr -> a -> Node a
Node Pos
NoPos Attr
forall a. Monoid a => a
mempty (Inlines -> Block
Para Inlines
backlink)
 where
   backlink :: Inlines
backlink = Seq (Node Inline) -> Inlines
forall a. Seq a -> Many a
Many (Seq (Node Inline) -> Inlines) -> Seq (Node Inline) -> Inlines
forall a b. (a -> b) -> a -> b
$ Node Inline -> Seq (Node Inline)
forall a. a -> Seq a
Seq.singleton (Node Inline -> Seq (Node Inline))
-> Node Inline -> Seq (Node Inline)
forall a b. (a -> b) -> a -> b
$
               Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
NoPos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"role", ByteString
"doc-backlink")])
                 (Inlines -> Target -> Inline
Link (ByteString -> Inlines
str (String -> ByteString
strToUtf8 String
"\8617\65038"))
                 (ByteString -> Target
Direct (ByteString
"#fnref" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
num)))

{-# INLINE escapeHtml #-}
escapeHtml :: ByteString -> Builder
escapeHtml :: ByteString -> Builder
escapeHtml ByteString
bs =
  if ByteString -> Bool
hasEscapable ByteString
bs
     then (Builder -> Word8 -> Builder) -> Builder -> ByteString -> Builder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Builder -> Word8 -> Builder
go Builder
forall a. Monoid a => a
mempty ByteString
bs
     else ByteString -> Builder
byteString ByteString
bs
 where
  hasEscapable :: ByteString -> Bool
hasEscapable = (Word8 -> Bool) -> ByteString -> Bool
B.any (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
38 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
60 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
62)
  go :: Builder -> Word8 -> Builder
go Builder
b Word8
38 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&amp;"
  go Builder
b Word8
60 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&lt;"
  go Builder
b Word8
62 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&gt;"
  go Builder
b Word8
c  = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
c

{-# INLINE escapeHtmlAttribute #-}
escapeHtmlAttribute :: ByteString -> Builder
escapeHtmlAttribute :: ByteString -> Builder
escapeHtmlAttribute ByteString
bs =
  if ByteString -> Bool
hasEscapable ByteString
bs
     then (Builder -> Word8 -> Builder) -> Builder -> ByteString -> Builder
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Builder -> Word8 -> Builder
go Builder
forall a. Monoid a => a
mempty ByteString
bs
     else ByteString -> Builder
byteString ByteString
bs
 where
  hasEscapable :: ByteString -> Bool
hasEscapable = (Word8 -> Bool) -> ByteString -> Bool
B.any (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
38 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
60 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
62 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34)
  go :: Builder -> Word8 -> Builder
go Builder
b Word8
38 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&amp;"
  go Builder
b Word8
60 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&lt;"
  go Builder
b Word8
62 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&gt;"
  go Builder
b Word8
34 = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
"&quot;"
  go Builder
b Word8
c  = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
c

data BState =
  BState { BState -> NoteMap
noteMap :: NoteMap
         , BState -> Map ByteString Int
noteRefs :: M.Map ByteString Int
         , BState -> Map ByteString Builder
renderedNotes :: M.Map ByteString Builder
         , BState -> ReferenceMap
referenceMap :: ReferenceMap
         , BState -> RenderOptions
options :: RenderOptions
         }

{-# SPECIALIZE toBuilder :: Blocks -> State BState Builder #-}
{-# SPECIALIZE toBuilder :: Inlines -> State BState Builder #-}
class ToBuilder a where
  toBuilder :: a -> State BState Builder

instance ToBuilder Inlines where
  toBuilder :: Inlines -> State BState Builder
toBuilder = (Seq Builder -> Builder)
-> StateT BState Identity (Seq Builder) -> State BState Builder
forall a b.
(a -> b) -> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Builder -> Builder
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (StateT BState Identity (Seq Builder) -> State BState Builder)
-> (Inlines -> StateT BState Identity (Seq Builder))
-> Inlines
-> State BState Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Inline -> State BState Builder)
-> Seq (Node Inline) -> StateT BState Identity (Seq Builder)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Node Inline -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Seq (Node Inline) -> StateT BState Identity (Seq Builder))
-> (Inlines -> Seq (Node Inline))
-> Inlines
-> StateT BState Identity (Seq Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Seq (Node Inline)
forall a. Many a -> Seq a
unMany

instance ToBuilder Blocks where
  toBuilder :: Blocks -> State BState Builder
toBuilder = (Seq Builder -> Builder)
-> StateT BState Identity (Seq Builder) -> State BState Builder
forall a b.
(a -> b) -> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Builder -> Builder
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (StateT BState Identity (Seq Builder) -> State BState Builder)
-> (Blocks -> StateT BState Identity (Seq Builder))
-> Blocks
-> State BState Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Block -> State BState Builder)
-> Seq (Node Block) -> StateT BState Identity (Seq Builder)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Node Block -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Seq (Node Block) -> StateT BState Identity (Seq Builder))
-> (Blocks -> Seq (Node Block))
-> Blocks
-> StateT BState Identity (Seq Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany

instance ToBuilder (Node Block) where
  toBuilder :: Node Block -> State BState Builder
toBuilder (Node Pos
pos Attr
attr Block
bl) =
    let addNl :: Builder -> Builder
addNl = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") in
    case Block
bl of
      Para Inlines
ils -> Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"p" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Heading Int
lev Inlines
ils ->
        let tag :: ByteString
tag = case Int
lev of
                    Int
1 -> ByteString
"h1"
                    Int
2 -> ByteString
"h2"
                    Int
3 -> ByteString
"h3"
                    Int
4 -> ByteString
"h4"
                    Int
5 -> ByteString
"h5"
                    Int
6 -> ByteString
"h6"
                    Int
_ -> ByteString
"p"
        in  Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
tag Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Section Blocks
bls -> do
        Builder
contents <- Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Blocks
bls
        Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
addNl (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"section" Pos
pos Attr
attr (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contents
      Block
ThematicBreak -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
addNl (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder
singleTag ByteString
"hr" Pos
pos Attr
attr
      BulletList ListSpacing
listSpacing [Blocks]
items ->
        Builder -> Builder
addNl (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"ul" Pos
pos Attr
attr (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT BState Identity [Builder] -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Blocks -> State BState Builder)
-> [Blocks] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Blocks -> State BState Builder
toLi [Blocks]
items
          where
            toLi :: Blocks -> State BState Builder
toLi Blocks
bls = Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"li" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          ListSpacing -> Blocks -> State BState Builder
toItemContents ListSpacing
listSpacing Blocks
bls
      OrderedList OrderedListAttributes
listAttr ListSpacing
listSpacing [Blocks]
items ->
        Builder -> Builder
addNl (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"ol" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"start", String -> ByteString
strToUtf8 (Int -> String
forall a. Show a => a -> String
show Int
start))
                                  | Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1]
                              Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"type", ByteString
typ) | ByteString
typ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"1"] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
         (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT BState Identity [Builder] -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Blocks -> State BState Builder)
-> [Blocks] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Blocks -> State BState Builder
toLi [Blocks]
items
          where
            typ :: ByteString
typ = case OrderedListAttributes -> OrderedListStyle
orderedListStyle OrderedListAttributes
listAttr of
                    OrderedListStyle
Decimal -> ByteString
"1"
                    OrderedListStyle
LetterUpper -> ByteString
"A"
                    OrderedListStyle
LetterLower -> ByteString
"a"
                    OrderedListStyle
RomanUpper -> ByteString
"I"
                    OrderedListStyle
RomanLower -> ByteString
"i"
            start :: Int
start = OrderedListAttributes -> Int
orderedListStart OrderedListAttributes
listAttr
            toLi :: Blocks -> State BState Builder
toLi Blocks
bls = Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"li" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)
                          (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListSpacing -> Blocks -> State BState Builder
toItemContents ListSpacing
listSpacing Blocks
bls
      DefinitionList ListSpacing
listSpacing [(Inlines, Blocks)]
defs ->
        Builder -> Builder
addNl (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"dl" Pos
pos Attr
attr (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
          ([Builder] -> Builder)
-> StateT BState Identity [Builder] -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Inlines, Blocks) -> State BState Builder)
-> [(Inlines, Blocks)] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ListSpacing -> (Inlines, Blocks) -> State BState Builder
toDefinition ListSpacing
listSpacing) [(Inlines, Blocks)]
defs
      TaskList ListSpacing
listSpacing [(TaskStatus, Blocks)]
items ->
        Builder -> Builder
addNl (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"ul" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
"task-list")] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
          (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> StateT BState Identity [Builder] -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TaskStatus, Blocks) -> State BState Builder)
-> [(TaskStatus, Blocks)] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ListSpacing -> (TaskStatus, Blocks) -> State BState Builder
toTaskListItem ListSpacing
listSpacing) [(TaskStatus, Blocks)]
items
      Div Blocks
bls -> Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"div" Pos
pos Attr
attr (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Blocks
bls
      BlockQuote Blocks
bls ->
        Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"blockquote" Pos
pos Attr
attr (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Blocks
bls
      CodeBlock ByteString
lang ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$
        ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"pre" Pos
pos Attr
attr (ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"code" Pos
NoPos Attr
codeattr (ByteString -> Builder
escapeHtml ByteString
bs))
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
         where
           codeattr :: Attr
codeattr = if ByteString -> Bool
B.null ByteString
lang
                         then Attr
forall a. Monoid a => a
mempty
                         else [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
"language-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lang)]
      Table Maybe Caption
mbCaption [[Cell]]
rows -> do
        [Builder]
rows' <- ([Cell] -> State BState Builder)
-> [[Cell]] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Cell] -> State BState Builder
toRow [[Cell]]
rows
        Builder
capt <- case Maybe Caption
mbCaption of
                   Maybe Caption
Nothing -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
                   Just (Caption Blocks
bs) ->
                     Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"caption" Pos
NoPos Attr
forall a. Monoid a => a
mempty
                       (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Seq (Node Block) -> [Node Block]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany Blocks
bs) of
                              [Node Pos
_pos Attr
at (Para Inlines
ils)] | Attr
at Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
forall a. Monoid a => a
mempty
                                 -> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
                              [Node Block]
_ -> (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Blocks
bs
        Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
addNl (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"table" Pos
pos Attr
attr (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder
capt Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
rows'
      RawBlock (Format ByteString
"html") ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs
      RawBlock Format
_ ByteString
_ -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty

toRow :: [Cell] -> State BState Builder
toRow :: [Cell] -> State BState Builder
toRow [Cell]
cells = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"tr" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                ([Builder] -> Builder)
-> StateT BState Identity [Builder] -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell -> State BState Builder)
-> [Cell] -> StateT BState Identity [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Cell -> State BState Builder
toCell [Cell]
cells

toCell :: Cell -> State BState Builder
toCell :: Cell -> State BState Builder
toCell (Cell CellType
cellType Align
align Inlines
ils) =
  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags (if CellType
cellType CellType -> CellType -> Bool
forall a. Eq a => a -> a -> Bool
== CellType
HeadCell
                         then ByteString
"th"
                         else ByteString
"td") Pos
NoPos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
 where
   attr :: Attr
attr = [(ByteString, ByteString)] -> Attr
Attr ([(ByteString, ByteString)] -> Attr)
-> [(ByteString, ByteString)] -> Attr
forall a b. (a -> b) -> a -> b
$ case Align
align of
                   Align
AlignDefault -> []
                   Align
AlignLeft -> [(ByteString
"style", ByteString
"text-align: left;")]
                   Align
AlignRight -> [(ByteString
"style", ByteString
"text-align: right;")]
                   Align
AlignCenter -> [(ByteString
"style", ByteString
"text-align: center;")]


toItemContents :: ListSpacing -> Blocks -> State BState Builder
toItemContents :: ListSpacing -> Blocks -> State BState Builder
toItemContents ListSpacing
listSpacing = (Seq Builder -> Builder)
-> StateT BState Identity (Seq Builder) -> State BState Builder
forall a b.
(a -> b) -> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Builder -> Builder
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (StateT BState Identity (Seq Builder) -> State BState Builder)
-> (Blocks -> StateT BState Identity (Seq Builder))
-> Blocks
-> State BState Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node Block -> State BState Builder)
-> Seq (Node Block) -> StateT BState Identity (Seq Builder)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Seq a -> m (Seq b)
mapM Node Block -> State BState Builder
go (Seq (Node Block) -> StateT BState Identity (Seq Builder))
-> (Blocks -> Seq (Node Block))
-> Blocks
-> StateT BState Identity (Seq Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany
 where
   go :: Node Block -> State BState Builder
go (Node Pos
pos Attr
attr Block
bl) =
    case Block
bl of
      Para Inlines
ils
        | ListSpacing
listSpacing ListSpacing -> ListSpacing -> Bool
forall a. Eq a => a -> a -> Bool
== ListSpacing
Tight ->
            if Attr
attr Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
forall a. Monoid a => a
mempty
               then (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
               else (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
        | Bool
otherwise -> Node Block -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Pos -> Attr -> Block -> Node Block
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr Block
bl)
      Block
_ -> Node Block -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Pos -> Attr -> Block -> Node Block
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr Block
bl)

toTaskListItem :: ListSpacing -> (TaskStatus, Blocks) -> State BState Builder
toTaskListItem :: ListSpacing -> (TaskStatus, Blocks) -> State BState Builder
toTaskListItem ListSpacing
listSpacing (TaskStatus
status, Blocks
bs) = do
  Builder
body <- case Seq (Node Block) -> ViewL (Node Block)
forall a. Seq a -> ViewL a
Seq.viewl (Seq (Node Block) -> ViewL (Node Block))
-> Seq (Node Block) -> ViewL (Node Block)
forall a b. (a -> b) -> a -> b
$ Blocks -> Seq (Node Block)
forall a. Many a -> Seq a
unMany Blocks
bs of
            Node Pos
pos Attr
attr (Para Inlines
ils) Seq.:< Seq (Node Block)
rest ->
              ListSpacing -> Blocks -> State BState Builder
toItemContents ListSpacing
listSpacing (Seq (Node Block) -> Blocks
forall a. Seq a -> Many a
Many
                (Pos -> Attr -> Block -> Node Block
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr
                 (Inlines -> Block
Para (Format -> ByteString -> Inlines
rawInline (ByteString -> Format
Format ByteString
"html") (ByteString
"<label>" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
input) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                         Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                         Format -> ByteString -> Inlines
rawInline (ByteString -> Format
Format ByteString
"html") ByteString
"</label>")) Node Block -> Seq (Node Block) -> Seq (Node Block)
forall a. a -> Seq a -> Seq a
Seq.<| Seq (Node Block)
rest))
            ViewL (Node Block)
_ -> Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Blocks -> State BState Builder) -> Blocks -> State BState Builder
forall a b. (a -> b) -> a -> b
$ Format -> ByteString -> Blocks
rawBlock (ByteString -> Format
Format ByteString
"html") ByteString
input Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs
  Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"li" Pos
NoPos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", if TaskStatus
status TaskStatus -> TaskStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TaskStatus
Complete
                                             then ByteString
"checked"
                                             else ByteString
"unchecked")])  (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
body) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
 where
   inputattr :: ByteString
inputattr = ByteString
" type=\"checkbox\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
               if TaskStatus
status TaskStatus -> TaskStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TaskStatus
Complete then ByteString
" checked=\"\"" else ByteString
""
   input :: ByteString
input = ByteString
"<input" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
inputattr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" />"

toDefinition :: ListSpacing -> (Inlines, Blocks) -> State BState Builder
toDefinition :: ListSpacing -> (Inlines, Blocks) -> State BState Builder
toDefinition ListSpacing
listSpacing (Inlines
term, Blocks
defn) = Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> State BState Builder
-> StateT BState Identity (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"dt" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
term) StateT BState Identity (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall a b.
StateT BState Identity (a -> b)
-> StateT BState Identity a -> StateT BState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"dd" Pos
NoPos Attr
forall a. Monoid a => a
mempty (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListSpacing -> Blocks -> State BState Builder
toItemContents ListSpacing
listSpacing Blocks
defn)

instance ToBuilder (Node Inline) where
  toBuilder :: Node Inline -> State BState Builder
toBuilder (Node Pos
pos Attr
attr Inline
il) =
    case Inline
il of
      Str ByteString
bs -> case Attr
attr of
                   Attr [] | Pos
pos Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
NoPos -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
escapeHtml ByteString
bs
                   Attr
_ -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos Attr
attr (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
escapeHtml ByteString
bs
      Inline
SoftBreak -> do
        RenderOptions
opts <- (BState -> RenderOptions) -> StateT BState Identity RenderOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> RenderOptions
options
        Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
word8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ if RenderOptions -> Bool
preserveSoftBreaks RenderOptions
opts then Word8
10 else Word8
32
      Inline
HardBreak -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder
singleTag ByteString
"br" Pos
NoPos Attr
attr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
      Inline
NonBreakingSpace -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
"&nbsp;"
      Emph Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"em" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Strong Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"strong" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Highlight Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"mark" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Insert Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"ins" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Delete Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"del" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Superscript Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"sup" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Subscript Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"sub" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Quoted QuoteType
SingleQuotes Inlines
ils -> Builder -> Builder
inSingleQuotes (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Quoted QuoteType
DoubleQuotes Inlines
ils -> Builder -> Builder
inDoubleQuotes (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Verbatim ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"code" Pos
pos Attr
attr (ByteString -> Builder
escapeHtml ByteString
bs)
      Math MathStyle
DisplayMath ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$
        ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
"math display")] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
          (Builder
"\\[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
escapeHtml ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\\]")
      Math MathStyle
InlineMath ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$
        ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
"math inline")] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
          (Builder
"\\(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
escapeHtml ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\\)")
      Symbol ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$
        ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"class", ByteString
"symbol")] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
          (Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
escapeHtml ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":")
      Span Inlines
ils -> ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"span" Pos
pos Attr
attr (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Link Inlines
ils Target
target -> do
        Attr
attr' <- case Target
target of
                   Direct ByteString
u -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"href", ByteString
u)]
                   Reference ByteString
label -> do
                     ReferenceMap
rm <- (BState -> ReferenceMap) -> StateT BState Identity ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> ReferenceMap
referenceMap
                     case ByteString -> ReferenceMap -> Maybe (ByteString, Attr)
lookupReference ByteString
label ReferenceMap
rm of
                       Maybe (ByteString, Attr)
Nothing -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"href", ByteString
"")]
                       Just (ByteString
u, Attr [(ByteString, ByteString)]
as) -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr ((ByteString
"href",ByteString
u)(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:[(ByteString, ByteString)]
as)
        ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"a" Pos
pos (Attr
attr' Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr) (Builder -> Builder)
-> State BState Builder -> State BState Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder Inlines
ils
      Image Inlines
ils Target
target -> do
        Attr
attr' <- case Target
target of
                   Direct ByteString
u -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"src", ByteString
u)]
                   Reference ByteString
label -> do
                     ReferenceMap
rm <- (BState -> ReferenceMap) -> StateT BState Identity ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> ReferenceMap
referenceMap
                     case ByteString -> ReferenceMap -> Maybe (ByteString, Attr)
lookupReference ByteString
label ReferenceMap
rm of
                       Maybe (ByteString, Attr)
Nothing -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr [(ByteString
"src", ByteString
"")]
                       Just (ByteString
u, Attr [(ByteString, ByteString)]
as) -> Attr -> StateT BState Identity Attr
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attr -> StateT BState Identity Attr)
-> Attr -> StateT BState Identity Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Attr
Attr ((ByteString
"src",ByteString
u)(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
:[(ByteString, ByteString)]
as)
        Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder
singleTag ByteString
"img" Pos
pos
                 ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"alt", Inlines -> ByteString
inlinesToByteString Inlines
ils)] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr' Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr)
      EmailLink ByteString
email ->
        Node Inline -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr (Inlines -> Target -> Inline
Link (ByteString -> Inlines
str ByteString
email) (ByteString -> Target
Direct (ByteString
"mailto:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
email))))
      UrlLink ByteString
url -> Node Inline -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Pos -> Attr -> Inline -> Node Inline
forall a. Pos -> Attr -> a -> Node a
Node Pos
pos Attr
attr (Inlines -> Target -> Inline
Link (ByteString -> Inlines
str ByteString
url) (ByteString -> Target
Direct ByteString
url)))
      RawInline (Format ByteString
"html") ByteString
bs -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs
      RawInline Format
_ ByteString
_ -> Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
      FootnoteReference ByteString
label -> do
        Map ByteString Int
noterefs <- (BState -> Map ByteString Int)
-> StateT BState Identity (Map ByteString Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Map ByteString Int
noteRefs
        NoteMap
notemap <- (BState -> NoteMap) -> StateT BState Identity NoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> NoteMap
noteMap
        Int
num <- case ByteString -> Map ByteString Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
label Map ByteString Int
noterefs of
                 Just Int
num -> Int -> StateT BState Identity Int
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
num
                 Maybe Int
Nothing -> do
                   let num :: Int
num = Map ByteString Int -> Int
forall k a. Map k a -> Int
M.size Map ByteString Int
noterefs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                   (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BState -> BState) -> StateT BState Identity ())
-> (BState -> BState) -> StateT BState Identity ()
forall a b. (a -> b) -> a -> b
$ \BState
st -> BState
st{ noteRefs = M.insert label num noterefs }
                   Map ByteString Builder
renderedNotesMap <- (BState -> Map ByteString Builder)
-> StateT BState Identity (Map ByteString Builder)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets BState -> Map ByteString Builder
renderedNotes
                   case ByteString -> Map ByteString Builder -> Maybe Builder
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
label Map ByteString Builder
renderedNotesMap of
                     Just Builder
_ -> () -> StateT BState Identity ()
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                     Maybe Builder
Nothing -> do -- render the note and add to renderedNotes
                       let num' :: ByteString
num' = String -> ByteString
B8.pack (Int -> String
forall a. Show a => a -> String
show Int
num)
                       Builder
rendered <- State BState Builder
-> (Blocks -> State BState Builder)
-> Maybe Blocks
-> State BState Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Blocks -> State BState Builder) -> Blocks -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Blocks -> Blocks
addBackref ByteString
num' (Blocks
forall a. Monoid a => a
mempty :: Blocks))
                                    (Blocks -> State BState Builder
forall a. ToBuilder a => a -> State BState Builder
toBuilder (Blocks -> State BState Builder)
-> (Blocks -> Blocks) -> Blocks -> State BState Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Blocks -> Blocks
addBackref ByteString
num') (ByteString -> NoteMap -> Maybe Blocks
lookupNote ByteString
label NoteMap
notemap)
                       (BState -> BState) -> StateT BState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((BState -> BState) -> StateT BState Identity ())
-> (BState -> BState) -> StateT BState Identity ()
forall a b. (a -> b) -> a -> b
$ \BState
st -> BState
st{ renderedNotes =
                                             M.insert label rendered (renderedNotes st) }
                   Int -> StateT BState Identity Int
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
num
        let num' :: ByteString
num' = String -> ByteString
B8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
num
        Builder -> State BState Builder
forall a. a -> StateT BState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> State BState Builder)
-> Builder -> State BState Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"a" Pos
pos ([(ByteString, ByteString)] -> Attr
Attr [(ByteString
"id", ByteString
"fnref" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
num'),
                                     (ByteString
"href", ByteString
"#fn" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
num'),
                                     (ByteString
"role", ByteString
"doc-noteref")] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<> Attr
attr) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
                 ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
"sup" Pos
pos Attr
forall a. Monoid a => a
mempty (ByteString -> Builder
escapeHtml ByteString
num')

{-# INLINE inTags #-}
inTags :: ByteString -> Pos -> Attr -> Builder -> Builder
inTags :: ByteString -> Pos -> Attr -> Builder -> Builder
inTags ByteString
tag Pos
pos Attr
attr Builder
contents =
  Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Pos -> Builder
posToBuilder Pos
pos
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Attr -> Builder
attrToBuilder Attr
attr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
contents
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"


{-# INLINE singleTag #-}
singleTag :: ByteString -> Pos -> Attr -> Builder
singleTag :: ByteString -> Pos -> Attr -> Builder
singleTag ByteString
tag Pos
pos Attr
attr =
  Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
tag Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Pos -> Builder
posToBuilder Pos
pos Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Attr -> Builder
attrToBuilder Attr
attr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">"

{-# INLINE attrToBuilder #-}
attrToBuilder :: Attr -> Builder
attrToBuilder :: Attr -> Builder
attrToBuilder (Attr [(ByteString, ByteString)]
pairs) = ((ByteString, ByteString) -> Builder)
-> [(ByteString, ByteString)] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Builder
go [(ByteString, ByteString)]
pairs
 where
   go :: (ByteString, ByteString) -> Builder
go (ByteString
k,ByteString
v) = Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
escapeHtmlAttribute ByteString
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

{-# INLINE posToBuilder #-}
posToBuilder :: Pos -> Builder
posToBuilder :: Pos -> Builder
posToBuilder Pos
NoPos = Builder
forall a. Monoid a => a
mempty
posToBuilder (Pos Int
sl Int
sc Int
el Int
ec) =
  Builder
" data-pos=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
sc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"-" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
     Int -> Builder
intDec Int
el Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
ec Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

inSingleQuotes :: Builder -> Builder
inSingleQuotes :: Builder -> Builder
inSingleQuotes Builder
x =
  ByteString -> Builder
byteString (String -> ByteString
strToUtf8 String
"\x2018") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (String -> ByteString
strToUtf8 String
"\x2019")

inDoubleQuotes :: Builder -> Builder
inDoubleQuotes :: Builder -> Builder
inDoubleQuotes Builder
x =
  ByteString -> Builder
byteString (String -> ByteString
strToUtf8 String
"\x201C") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (String -> ByteString
strToUtf8 String
"\x201D")