{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Pandoc.Writers.Djot (
writeDjot
) where
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Class ( PandocMonad , report )
import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..))
import Data.Text (Text)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared ( metaToContext, defField, toLegacyTable )
import Text.Pandoc.Shared (isTightList, tshow, stringify, onlySimpleTableCells,
makeSections)
import Text.DocLayout
import Text.DocTemplates (renderTemplate)
import Control.Monad.State (StateT(..), gets, modify)
import Control.Monad (zipWithM, when)
import Data.Maybe (fromMaybe)
import qualified Djot.AST as D
import Djot (renderDjot, RenderOptions(..), toIdentifier)
import Text.Pandoc.UTF8 (fromText)
writeDjot :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDjot :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDjot WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
let ropts :: RenderOptions
ropts = RenderOptions{ preserveSoftBreaks :: Bool
preserveSoftBreaks =
WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve }
Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
((Doc -> Doc Text) -> m Doc -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RenderOptions -> Doc -> Doc Text
renderDjot RenderOptions
ropts) (m Doc -> m (Doc Text))
-> ([Block] -> m Doc) -> [Block] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> m Doc
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Doc
bodyToDjot WriterOptions
opts)
((Doc -> Doc Text) -> m Doc -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (Doc Text -> Doc Text) -> (Doc -> Doc Text) -> Doc -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderOptions -> Doc -> Doc Text
renderDjot RenderOptions
ropts) (m Doc -> m (Doc Text))
-> ([Inline] -> m Doc) -> [Inline] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Block] -> m Doc
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Doc
bodyToDjot WriterOptions
opts ([Block] -> m Doc) -> ([Inline] -> [Block]) -> [Inline] -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[]) (Block -> [Block]) -> ([Inline] -> Block) -> [Inline] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain)
Meta
meta
Doc Text
main <- RenderOptions -> Doc -> Doc Text
renderDjot RenderOptions
ropts (Doc -> Doc Text) -> m Doc -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Block] -> m Doc
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Doc
bodyToDjot WriterOptions
opts (Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False Maybe Int
forall a. Maybe a
Nothing [Block]
blocks)
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main Context Text
metadata
Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
data DjotState =
DjotState
{ :: D.NoteMap
, DjotState -> ReferenceMap
references :: D.ReferenceMap
, DjotState -> ReferenceMap
autoReferences :: D.ReferenceMap
, DjotState -> Set ByteString
autoIds :: Set B.ByteString
, DjotState -> WriterOptions
options :: WriterOptions }
bodyToDjot :: PandocMonad m => WriterOptions -> [Block] -> m D.Doc
bodyToDjot :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m Doc
bodyToDjot WriterOptions
opts [Block]
bls = do
(Blocks
bs, DjotState
st) <- StateT DjotState m Blocks -> DjotState -> m (Blocks, DjotState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls)
(NoteMap
-> ReferenceMap
-> ReferenceMap
-> Set ByteString
-> WriterOptions
-> DjotState
DjotState NoteMap
forall a. Monoid a => a
mempty ReferenceMap
forall a. Monoid a => a
mempty ReferenceMap
forall a. Monoid a => a
mempty Set ByteString
forall a. Monoid a => a
mempty WriterOptions
opts)
let D.ReferenceMap Map ByteString (ByteString, Attr)
autos = DjotState -> ReferenceMap
autoReferences DjotState
st
let D.ReferenceMap Map ByteString (ByteString, Attr)
refs = DjotState -> ReferenceMap
references DjotState
st
Doc -> m Doc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ D.Doc{ docBlocks :: Blocks
D.docBlocks = Blocks
bs
, docFootnotes :: NoteMap
D.docFootnotes = DjotState -> NoteMap
footnotes DjotState
st
, docReferences :: ReferenceMap
D.docReferences = Map ByteString (ByteString, Attr) -> ReferenceMap
D.ReferenceMap (Map ByteString (ByteString, Attr) -> ReferenceMap)
-> Map ByteString (ByteString, Attr) -> ReferenceMap
forall a b. (a -> b) -> a -> b
$ Map ByteString (ByteString, Attr)
-> Map ByteString (ByteString, Attr)
-> Map ByteString (ByteString, Attr)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.difference Map ByteString (ByteString, Attr)
refs Map ByteString (ByteString, Attr)
autos
, docAutoReferences :: ReferenceMap
D.docAutoReferences = Map ByteString (ByteString, Attr) -> ReferenceMap
D.ReferenceMap Map ByteString (ByteString, Attr)
autos
, docAutoIdentifiers :: Set ByteString
D.docAutoIdentifiers = DjotState -> Set ByteString
autoIds DjotState
st
}
blocksToDjot :: PandocMonad m => [Block] -> StateT DjotState m D.Blocks
blocksToDjot :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot = ([Blocks] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall a b.
(a -> b) -> StateT DjotState m a -> StateT DjotState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat (StateT DjotState m [Blocks] -> StateT DjotState m Blocks)
-> ([Block] -> StateT DjotState m [Blocks])
-> [Block]
-> StateT DjotState m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> StateT DjotState m Blocks)
-> [Block] -> StateT DjotState m [Blocks]
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 Block -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Block -> StateT DjotState m Blocks
blockToDjot
blockToDjot :: PandocMonad m => Block -> StateT DjotState m D.Blocks
blockToDjot :: forall (m :: * -> *).
PandocMonad m =>
Block -> StateT DjotState m Blocks
blockToDjot (Para [Inline]
ils) = Inlines -> Blocks
D.para (Inlines -> Blocks)
-> StateT DjotState m Inlines -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
blockToDjot (Plain [Inline]
ils) = Inlines -> Blocks
D.para (Inlines -> Blocks)
-> StateT DjotState m Inlines -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
blockToDjot (LineBlock [[Inline]]
ls) =
Inlines -> Blocks
D.para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
D.hardBreak ([Inlines] -> Blocks)
-> StateT DjotState m [Inlines] -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline] -> StateT DjotState m Inlines)
-> [[Inline]] -> StateT DjotState m [Inlines]
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 [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [[Inline]]
ls
blockToDjot (CodeBlock attr :: Attr
attr@(Text
_,[Text]
_,[(Text, Text)]
kvs) Text
t) = do
let lang :: Text
lang = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs
Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> StateT DjotState m Blocks)
-> Blocks -> StateT DjotState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr)
(Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> Blocks
D.codeBlock (Text -> ByteString
fromText Text
lang) (Text -> ByteString
fromText Text
t)
blockToDjot (RawBlock (Format Text
f) Text
t) =
Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> StateT DjotState m Blocks)
-> Blocks -> StateT DjotState m Blocks
forall a b. (a -> b) -> a -> b
$ Format -> ByteString -> Blocks
D.rawBlock (ByteString -> Format
D.Format (Text -> ByteString
fromText Text
f)) (Text -> ByteString
fromText Text
t)
blockToDjot (BlockQuote [Block]
bls) = Blocks -> Blocks
D.blockQuote (Blocks -> Blocks)
-> StateT DjotState m Blocks -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
blockToDjot (Header Int
lev Attr
attr [Inline]
ils) =
(Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr)) (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Inlines -> Blocks
D.heading Int
lev (Inlines -> Blocks)
-> StateT DjotState m Inlines -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
blockToDjot Block
HorizontalRule = Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
D.thematicBreak
blockToDjot (Div (Text
ident,Text
"section":[Text]
cls,[(Text, Text)]
kvs) bls :: [Block]
bls@(Header Int
_ Attr
_ [Inline]
ils : [Block]
_)) = do
ByteString
ilsBs <- Inlines -> ByteString
D.inlinesToByteString (Inlines -> ByteString)
-> StateT DjotState m Inlines -> StateT DjotState m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
let ident' :: ByteString
ident' = ByteString -> ByteString
toIdentifier ByteString
ilsBs
let label :: ByteString
label = ByteString -> ByteString
D.normalizeLabel ByteString
ilsBs
let autoid :: Bool
autoid = ByteString -> Text
UTF8.toText ByteString
ident' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ident
Bool -> StateT DjotState m () -> StateT DjotState m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
autoid (StateT DjotState m () -> StateT DjotState m ())
-> StateT DjotState m () -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$
(DjotState -> DjotState) -> StateT DjotState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DjotState -> DjotState) -> StateT DjotState m ())
-> (DjotState -> DjotState) -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$ \DjotState
st -> DjotState
st{ autoIds = Set.insert ident' (autoIds st) }
(DjotState -> DjotState) -> StateT DjotState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DjotState -> DjotState) -> StateT DjotState m ())
-> (DjotState -> DjotState) -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$ \DjotState
st -> DjotState
st{ autoReferences = D.insertReference label
(B8.cons '#' ident', mempty) (autoReferences st) }
(Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr (if Bool
autoid then Text
"" else Text
ident,
(Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"section") [Text]
cls,
((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"wrapper") [(Text, Text)]
kvs))) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
D.section
(Blocks -> Blocks)
-> StateT DjotState m Blocks -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
blockToDjot (Div attr :: Attr
attr@(Text
ident,[Text]
cls,[(Text, Text)]
kvs) [Block]
bls)
| Just Text
"1" <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"wrapper" [(Text, Text)]
kvs
= (Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr
(Attr -> Attr
toDjotAttr (Text
ident,[Text]
cls,((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"wrapper") [(Text, Text)]
kvs)))
(Blocks -> Blocks)
-> StateT DjotState m Blocks -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
| Bool
otherwise
= (Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr)) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
D.div (Blocks -> Blocks)
-> StateT DjotState m Blocks -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
blockToDjot (BulletList [[Block]]
items) =
ListSpacing -> [Blocks] -> Blocks
D.bulletList ListSpacing
spacing ([Blocks] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> StateT DjotState m Blocks)
-> [[Block]] -> StateT DjotState m [Blocks]
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 [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [[Block]]
items
where
spacing :: ListSpacing
spacing = if [[Block]] -> Bool
isTightList [[Block]]
items then ListSpacing
D.Tight else ListSpacing
D.Loose
blockToDjot (OrderedList (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) [[Block]]
items) =
OrderedListAttributes -> ListSpacing -> [Blocks] -> Blocks
D.orderedList OrderedListAttributes
listAttr ListSpacing
spacing ([Blocks] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> StateT DjotState m Blocks)
-> [[Block]] -> StateT DjotState m [Blocks]
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 [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [[Block]]
items
where
spacing :: ListSpacing
spacing = if [[Block]] -> Bool
isTightList [[Block]]
items then ListSpacing
D.Tight else ListSpacing
D.Loose
listAttr :: OrderedListAttributes
listAttr = D.OrderedListAttributes {
orderedListStyle :: OrderedListStyle
D.orderedListStyle =
case ListNumberStyle
sty of
ListNumberStyle
DefaultStyle -> OrderedListStyle
D.Decimal
ListNumberStyle
Example -> OrderedListStyle
D.Decimal
ListNumberStyle
Decimal -> OrderedListStyle
D.Decimal
ListNumberStyle
LowerRoman -> OrderedListStyle
D.RomanLower
ListNumberStyle
UpperRoman -> OrderedListStyle
D.RomanUpper
ListNumberStyle
LowerAlpha -> OrderedListStyle
D.LetterLower
ListNumberStyle
UpperAlpha -> OrderedListStyle
D.LetterUpper,
orderedListDelim :: OrderedListDelim
D.orderedListDelim =
case ListNumberDelim
delim of
ListNumberDelim
DefaultDelim -> OrderedListDelim
D.RightPeriod
ListNumberDelim
Period -> OrderedListDelim
D.RightPeriod
ListNumberDelim
OneParen -> OrderedListDelim
D.RightParen
ListNumberDelim
TwoParens -> OrderedListDelim
D.LeftRightParen,
orderedListStart :: Int
D.orderedListStart = Int
start }
blockToDjot (DefinitionList [([Inline], [[Block]])]
items) =
ListSpacing -> [(Inlines, Blocks)] -> Blocks
D.definitionList ListSpacing
spacing ([(Inlines, Blocks)] -> Blocks)
-> StateT DjotState m [(Inlines, Blocks)]
-> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> StateT DjotState m (Inlines, Blocks))
-> [([Inline], [[Block]])]
-> StateT DjotState m [(Inlines, Blocks)]
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 ([Inline], [[Block]]) -> StateT DjotState m (Inlines, Blocks)
forall {m :: * -> *}.
PandocMonad m =>
([Inline], [[Block]]) -> StateT DjotState m (Inlines, Blocks)
toDLItem [([Inline], [[Block]])]
items
where
spacing :: ListSpacing
spacing = if [[Block]] -> Bool
isTightList ((([Inline], [[Block]]) -> [Block])
-> [([Inline], [[Block]])] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Block]] -> [Block]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Block]] -> [Block])
-> (([Inline], [[Block]]) -> [[Block]])
-> ([Inline], [[Block]])
-> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd) [([Inline], [[Block]])]
items)
then ListSpacing
D.Tight
else ListSpacing
D.Loose
toDLItem :: ([Inline], [[Block]]) -> StateT DjotState m (Inlines, Blocks)
toDLItem ([Inline]
term, [[Block]]
defs) = do
Inlines
term' <- [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
term
Blocks
def' <- [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> StateT DjotState m Blocks)
-> [[Block]] -> StateT DjotState m [Blocks]
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 [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [[Block]]
defs
(Inlines, Blocks) -> StateT DjotState m (Inlines, Blocks)
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines
term', Blocks
def')
blockToDjot (Figure Attr
attr (Caption Maybe [Inline]
_ [Block]
capt) [Block]
bls) = do
Blocks
content <- [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
Blocks
caption <- (Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr ([(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"class",ByteString
"caption")])) (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
D.div (Blocks -> Blocks)
-> StateT DjotState m Blocks -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
capt
Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> StateT DjotState m Blocks)
-> Blocks -> StateT DjotState m Blocks
forall a b. (a -> b) -> a -> b
$ (Node Block -> Node Block) -> Blocks -> Blocks
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr)) (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
D.div (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
content Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
caption
blockToDjot (Table Attr
attr Caption
capt' [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
let ([Inline]
capt, [Alignment]
aligns, [Double]
_, [[Block]]
headRow, [[[Block]]]
bodyRows) =
Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
capt' [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot
if [[[Block]]] -> Bool
onlySimpleTableCells ([[Block]]
headRow [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
bodyRows)
then do
let alignToAlign :: Alignment -> Align
alignToAlign Alignment
al = case Alignment
al of
Alignment
AlignDefault -> Align
D.AlignDefault
Alignment
AlignLeft -> Align
D.AlignLeft
Alignment
AlignRight -> Align
D.AlignRight
Alignment
AlignCenter -> Align
D.AlignCenter
let defAligns :: [Align]
defAligns = (Alignment -> Align) -> [Alignment] -> [Align]
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Align
alignToAlign [Alignment]
aligns
let cellToCell :: Bool -> [Block] -> Align -> StateT DjotState m Cell
cellToCell Bool
isHeader [Block]
bls Align
al =
CellType -> Align -> Inlines -> Cell
D.Cell (if Bool
isHeader then CellType
D.HeadCell else CellType
D.BodyCell) Align
al
(Inlines -> Cell)
-> StateT DjotState m Inlines -> StateT DjotState m Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [Block]
bls of
[Para [Inline]
ils] -> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
[Plain [Inline]
ils] -> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
[] -> Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
forall a. Monoid a => a
mempty
[Block]
bs -> do
(Block -> StateT DjotState m ())
-> [Block] -> StateT DjotState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LogMessage -> StateT DjotState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT DjotState m ())
-> (Block -> LogMessage) -> Block -> StateT DjotState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> LogMessage
BlockNotRendered) [Block]
bs
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
D.str ByteString
"((omitted))"
let rowToRow :: Bool -> [[Block]] -> StateT DjotState m [Cell]
rowToRow Bool
isHeader [[Block]]
cells = ([Block] -> Align -> StateT DjotState m Cell)
-> [[Block]] -> [Align] -> StateT DjotState m [Cell]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Bool -> [Block] -> Align -> StateT DjotState m Cell
forall {m :: * -> *}.
PandocMonad m =>
Bool -> [Block] -> Align -> StateT DjotState m Cell
cellToCell Bool
isHeader) [[Block]]
cells [Align]
defAligns
[[Cell]]
hrows <- if [[Block]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headRow
then [[Cell]] -> StateT DjotState m [[Cell]]
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else ([Cell] -> [[Cell]] -> [[Cell]]
forall a. a -> [a] -> [a]
:[]) ([Cell] -> [[Cell]])
-> StateT DjotState m [Cell] -> StateT DjotState m [[Cell]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [[Block]] -> StateT DjotState m [Cell]
forall {m :: * -> *}.
PandocMonad m =>
Bool -> [[Block]] -> StateT DjotState m [Cell]
rowToRow Bool
True [[Block]]
headRow
[[Cell]]
rows <- ([[Block]] -> StateT DjotState m [Cell])
-> [[[Block]]] -> StateT DjotState m [[Cell]]
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 (Bool -> [[Block]] -> StateT DjotState m [Cell]
forall {m :: * -> *}.
PandocMonad m =>
Bool -> [[Block]] -> StateT DjotState m [Cell]
rowToRow Bool
False) [[[Block]]]
bodyRows
Maybe Caption
caption <- case [Inline]
capt of
[] -> Maybe Caption -> StateT DjotState m (Maybe Caption)
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Caption
forall a. Maybe a
Nothing
[Inline]
_ -> Caption -> Maybe Caption
forall a. a -> Maybe a
Just (Caption -> Maybe Caption)
-> (Inlines -> Caption) -> Inlines -> Maybe Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Caption
D.Caption (Blocks -> Caption) -> (Inlines -> Blocks) -> Inlines -> Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
D.para (Inlines -> Maybe Caption)
-> StateT DjotState m Inlines -> StateT DjotState m (Maybe Caption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
capt
Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> StateT DjotState m Blocks)
-> Blocks -> StateT DjotState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr) (Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Caption -> [[Cell]] -> Blocks
D.table Maybe Caption
caption ([[Cell]]
hrows [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. Semigroup a => a -> a -> a
<> [[Cell]]
rows)
else do
Blocks
tableList <- ListSpacing -> [Blocks] -> Blocks
D.bulletList ListSpacing
D.Loose ([Blocks] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Block]] -> StateT DjotState m Blocks)
-> [[[Block]]] -> StateT DjotState m [Blocks]
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] -> Blocks)
-> StateT DjotState m [Blocks] -> StateT DjotState m Blocks
forall a b.
(a -> b) -> StateT DjotState m a -> StateT DjotState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListSpacing -> [Blocks] -> Blocks
D.bulletList ListSpacing
D.Loose) (StateT DjotState m [Blocks] -> StateT DjotState m Blocks)
-> ([[Block]] -> StateT DjotState m [Blocks])
-> [[Block]]
-> StateT DjotState m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> StateT DjotState m Blocks)
-> [[Block]] -> StateT DjotState m [Blocks]
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 [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot)
([[Block]]
headRow[[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
:[[[Block]]]
bodyRows)
Blocks -> StateT DjotState m Blocks
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> StateT DjotState m Blocks)
-> Blocks -> StateT DjotState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Node Block -> Node Block
forall a. Attr -> Node a -> Node a
D.addAttr ([(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"class", ByteString
"table")]) (Node Block -> Node Block) -> Blocks -> Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks
tableList
inlinesToDjot :: PandocMonad m => [Inline] -> StateT DjotState m D.Inlines
inlinesToDjot :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot = ([Inlines] -> Inlines)
-> StateT DjotState m [Inlines] -> StateT DjotState m Inlines
forall a b.
(a -> b) -> StateT DjotState m a -> StateT DjotState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (StateT DjotState m [Inlines] -> StateT DjotState m Inlines)
-> ([Inline] -> StateT DjotState m [Inlines])
-> [Inline]
-> StateT DjotState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> StateT DjotState m Inlines)
-> [Inline] -> StateT DjotState m [Inlines]
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 Inline -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Inline -> StateT DjotState m Inlines
inlineToDjot
inlineToDjot :: PandocMonad m => Inline -> StateT DjotState m D.Inlines
inlineToDjot :: forall (m :: * -> *).
PandocMonad m =>
Inline -> StateT DjotState m Inlines
inlineToDjot (Str Text
t) = Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
D.str (Text -> ByteString
fromText Text
t)
inlineToDjot Inline
Space = Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
D.str ByteString
" "
inlineToDjot Inline
SoftBreak = Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
D.softBreak
inlineToDjot Inline
LineBreak = Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
D.hardBreak
inlineToDjot (Emph [Inline]
ils) = Inlines -> Inlines
D.emph (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Underline [Inline]
ils) =
(Node Inline -> Node Inline) -> Inlines -> Inlines
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr ([(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"class",ByteString
"underline")])) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
D.span_
(Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Strong [Inline]
ils) = Inlines -> Inlines
D.strong (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Strikeout [Inline]
ils) = Inlines -> Inlines
D.delete (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Subscript [Inline]
ils) = Inlines -> Inlines
D.subscript (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Superscript [Inline]
ils) = Inlines -> Inlines
D.superscript (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Span attr :: Attr
attr@(Text
ident,[Text]
cls,[(Text, Text)]
kvs) [Inline]
ils)
| Just Text
"1" <- Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"wrapper" [(Text, Text)]
kvs
= (Node Inline -> Node Inline) -> Inlines -> Inlines
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr
(Attr -> Attr
toDjotAttr (Text
ident,[Text]
cls,((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"wrapper") [(Text, Text)]
kvs)))
(Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
| Bool
otherwise
= (Node Inline -> Node Inline) -> Inlines -> Inlines
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr)) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
D.span_ (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (SmallCaps [Inline]
ils) =
(Node Inline -> Node Inline) -> Inlines -> Inlines
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr ([(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"class",ByteString
"smallcaps")])) (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
D.span_
(Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Quoted QuoteType
DoubleQuote [Inline]
ils) = Inlines -> Inlines
D.doubleQuoted (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Quoted QuoteType
SingleQuote [Inline]
ils) = Inlines -> Inlines
D.singleQuoted (Inlines -> Inlines)
-> StateT DjotState m Inlines -> StateT DjotState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Cite [Citation]
_cs [Inline]
ils) = [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
inlineToDjot (Code Attr
attr Text
t) =
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr (Attr -> Attr
toDjotAttr Attr
attr) (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Inlines
D.verbatim (Text -> ByteString
fromText Text
t)
inlineToDjot (Math MathType
mt Text
t) =
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ (if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
InlineMath
then ByteString -> Inlines
D.inlineMath
else ByteString -> Inlines
D.displayMath) (Text -> ByteString
fromText Text
t)
inlineToDjot (RawInline (Format Text
f) Text
t) =
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Format -> ByteString -> Inlines
D.rawInline (ByteString -> Format
D.Format (Text -> ByteString
fromText Text
f)) (Text -> ByteString
fromText Text
t)
inlineToDjot (Link Attr
attr [Inline]
ils (Text
src,Text
tit)) = do
WriterOptions
opts <- (DjotState -> WriterOptions) -> StateT DjotState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> WriterOptions
options
Inlines
description <- [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
let ilstring :: Text
ilstring = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
let autolink :: Bool
autolink = Text
ilstring Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src
let email :: Bool
email = (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ilstring) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src
let removeClass :: a -> (a, [a], c) -> (a, [a], c)
removeClass a
name (a
ident, [a]
cls, c
kvs) = (a
ident, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
name) [a]
cls, c
kvs)
let attr' :: Attr
attr' = [(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"title", Text -> ByteString
fromText Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<>
Attr -> Attr
toDjotAttr ( (if Bool
autolink
then Text -> Attr -> Attr
forall {a} {a} {c}. Eq a => a -> (a, [a], c) -> (a, [a], c)
removeClass Text
"uri"
else Attr -> Attr
forall a. a -> a
id) (Attr -> Attr) -> (Attr -> Attr) -> Attr -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Bool
email
then Text -> Attr -> Attr
forall {a} {a} {c}. Eq a => a -> (a, [a], c) -> (a, [a], c)
removeClass Text
"email"
else Attr -> Attr
forall a. a -> a
id) (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Attr
attr)
case () of
()
_ | Bool
autolink -> Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Inlines
D.urlLink (Text -> ByteString
fromText Text
ilstring)
| Bool
email -> Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Inlines
D.emailLink (Text -> ByteString
fromText Text
ilstring)
| WriterOptions -> Bool
writerReferenceLinks WriterOptions
opts
-> do refs :: ReferenceMap
refs@(D.ReferenceMap Map ByteString (ByteString, Attr)
m) <- (DjotState -> ReferenceMap) -> StateT DjotState m ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> ReferenceMap
references
ReferenceMap
autoRefs <- (DjotState -> ReferenceMap) -> StateT DjotState m ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> ReferenceMap
autoReferences
let lab' :: ByteString
lab' = Inlines -> ByteString
D.inlinesToByteString Inlines
description
ByteString
lab <- case ByteString -> ReferenceMap -> Maybe (ByteString, Attr)
D.lookupReference ByteString
lab' (ReferenceMap
refs ReferenceMap -> ReferenceMap -> ReferenceMap
forall a. Semigroup a => a -> a -> a
<> ReferenceMap
autoRefs) of
Just (ByteString, Attr)
_ -> ByteString -> StateT DjotState m ByteString
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
lab'
Maybe (ByteString, Attr)
Nothing -> do
let refnum :: Int
refnum = Map ByteString (ByteString, Attr) -> Int
forall k a. Map k a -> Int
M.size Map ByteString (ByteString, Attr)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
let lab :: ByteString
lab = Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
refnum
(DjotState -> DjotState) -> StateT DjotState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DjotState -> DjotState) -> StateT DjotState m ())
-> (DjotState -> DjotState) -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$ \DjotState
st -> DjotState
st{ references =
D.insertReference lab
(fromText src, attr') refs }
ByteString -> StateT DjotState m ByteString
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
lab
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> Target -> Inlines
D.link Inlines
description (ByteString -> Target
D.Reference ByteString
lab)
| Bool
otherwise
-> Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> Target -> Inlines
D.link Inlines
description (ByteString -> Target
D.Direct (Text -> ByteString
fromText Text
src))
inlineToDjot (Image Attr
attr [Inline]
ils (Text
src,Text
tit)) = do
WriterOptions
opts <- (DjotState -> WriterOptions) -> StateT DjotState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> WriterOptions
options
Inlines
description <- [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
ils
let attr' :: Attr
attr' = [(ByteString, ByteString)] -> Attr
D.Attr [(ByteString
"title", Text -> ByteString
fromText Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] Attr -> Attr -> Attr
forall a. Semigroup a => a -> a -> a
<>
Attr -> Attr
toDjotAttr Attr
attr
if WriterOptions -> Bool
writerReferenceLinks WriterOptions
opts
then do
refs :: ReferenceMap
refs@(D.ReferenceMap Map ByteString (ByteString, Attr)
m) <- (DjotState -> ReferenceMap) -> StateT DjotState m ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> ReferenceMap
references
let refnum :: Int
refnum = Map ByteString (ByteString, Attr) -> Int
forall k a. Map k a -> Int
M.size Map ByteString (ByteString, Attr)
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
let lab :: ByteString
lab = Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
refnum
(DjotState -> DjotState) -> StateT DjotState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DjotState -> DjotState) -> StateT DjotState m ())
-> (DjotState -> DjotState) -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$ \DjotState
st -> DjotState
st{ references =
D.insertReference lab
(fromText src, attr') refs }
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> Target -> Inlines
D.image Inlines
description (ByteString -> Target
D.Reference ByteString
lab)
else Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Node Inline -> Node Inline
forall a. Attr -> Node a -> Node a
D.addAttr Attr
attr' (Node Inline -> Node Inline) -> Inlines -> Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inlines -> Target -> Inlines
D.image Inlines
description (ByteString -> Target
D.Direct (Text -> ByteString
fromText Text
src))
inlineToDjot (Note [Block]
bs) = do
notes :: NoteMap
notes@(D.NoteMap Map ByteString Blocks
m) <- (DjotState -> NoteMap) -> StateT DjotState m NoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> NoteMap
footnotes
let notenum :: Int
notenum = Map ByteString Blocks -> Int
forall k a. Map k a -> Int
M.size Map ByteString Blocks
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
let lab :: ByteString
lab = Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
notenum
Blocks
contents <- [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bs
(DjotState -> DjotState) -> StateT DjotState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DjotState -> DjotState) -> StateT DjotState m ())
-> (DjotState -> DjotState) -> StateT DjotState m ()
forall a b. (a -> b) -> a -> b
$ \DjotState
st -> DjotState
st{ footnotes = D.insertNote lab contents notes }
Inlines -> StateT DjotState m Inlines
forall a. a -> StateT DjotState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT DjotState m Inlines)
-> Inlines -> StateT DjotState m Inlines
forall a b. (a -> b) -> a -> b
$ ByteString -> Inlines
D.footnoteReference ByteString
lab
toDjotAttr :: (Text, [Text], [(Text, Text)]) -> D.Attr
toDjotAttr :: Attr -> Attr
toDjotAttr (Text
ident, [Text]
classes, [(Text, Text)]
kvs) =
[(ByteString, ByteString)] -> Attr
D.Attr ([(ByteString, ByteString)] -> Attr)
-> [(ByteString, ByteString)] -> Attr
forall a b. (a -> b) -> a -> b
$ [(ByteString
"id", Text -> ByteString
fromText Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++
[(ByteString
"class", Text -> ByteString
fromText ([Text] -> Text
T.unwords [Text]
classes)) | Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes)] [(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++
((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k,Text
v) -> (Text -> ByteString
fromText Text
k, Text -> ByteString
fromText Text
v)) [(Text, Text)]
kvs