{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.Writers.Djot
   Copyright   : Copyright (C) 2024 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' format into Djot markup (<https://djot.net>).
-}
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)

-- | Convert Pandoc to Djot.
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
  { DjotState -> NoteMap
footnotes :: 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 -- table can't be represented as a simple pipe table, use list
       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