{-# 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 }
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
main <- renderDjot ropts <$>
bodyToDjot opts (makeSections False Nothing blocks)
let 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
return $ render colwidth $
case writerTemplate 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
(bs, 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 autos = autoReferences st
let D.ReferenceMap refs = references st
pure $ D.Doc{ D.docBlocks = bs
, D.docFootnotes = footnotes st
, D.docReferences = D.ReferenceMap $ M.difference refs autos
, D.docAutoReferences = D.ReferenceMap autos
, D.docAutoIdentifiers = autoIds 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
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 -> ByteString
toIdentifier ByteString
ilsBs
let label = ByteString -> ByteString
D.normalizeLabel ByteString
ilsBs
let autoid = ByteString -> Text
UTF8.toText ByteString
ident' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ident
when autoid $
modify $ \DjotState
st -> DjotState
st{ autoIds = Set.insert ident' (autoIds st) }
modify $ \DjotState
st -> DjotState
st{ autoReferences = D.insertReference label
(B8.cons '#' ident', mempty) (autoReferences st) }
fmap
(D.addAttr (toDjotAttr (if autoid then "" else ident,
filter (/= "section") cls,
filter (\(Text
k,Text
_) -> Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"wrapper") kvs))) . D.section
<$> blocksToDjot 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
term' <- [Inline] -> StateT DjotState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> StateT DjotState m Inlines
inlinesToDjot [Inline]
term
def' <- mconcat <$> mapM blocksToDjot defs
pure (term', def')
blockToDjot (Figure Attr
attr (Caption Maybe [Inline]
_ [Block]
capt) [Block]
bls) = do
content <- [Block] -> StateT DjotState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Block] -> StateT DjotState m Blocks
blocksToDjot [Block]
bls
caption <- fmap (D.addAttr (D.Attr [("class","caption")])) . D.div <$>
blocksToDjot capt
pure $ fmap (D.addAttr (toDjotAttr attr)) $ D.div $ content <> 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
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
rows <- mapM (rowToRow False) bodyRows
caption <- case 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
pure $ D.addAttr (toDjotAttr attr) <$> D.table caption (hrows <> rows)
else do
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)
pure $ D.addAttr (D.Attr [("class", "table")]) <$> 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 (Text
"",[Text
"mark"],[]) [Inline]
ils) = Inlines -> Inlines
D.highlight (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
opts <- (DjotState -> WriterOptions) -> StateT DjotState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> WriterOptions
options
description <- inlinesToDjot ils
let ilstring = [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils
let autolink = Text
ilstring Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src
let 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
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' = [(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@(D.ReferenceMap m) <- (DjotState -> ReferenceMap) -> StateT DjotState m ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> ReferenceMap
references
autoRefs <- gets autoReferences
let lab' = Inlines -> ByteString
D.inlinesToByteString Inlines
description
lab <- case D.lookupReference lab' (refs <> 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
pure $ D.addAttr attr' <$> D.link description (D.Reference 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
opts <- (DjotState -> WriterOptions) -> StateT DjotState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> WriterOptions
options
description <- inlinesToDjot ils
let 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 writerReferenceLinks opts
then do
refs@(D.ReferenceMap m) <- gets references
let 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 = 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
modify $ \DjotState
st -> DjotState
st{ references =
D.insertReference lab
(fromText src, attr') refs }
pure $ D.addAttr attr' <$> D.image description (D.Reference lab)
else pure $ D.addAttr attr' <$> D.image description (D.Direct (fromText src))
inlineToDjot (Note [Block]
bs) = do
notes@(D.NoteMap m) <- (DjotState -> NoteMap) -> StateT DjotState m NoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DjotState -> NoteMap
footnotes
let 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 = 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
contents <- blocksToDjot bs
modify $ \DjotState
st -> DjotState
st{ footnotes = D.insertNote lab contents notes }
pure $ D.footnoteReference 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