{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

{- |
   Module      : Text.Pandoc.Readers.AsciiDoc
   Copyright   : Copyright (C) 2024 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Reads and evaluates a AsciiDoc document as a Pandoc AST.
-}
module Text.Pandoc.Readers.AsciiDoc
  ( readAsciiDoc
  )
where

import Text.Pandoc.Class
import Text.Pandoc.Options
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import Text.Pandoc.Shared (addPandocAttributes, blocksToInlines, safeRead,
                           tshow)
import qualified Text.Pandoc.UTF8 as UTF8
import qualified AsciiDoc as A
import Text.Pandoc.Error
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Readers.HTML (readHtml)
import Control.Monad.Except (throwError)
import Control.Monad
import Text.Pandoc.Parsing (newPos, sourceName)
import Text.Pandoc.Logging
import Text.Pandoc.Sources
import Control.Monad.State
import Data.List (intersperse, foldl')
import Data.Char (chr, ord)
import qualified Data.Text as T
import qualified Data.Map as M
import Data.Maybe (fromMaybe)

-- import Debug.Trace

-- | Read AsciiDoc from an input string and return a Pandoc document.
readAsciiDoc :: (PandocMonad m, ToSources a) => ReaderOptions -> a -> m Pandoc
readAsciiDoc :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readAsciiDoc ReaderOptions
_opts a
inp = do
  let Sources [(SourcePos, Text)]
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
  ([Document] -> Document
forall a. Monoid a => [a] -> a
mconcat ([Document] -> Document) -> m [Document] -> m Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SourcePos, Text) -> m Document)
-> [(SourcePos, Text)] -> m [Document]
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
   (\(SourcePos
sourcepos, Text
t) ->
     (FilePath -> m Text)
-> (FilePath -> Int -> FilePath -> m Document)
-> FilePath
-> Text
-> m Document
forall (m :: * -> *).
Monad m =>
(FilePath -> m Text)
-> (FilePath -> Int -> FilePath -> m Document)
-> FilePath
-> Text
-> m Document
A.parseDocument FilePath -> m Text
forall {f :: * -> *}. PandocMonad f => FilePath -> f Text
getIncludeFile FilePath -> Int -> FilePath -> m Document
forall {m :: * -> *} {a} {a} {a}.
(MonadError PandocError m, Show a, Show a) =>
a -> a -> FilePath -> m a
raiseError (SourcePos -> FilePath
sourceName SourcePos
sourcepos) Text
t)
    [(SourcePos, Text)]
sources)
   m Document -> (Document -> m Document) -> m Document
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Document
forall (m :: * -> *). Monad m => Document -> m Document
resolveFootnotes
   m Document -> (Document -> m Document) -> m Document
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Document
forall (m :: * -> *). Monad m => Document -> m Document
resolveStem
   m Document -> (Document -> m Document) -> m Document
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Document
forall (m :: * -> *). Monad m => Document -> m Document
resolveIcons
   m Document -> (Document -> m Pandoc) -> m Pandoc
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Document -> m Pandoc
forall (m :: * -> *). PandocMonad m => Document -> m Pandoc
toPandoc
 where
  getIncludeFile :: FilePath -> f Text
getIncludeFile FilePath
fp = ByteString -> Text
UTF8.toText (ByteString -> Text) -> f ByteString -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict FilePath
fp
  raiseError :: a -> a -> FilePath -> m a
raiseError a
fp a
pos FilePath
msg = PandocError -> m a
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m a) -> PandocError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack
                            (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
msg FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Show a => a -> FilePath
show a
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                              FilePath
" char " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Show a => a -> FilePath
show a
pos

toPandoc :: PandocMonad m => A.Document -> m Pandoc
toPandoc :: forall (m :: * -> *). PandocMonad m => Document -> m Pandoc
toPandoc Document
doc =
  Meta -> [Block] -> Pandoc
Pandoc (Meta -> [Block] -> Pandoc) -> m Meta -> m ([Block] -> Pandoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Meta -> m Meta
forall (m :: * -> *). PandocMonad m => Meta -> m Meta
doMeta (Document -> Meta
A.docMeta Document
doc)
         m ([Block] -> Pandoc) -> m [Block] -> m Pandoc
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block]) -> m Blocks -> m [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks (Document -> [Block]
A.docBlocks Document
doc))

resolveFootnotes :: Monad m => A.Document -> m A.Document
resolveFootnotes :: forall (m :: * -> *). Monad m => Document -> m Document
resolveFootnotes Document
doc = do
  StateT (Map Text [Inline]) m Document
-> Map Text [Inline] -> m Document
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((Inline -> StateT (Map Text [Inline]) m Inline)
-> Document -> StateT (Map Text [Inline]) m Document
forall a (m :: * -> *).
(HasInlines a, Monad m) =>
(Inline -> m Inline) -> a -> m a
forall (m :: * -> *).
Monad m =>
(Inline -> m Inline) -> Document -> m Document
A.mapInlines Inline -> StateT (Map Text [Inline]) m Inline
forall {m :: * -> *}.
MonadState (Map Text [Inline]) m =>
Inline -> m Inline
go Document
doc) (Map Text [Inline]
forall a. Monoid a => a
mempty :: M.Map T.Text [A.Inline])
 where
   go :: Inline -> m Inline
go (A.Inline Attr
attr (A.Footnote (Just (A.FootnoteId Text
fnid)) [Inline]
ils)) = do
     Map Text [Inline]
fnmap <- m (Map Text [Inline])
forall s (m :: * -> *). MonadState s m => m s
get
     case Text -> Map Text [Inline] -> Maybe [Inline]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
fnid Map Text [Inline]
fnmap of
       Just [Inline]
ils' ->
         Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> InlineType -> Inline
A.Inline Attr
attr (Maybe FootnoteId -> [Inline] -> InlineType
A.Footnote (FootnoteId -> Maybe FootnoteId
forall a. a -> Maybe a
Just (Text -> FootnoteId
A.FootnoteId Text
fnid)) [Inline]
ils')
       Maybe [Inline]
Nothing -> do
         Map Text [Inline] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Map Text [Inline] -> m ()) -> Map Text [Inline] -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inline] -> Map Text [Inline] -> Map Text [Inline]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
fnid [Inline]
ils Map Text [Inline]
fnmap
         Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> InlineType -> Inline
A.Inline Attr
attr (Maybe FootnoteId -> [Inline] -> InlineType
A.Footnote (FootnoteId -> Maybe FootnoteId
forall a. a -> Maybe a
Just (Text -> FootnoteId
A.FootnoteId Text
fnid)) [Inline]
ils)
   go Inline
x = Inline -> m Inline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
x

resolveStem :: Monad m => A.Document -> m A.Document
resolveStem :: forall (m :: * -> *). Monad m => Document -> m Document
resolveStem Document
doc = do
  let defaultType :: MathType
defaultType = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"stem" (Meta -> Map Text Text
A.docAttributes (Document -> Meta
A.docMeta Document
doc)) of
                      Just Text
"asciimath" -> MathType
A.AsciiMath
                      Maybe Text
_ -> MathType
A.LaTeXMath
  let doInlineStem :: Inline -> f Inline
doInlineStem (A.Inline Attr
attr (A.Math Maybe MathType
Nothing Text
t)) =
        Inline -> f Inline
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> f Inline) -> Inline -> f Inline
forall a b. (a -> b) -> a -> b
$ Attr -> InlineType -> Inline
A.Inline Attr
attr (Maybe MathType -> Text -> InlineType
A.Math (MathType -> Maybe MathType
forall a. a -> Maybe a
Just MathType
defaultType) Text
t)
      doInlineStem Inline
x = Inline -> f Inline
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
x
  let doBlockStem :: Block -> f Block
doBlockStem (A.Block Attr
attr Maybe BlockTitle
mbtit (A.MathBlock Maybe MathType
Nothing Text
t)) =
        Block -> f Block
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> f Block) -> Block -> f Block
forall a b. (a -> b) -> a -> b
$ Attr -> Maybe BlockTitle -> BlockType -> Block
A.Block Attr
attr Maybe BlockTitle
mbtit (Maybe MathType -> Text -> BlockType
A.MathBlock (MathType -> Maybe MathType
forall a. a -> Maybe a
Just MathType
defaultType) Text
t)
      doBlockStem Block
x = (Inline -> f Inline) -> Block -> f Block
forall a (m :: * -> *).
(HasInlines a, Monad m) =>
(Inline -> m Inline) -> a -> m a
forall (m :: * -> *).
Monad m =>
(Inline -> m Inline) -> Block -> m Block
A.mapInlines Inline -> f Inline
forall {f :: * -> *}. Applicative f => Inline -> f Inline
doInlineStem Block
x
  (Block -> m Block) -> Document -> m Document
forall a (m :: * -> *).
(HasBlocks a, Monad m) =>
(Block -> m Block) -> a -> m a
forall (m :: * -> *).
Monad m =>
(Block -> m Block) -> Document -> m Document
A.mapBlocks Block -> m Block
forall {f :: * -> *}. Monad f => Block -> f Block
doBlockStem Document
doc

-- resolve icons as either characters in an icon font or images
resolveIcons :: Monad m => A.Document -> m A.Document
resolveIcons :: forall (m :: * -> *). Monad m => Document -> m Document
resolveIcons Document
doc = (Inline -> m Inline) -> Document -> m Document
forall a (m :: * -> *).
(HasInlines a, Monad m) =>
(Inline -> m Inline) -> a -> m a
forall (m :: * -> *).
Monad m =>
(Inline -> m Inline) -> Document -> m Document
A.mapInlines Inline -> m Inline
forall {f :: * -> *}. Applicative f => Inline -> f Inline
fromIcon Document
doc
 where
   docattrs :: Map Text Text
docattrs = Meta -> Map Text Text
A.docAttributes (Document -> Meta
A.docMeta Document
doc)
   iconFont :: Bool
iconFont = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"icons" Map Text Text
docattrs of
                Just Text
"font" -> Bool
True
                Maybe Text
_ -> Bool
False
   iconsdir :: Text
iconsdir = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"./images/icons" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"iconsdir" Map Text Text
docattrs
   icontype :: Text
icontype = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"png" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"icontype" Map Text Text
docattrs
   addClasses :: [Text] -> Attr -> Attr
addClasses [Text]
cls (A.Attr [Text]
ps Map Text Text
kvs) =
     [Text] -> Map Text Text -> Attr
A.Attr [Text]
ps (Map Text Text -> Attr) -> Map Text Text -> Attr
forall a b. (a -> b) -> a -> b
$
      case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"role" Map Text Text
kvs of
       Just Text
r -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"role" ([Text] -> Text
T.unwords (Text
r Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cls)) Map Text Text
kvs
       Maybe Text
Nothing -> Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
"role" ([Text] -> Text
T.unwords [Text]
cls) Map Text Text
kvs
   fromIcon :: Inline -> f Inline
fromIcon (A.Inline Attr
attr (A.Icon Text
name)) =
     if Bool
iconFont
        then Inline -> f Inline
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> f Inline) -> Inline -> f Inline
forall a b. (a -> b) -> a -> b
$
              Attr -> InlineType -> Inline
A.Inline ([Text] -> Attr -> Attr
addClasses [Text
"fa", Text
"fa-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name] Attr
attr) ([Inline] -> InlineType
A.Span [])
        else Inline -> f Inline
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inline -> f Inline) -> Inline -> f Inline
forall a b. (a -> b) -> a -> b
$ -- default is to use an image
              Attr -> InlineType -> Inline
A.Inline ([Text] -> Attr -> Attr
addClasses [Text
"icon"] Attr
attr)
                 (Target
-> Maybe AltText -> Maybe Width -> Maybe Height -> InlineType
A.InlineImage
                   (Text -> Target
A.Target
                      (Text
iconsdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
icontype))
                      Maybe AltText
forall a. Maybe a
Nothing Maybe Width
forall a. Maybe a
Nothing Maybe Height
forall a. Maybe a
Nothing)
   fromIcon Inline
x = Inline -> f Inline
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inline
x

addAttribution :: Maybe A.Attribution -> B.Blocks -> B.Blocks
addAttribution :: Maybe Attribution -> Blocks -> Blocks
addAttribution Maybe Attribution
Nothing Blocks
bs = Blocks
bs
addAttribution (Just (A.Attribution Text
t)) Blocks
bs = [Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$
  case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
    [B.Div Attr
attr [Block]
bls] -> [Attr -> [Block] -> Block
B.Div Attr
attr ([Block]
bls [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
attrBlock])]
    [B.BlockQuote [Block]
bls] -> [[Block] -> Block
B.BlockQuote ([Block]
bls [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
attrBlock])]
    [Block]
xs -> [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block
attrBlock]
 where
   attrBlock :: Block
attrBlock = [Inline] -> Block
Para (Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline]) -> Inlines -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text
"\x2014 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)

doMeta :: PandocMonad m => A.Meta -> m B.Meta
doMeta :: forall (m :: * -> *). PandocMonad m => Meta -> m Meta
doMeta Meta
meta = do
  Inlines
tit' <- [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines (Meta -> [Inline]
A.docTitle Meta
meta)
  Meta -> m Meta
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Meta -> m Meta) -> Meta -> m Meta
forall a b. (a -> b) -> a -> b
$
    (if Inlines
tit' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
        then Meta -> Meta
forall a. a -> a
id
        else Text -> Inlines -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"title" Inlines
tit') (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (case Meta -> [Author]
A.docAuthors Meta
meta of
       [] -> Meta -> Meta
forall a. a -> a
id
       [Author]
as -> Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"author" ((Author -> Inlines) -> [Author] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Author -> Inlines
fromAuthor [Author]
as)) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (case Meta -> Maybe Revision
A.docRevision Meta
meta of
       Maybe Revision
Nothing -> Meta -> Meta
forall a. a -> a
id
       Just (A.Revision Text
vers Maybe Text
mbdate Maybe Text
mbremark) ->
         Text -> Text -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"version" Text
vers (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (Meta -> Meta)
-> (Text -> Meta -> Meta) -> Maybe Text -> Meta -> Meta
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Meta -> Meta
forall a. a -> a
id (Text -> Text -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"date") Maybe Text
mbdate (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (Meta -> Meta)
-> (Text -> Meta -> Meta) -> Maybe Text -> Meta -> Meta
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Meta -> Meta
forall a. a -> a
id (Text -> Text -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"remark") Maybe Text
mbremark) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Meta -> [(Text, Text)] -> Meta) -> [(Text, Text)] -> Meta -> Meta
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Meta -> (Text, Text) -> Meta) -> Meta -> [(Text, Text)] -> Meta
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Meta
m (Text
k,Text
v) ->
                    -- leave out flags that are set just for processing
                    if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"sectids" Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"stem"
                       then Meta
m
                       else if Text -> Bool
T.null Text
v
                               then Text -> Bool -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
k Bool
True Meta
m
                               else Text -> Text -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
k Text
v Meta
m))
      (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Meta -> Map Text Text
A.docAttributes Meta
meta))
    (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ Meta
forall a. Monoid a => a
mempty

fromAuthor :: A.Author -> B.Inlines
fromAuthor :: Author -> Inlines
fromAuthor Author
au = Text -> Inlines
B.text (Author -> Text
A.authorName Author
au) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
  Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inlines
forall a. Monoid a => a
mempty (\Text
email ->
    Inlines
" (" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Inlines -> Inlines
B.link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
email) Text
"" (Text -> Inlines
B.str Text
email) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
")")
    (Author -> Maybe Text
A.authorEmail Author
au)

doBlocks :: PandocMonad m => [A.Block] -> m B.Blocks
doBlocks :: forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks = ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat (m [Blocks] -> m Blocks)
-> ([Block] -> m [Blocks]) -> [Block] -> m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> m Blocks) -> [Block] -> 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 -> m Blocks
forall (m :: * -> *). PandocMonad m => Block -> m Blocks
doBlock

addBlockAttr :: A.Attr -> B.Blocks -> B.Blocks
addBlockAttr :: Attr -> Blocks -> Blocks
addBlockAttr (A.Attr [Text]
_ Map Text Text
kvs') Blocks
bs =
  case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
    x :: Block
x@(B.OrderedList{}) : [Block]
xs -> -- "start" is handled in list attribs
      [(Text, Text)] -> Blocks -> Blocks
forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Text
"start" Map Text Text
kvs)
             (Block -> Blocks
forall a. a -> Many a
B.singleton Block
x) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
xs
    Block
x:[Block]
xs -> [(Text, Text)] -> Blocks -> Blocks
forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
kvs) (Block -> Blocks
forall a. a -> Many a
B.singleton Block
x)
                Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
xs
    [] -> Blocks
forall a. Monoid a => a
mempty
 where
  kvs :: Map Text Text
kvs = (Text -> Text) -> Map Text Text -> Map Text Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\Text
k -> if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"role" then Text
"class" else Text
k) Map Text Text
kvs'

addBlockTitle :: B.Inlines -> B.Blocks -> B.Blocks
addBlockTitle :: Inlines -> Blocks -> Blocks
addBlockTitle Inlines
tit' Blocks
bs =
  let tit :: [Inline]
tit = Inlines -> [Inline]
forall a. Many a -> [a]
B.toList Inlines
tit'
  in case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs of
    [B.Table Attr
attr Caption
_ [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot] ->
      Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
B.Table Attr
attr (Maybe [Inline] -> [Block] -> Caption
B.Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
B.Plain [Inline]
tit])
                     [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot
    [B.Figure Attr
attr Caption
_ [Block]
bs'] ->
      Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
B.Figure Attr
attr (Maybe [Inline] -> [Block] -> Caption
B.Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
B.Plain [Inline]
tit]) [Block]
bs'
    [B.Div Attr
attr (B.Div (Text
"",[Text
"title"],[]) [Para [Inline]
_] : [Block]
bs')] ->
      -- replace existing title, which might be e.g. "Note"
      Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
B.Div Attr
attr (Attr -> [Block] -> Block
B.Div (Text
"",[Text
"title"],[]) [[Inline] -> Block
B.Para [Inline]
tit] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs')
    [B.Div Attr
attr [Block]
bs'] -> -- put title Div inside
      Block -> Blocks
forall a. a -> Many a
B.singleton (Block -> Blocks) -> Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
B.Div Attr
attr (Attr -> [Block] -> Block
B.Div (Text
"",[Text
"title"],[]) [[Inline] -> Block
B.Para [Inline]
tit] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs')
    [Block]
_ -> Attr -> Blocks -> Blocks
B.divWith Attr
B.nullAttr (Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"title"],[]) (Inlines -> Blocks
B.para Inlines
tit') Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs)

doBlock :: PandocMonad m => A.Block -> m B.Blocks
doBlock :: forall (m :: * -> *). PandocMonad m => Block -> m Blocks
doBlock (A.Block attr :: Attr
attr@(A.Attr [Text]
ps Map Text Text
kvs) Maybe BlockTitle
mbtitle BlockType
bt) = do
  Maybe Inlines
mbtitle' <- case Maybe BlockTitle
mbtitle of
                Maybe BlockTitle
Nothing -> Maybe Inlines -> m (Maybe Inlines)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Inlines
forall a. Maybe a
Nothing
                Just (A.BlockTitle [Inline]
ils) -> Inlines -> Maybe Inlines
forall a. a -> Maybe a
Just (Inlines -> Maybe Inlines) -> m Inlines -> m (Maybe Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
  Attr -> Blocks -> Blocks
addBlockAttr Attr
attr (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Blocks)
-> (Inlines -> Blocks -> Blocks)
-> Maybe Inlines
-> Blocks
-> Blocks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Blocks -> Blocks
forall a. a -> a
id Inlines -> Blocks -> Blocks
addBlockTitle Maybe Inlines
mbtitle' (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   case BlockType
bt of
    A.Section (A.Level Int
lev) [Inline]
ils [Block]
bs -> do
      Inlines
ils' <- [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
      Blocks
bs' <- [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ (Int -> Inlines -> Blocks
B.header Int
lev Inlines
ils') Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs'
    A.DiscreteHeading (A.Level Int
lev) [Inline]
ils ->
      Int -> Inlines -> Blocks
B.header Int
lev (Inlines -> Blocks) -> m Inlines -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Paragraph [Inline]
ils -> Inlines -> Blocks
B.para (Inlines -> Blocks) -> m Inlines -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.LiteralBlock Text
t -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Blocks
B.codeBlock Text
t
    A.Listing Maybe Language
mblang [SourceLine]
lns -> do
      let fromCallout :: Callout -> Text
fromCallout (A.Callout Int
i)
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20 = FilePath -> Text
T.pack [Char
' ', Int -> Char
chr (Int
0x2460 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
            | Bool
otherwise = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
      let fromSourceLine :: SourceLine -> Text
fromSourceLine (A.SourceLine Text
t [Callout]
callouts) =
            Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((Callout -> Text) -> [Callout] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Callout -> Text
fromCallout [Callout]
callouts)
      let code :: Text
code = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SourceLine -> Text) -> [SourceLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SourceLine -> Text
fromSourceLine [SourceLine]
lns
      let classes :: [Text]
classes = case Maybe Language
mblang of
                      Maybe Language
Nothing -> []
                      Just (A.Language Text
l) -> [Text
l]
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
B.codeBlockWith (Text
"", [Text]
classes, []) Text
code
    A.IncludeListing Maybe Language
_ FilePath
_ Maybe [SourceLine]
Nothing -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
    A.IncludeListing Maybe Language
mblang FilePath
_fp (Just [SourceLine]
lns) ->
      Block -> m Blocks
forall (m :: * -> *). PandocMonad m => Block -> m Blocks
doBlock (Attr -> Maybe BlockTitle -> BlockType -> Block
A.Block Attr
forall a. Monoid a => a
mempty Maybe BlockTitle
mbtitle (Maybe Language -> [SourceLine] -> BlockType
A.Listing Maybe Language
mblang [SourceLine]
lns))
    A.ExampleBlock [Block]
bs -> Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"example"],[]) (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    A.Sidebar [Block]
bs -> Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"sidebar"],[]) (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    A.OpenBlock [Block]
bs -> Attr -> Blocks -> Blocks
B.divWith (Text
"",[],[]) (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    A.QuoteBlock Maybe Attribution
mbattrib [Block]
bs ->
      Maybe Attribution -> Blocks -> Blocks
addAttribution Maybe Attribution
mbattrib (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    A.Verse Maybe Attribution
mbattrib [Block]
bs ->
      Maybe Attribution -> Blocks -> Blocks
addAttribution Maybe Attribution
mbattrib (Blocks -> Blocks) -> (Blocks -> Blocks) -> Blocks -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> Blocks
B.blockQuote (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    -- TODO when texmath's asciimath parser works, convert:
    A.MathBlock (Just MathType
A.AsciiMath) Text
t -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.displayMath Text
t
    A.MathBlock (Just MathType
A.LaTeXMath) Text
t -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.displayMath Text
t
    A.MathBlock Maybe MathType
Nothing Text
_ ->
      PandocError -> m Blocks
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Blocks) -> PandocError -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Encountered math type Nothing"
    A.List (A.BulletList Level
_) [ListItem]
items ->
      [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m Blocks) -> [ListItem] -> 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 ListItem -> m Blocks
forall (m :: * -> *). PandocMonad m => ListItem -> m Blocks
doItem [ListItem]
items
    A.List ListType
A.CheckList [ListItem]
items ->
      [Blocks] -> Blocks
B.bulletList ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m Blocks) -> [ListItem] -> 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 ListItem -> m Blocks
forall (m :: * -> *). PandocMonad m => ListItem -> m Blocks
doItem [ListItem]
items
    A.List (A.OrderedList Level
_ Maybe Int
mbstart) [ListItem]
items -> do
      let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
1 :: Int)
                    (Maybe Int
mbstart Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"start" Map Text Text
kvs Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead))
      let getStyle :: [a] -> ListNumberStyle
getStyle [a]
xs = case [a]
xs of
                  a
"arabic":[a]
_ -> ListNumberStyle
Decimal
                  a
"decimal":[a]
_ -> ListNumberStyle
Decimal
                  a
"loweralpha":[a]
_ -> ListNumberStyle
LowerAlpha
                  a
"upperalpha":[a]
_ -> ListNumberStyle
UpperAlpha
                  a
"lowerroman":[a]
_ -> ListNumberStyle
LowerRoman
                  a
"upperroman":[a]
_ -> ListNumberStyle
UpperRoman
                  a
_:[a]
rest -> [a] -> ListNumberStyle
getStyle [a]
rest
                  [] -> ListNumberStyle
DefaultStyle
      let sty :: ListNumberStyle
sty = [Text] -> ListNumberStyle
forall {a}. (Eq a, IsString a) => [a] -> ListNumberStyle
getStyle [Text]
ps
      let delim :: ListNumberDelim
delim = ListNumberDelim
DefaultDelim
      ListAttributes -> [Blocks] -> Blocks
B.orderedListWith (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m Blocks) -> [ListItem] -> 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 ListItem -> m Blocks
forall (m :: * -> *). PandocMonad m => ListItem -> m Blocks
doItem [ListItem]
items
    A.List ListType
A.CalloutList [ListItem]
items ->
      Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"callout-list"],[]) (Blocks -> Blocks) -> ([Blocks] -> Blocks) -> [Blocks] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
B.orderedList ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m Blocks) -> [ListItem] -> 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 ListItem -> m Blocks
forall (m :: * -> *). PandocMonad m => ListItem -> m Blocks
doItem [ListItem]
items
    A.DefinitionList [([Inline], [Block])]
items
      | Text
"ordered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ps ->
          [Blocks] -> Blocks
B.orderedList ([Blocks] -> Blocks) -> m [Blocks] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (([Inline], [Block]) -> m Blocks)
-> [([Inline], [Block])] -> 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 (((Inlines, [Blocks]) -> Blocks)
-> m (Inlines, [Blocks]) -> m Blocks
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> ((Inlines, [Blocks]) -> [(Inlines, [Blocks])])
-> (Inlines, [Blocks])
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Inlines, [Blocks])
-> [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. a -> [a] -> [a]
:[])) (m (Inlines, [Blocks]) -> m Blocks)
-> (([Inline], [Block]) -> m (Inlines, [Blocks]))
-> ([Inline], [Block])
-> m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [Block]) -> m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
([Inline], [Block]) -> m (Inlines, [Blocks])
doDefListItem) [([Inline], [Block])]
items
      | Bool
otherwise -> [(Inlines, [Blocks])] -> Blocks
B.definitionList ([(Inlines, [Blocks])] -> Blocks)
-> m [(Inlines, [Blocks])] -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [Block]) -> m (Inlines, [Blocks]))
-> [([Inline], [Block])] -> 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]) -> m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
([Inline], [Block]) -> m (Inlines, [Blocks])
doDefListItem [([Inline], [Block])]
items
    A.Table [ColumnSpec]
specs Maybe [TableRow]
mbHeader [TableRow]
rows Maybe [TableRow]
mbFooter -> do
      let toAlign :: HorizAlign -> Alignment
toAlign HorizAlign
A.AlignLeft = Alignment
B.AlignLeft
          toAlign HorizAlign
A.AlignCenter = Alignment
B.AlignCenter
          toAlign HorizAlign
A.AlignRight = Alignment
B.AlignRight
      let fromCell :: TableCell -> f Cell
fromCell (A.TableCell [Block]
bs Maybe HorizAlign
mbHorizAlign Maybe VertAlign
_mbVertAlign Int
colspan Int
rowspan) =
            Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
B.Cell Attr
B.nullAttr (Alignment
-> (HorizAlign -> Alignment) -> Maybe HorizAlign -> Alignment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
B.AlignDefault HorizAlign -> Alignment
toAlign Maybe HorizAlign
mbHorizAlign)
                        (Int -> RowSpan
B.RowSpan Int
rowspan) (Int -> ColSpan
B.ColSpan Int
colspan) ([Block] -> Cell) -> (Blocks -> [Block]) -> Blocks -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blocks -> [Block]
forall a. Many a -> [a]
B.toList
                   (Blocks -> Cell) -> f Blocks -> f Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> f Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
      let fromRow :: TableRow -> f Row
fromRow (A.TableRow [TableCell]
cs) = Attr -> [Cell] -> Row
B.Row Attr
B.nullAttr ([Cell] -> Row) -> f [Cell] -> f Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableCell -> f Cell) -> [TableCell] -> f [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 TableCell -> f Cell
forall {f :: * -> *}. PandocMonad f => TableCell -> f Cell
fromCell [TableCell]
cs
      TableBody
tbody <- Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
B.TableBody Attr
B.nullAttr (Int -> RowHeadColumns
B.RowHeadColumns Int
0) [] ([Row] -> TableBody) -> m [Row] -> m TableBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TableRow -> m Row) -> [TableRow] -> m [Row]
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 TableRow -> m Row
forall {f :: * -> *}. PandocMonad f => TableRow -> f Row
fromRow [TableRow]
rows
      TableHead
thead <- Attr -> [Row] -> TableHead
B.TableHead Attr
B.nullAttr ([Row] -> TableHead) -> m [Row] -> m TableHead
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Row] -> ([TableRow] -> m [Row]) -> Maybe [TableRow] -> m [Row]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Row] -> m [Row]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((TableRow -> m Row) -> [TableRow] -> m [Row]
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 TableRow -> m Row
forall {f :: * -> *}. PandocMonad f => TableRow -> f Row
fromRow) Maybe [TableRow]
mbHeader
      TableFoot
tfoot <- Attr -> [Row] -> TableFoot
B.TableFoot Attr
B.nullAttr ([Row] -> TableFoot) -> m [Row] -> m TableFoot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Row] -> ([TableRow] -> m [Row]) -> Maybe [TableRow] -> m [Row]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Row] -> m [Row]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((TableRow -> m Row) -> [TableRow] -> m [Row]
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 TableRow -> m Row
forall {f :: * -> *}. PandocMonad f => TableRow -> f Row
fromRow) Maybe [TableRow]
mbFooter
      let totalWidth :: Int
totalWidth = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ColumnSpec -> Int) -> [ColumnSpec] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int)
-> (ColumnSpec -> Maybe Int) -> ColumnSpec -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnSpec -> Maybe Int
A.colWidth) [ColumnSpec]
specs
      let toColSpec :: ColumnSpec -> ColSpec
toColSpec ColumnSpec
spec = (Alignment
-> (HorizAlign -> Alignment) -> Maybe HorizAlign -> Alignment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Alignment
B.AlignDefault HorizAlign -> Alignment
toAlign (ColumnSpec -> Maybe HorizAlign
A.colHorizAlign ColumnSpec
spec),
                             ColWidth -> (Int -> ColWidth) -> Maybe Int -> ColWidth
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ColWidth
B.ColWidthDefault
                               (Double -> ColWidth
B.ColWidth (Double -> ColWidth) -> (Int -> Double) -> Int -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x ->
                                   Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalWidth))
                               (ColumnSpec -> Maybe Int
A.colWidth ColumnSpec
spec))
      let colspecs :: [ColSpec]
colspecs = (ColumnSpec -> ColSpec) -> [ColumnSpec] -> [ColSpec]
forall a b. (a -> b) -> [a] -> [b]
map ColumnSpec -> ColSpec
toColSpec [ColumnSpec]
specs
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
B.table (Maybe [Inline] -> [Block] -> Caption
B.Caption Maybe [Inline]
forall a. Maybe a
Nothing [Block]
forall a. Monoid a => a
mempty) -- added by addBlockTitle
                [ColSpec]
colspecs TableHead
thead [TableBody
tbody] TableFoot
tfoot
    A.BlockImage Target
target Maybe AltText
mbalt Maybe Width
mbw Maybe Height
mbh -> do
      Inlines
img' <- Inline -> m Inlines
forall (m :: * -> *). PandocMonad m => Inline -> m Inlines
doInline (Attr -> InlineType -> Inline
A.Inline Attr
forall a. Monoid a => a
mempty (Target
-> Maybe AltText -> Maybe Width -> Maybe Height -> InlineType
A.InlineImage Target
target Maybe AltText
mbalt Maybe Width
mbw Maybe Height
mbh))
      -- TODO have a global function that adds the title to caption here:
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Caption -> Blocks -> Blocks
B.figure (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [Block]
forall a. Monoid a => a
mempty) -- added by addBlockTitle
                      (Inlines -> Blocks
B.plain Inlines
img')
    -- TODO alt text?
    A.BlockAudio (A.Target Text
t) ->
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image Text
t Text
"" (Text -> Inlines
B.str Text
t)
    -- TODO alt text?
    A.BlockVideo (A.Target Text
t) ->
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
B.plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
B.image Text
t Text
"" (Text -> Inlines
B.str Text
t)
    BlockType
A.TOC -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"toc",[],[]) Blocks
forall a. Monoid a => a
mempty
    A.Admonition AdmonitionType
admonitionType [Block]
bs -> do
      let admon :: Text
admon = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ AdmonitionType -> FilePath
forall a. Show a => a -> FilePath
show AdmonitionType
admonitionType
      Blocks
bs' <- [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text -> Text
T.toLower Text
admon],[])
           (Blocks -> Blocks) -> Blocks -> Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"title"],[]) (Inlines -> Blocks
B.para (Text -> Inlines
B.str Text
admon)) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
bs'
    BlockType
A.PageBreak ->
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
B.divWith (Text
"", [Text
"page-break"], [(Text
"wrapper", Text
"1")]) Blocks
B.horizontalRule
    BlockType
A.ThematicBreak -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
B.horizontalRule
    A.Include FilePath
fp (Just [Block]
bs) ->
      Attr -> Blocks -> Blocks
B.divWith (Text
"",[Text
"included"],[(Text
"path",FilePath -> Text
T.pack FilePath
fp)]) (Blocks -> Blocks) -> m Blocks -> m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
    A.Include FilePath
fp Maybe [Block]
Nothing -> do
      LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> SourcePos -> LogMessage
CouldNotLoadIncludeFile (FilePath -> Text
T.pack FilePath
fp) (FilePath -> Int -> Int -> SourcePos
newPos FilePath
"" Int
0 Int
0)
      Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
    A.PassthroughBlock Text
t ->
         case PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
forall a. Default a => a
def{
                               readerExtensions = extensionsFromList [Ext_raw_html]
                               } Text
t) of
        Left PandocError
_ -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
B.rawBlock Text
"html" Text
t
        Right (Pandoc Meta
_ [Block]
bs) -> Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
bs

doItem :: PandocMonad m => A.ListItem -> m B.Blocks
doItem :: forall (m :: * -> *). PandocMonad m => ListItem -> m Blocks
doItem (A.ListItem Maybe CheckboxState
Nothing [Block]
bs) = [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
doItem (A.ListItem (Just CheckboxState
checkstate) [Block]
bs) = do
  Blocks
bs' <- [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
  let check :: Inline
check = case CheckboxState
checkstate of
                CheckboxState
A.Checked -> Text -> Inline
Str Text
"\9746"
                CheckboxState
A.Unchecked -> Text -> Inline
Str Text
"\9744"
  Blocks -> m Blocks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blocks -> m Blocks) -> Blocks -> m Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
B.fromList
       ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ case Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
bs' of
           (B.Para [Inline]
ils : [Block]
rest) -> [Inline] -> Block
B.Para (Inline
check Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
B.Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
           (B.Plain [Inline]
ils : [Block]
rest) -> [Inline] -> Block
B.Plain (Inline
check Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
B.Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
           [Block]
rest -> [Inline] -> Block
B.Para [Inline
check] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest

doDefListItem :: PandocMonad m
              => ([A.Inline], [A.Block]) -> m (B.Inlines , [B.Blocks])
doDefListItem :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [Block]) -> m (Inlines, [Blocks])
doDefListItem ([Inline]
lab, [Block]
bs) = do
  Inlines
lab' <- [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
lab
  Blocks
bs' <- [Block] -> m Blocks
forall (m :: * -> *). PandocMonad m => [Block] -> m Blocks
doBlocks [Block]
bs
  (Inlines, [Blocks]) -> m (Inlines, [Blocks])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines
lab', [Blocks
bs'])

doInlines :: PandocMonad m => [A.Inline] -> m B.Inlines
doInlines :: forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines = ([Inlines] -> Inlines) -> m [Inlines] -> m Inlines
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (m [Inlines] -> m Inlines)
-> ([Inline] -> m [Inlines]) -> [Inline] -> m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> m Inlines) -> [Inline] -> 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 -> m Inlines
forall (m :: * -> *). PandocMonad m => Inline -> m Inlines
doInline

doInline :: PandocMonad m => A.Inline -> m B.Inlines
doInline :: forall (m :: * -> *). PandocMonad m => Inline -> m Inlines
doInline (A.Inline (A.Attr [Text]
_ps Map Text Text
kvs') InlineType
it) = do
  let kvs :: Map Text Text
kvs = (Text -> Text) -> Map Text Text -> Map Text Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\Text
k -> if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"role" then Text
"class" else Text
k) Map Text Text
kvs'
  [(Text, Text)] -> Inlines -> Inlines
forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
kvs) (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   case InlineType
it of
    A.Str Text
t -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text Text
t
    InlineType
A.HardBreak -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Inlines
B.linebreak
    A.Bold [Inline]
ils -> Inlines -> Inlines
B.strong (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Italic [Inline]
ils -> Inlines -> Inlines
B.emph (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Monospace [Inline]
ils -> (Inline -> Inline) -> Inlines -> Inlines
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
monospaceStr (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Superscript [Inline]
ils -> Inlines -> Inlines
B.superscript (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Subscript [Inline]
ils -> Inlines -> Inlines
B.subscript (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Highlight [Inline]
ils -> Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"mark"],[]) (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.Strikethrough [Inline]
ils -> Inlines -> Inlines
B.strikeout (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.DoubleQuoted [Inline]
ils -> Inlines -> Inlines
B.doubleQuoted (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.SingleQuoted [Inline]
ils -> Inlines -> Inlines
B.singleQuoted (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    -- TODO when texmath's asciimath parser works, convert:
    A.Math (Just MathType
A.AsciiMath) Text
t -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.math Text
t
    A.Math (Just MathType
A.LaTeXMath) Text
t -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.math Text
t
    A.Math Maybe MathType
Nothing Text
_ ->
      PandocError -> m Inlines
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Inlines) -> PandocError -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Encountered math type Nothing"
    A.Icon Text
t -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"icon"],[(Text
"name",Text
t)])
                         (Text -> Inlines
B.str (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"))
    A.Button Text
t -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"button"],[])
                         (Inlines -> Inlines
B.strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"))
    A.Kbd [Text]
ts -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
B.str Text
"+") ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$
         (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"kbd"],[]) (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
B.strong (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.str) [Text]
ts
    A.Menu [Text]
ts -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"menu"],[]) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$
        Inlines -> Inlines
B.strong (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" › " [Text]
ts
    -- TODO do we need linktype?
    A.Link LinkType
_linkType (A.Target Text
t) [Inline]
ils -> Text -> Text -> Inlines -> Inlines
B.link Text
t Text
"" (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.InlineImage (A.Target Text
url) Maybe AltText
mbalt Maybe Width
mbwidth Maybe Height
mbheight -> do
      let alt :: Inlines
alt = case Maybe AltText
mbalt of
                  Just (A.AltText Text
t) -> Text -> Inlines
B.text Text
t
                  Maybe AltText
Nothing -> Inlines
forall a. Monoid a => a
mempty
          width :: [(Text, Text)]
width = case Maybe Width
mbwidth of
                  Just (A.Width Int
n) -> [(Text
"width", FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"px")]
                  Maybe Width
Nothing -> []
          height :: [(Text, Text)]
height = case Maybe Height
mbheight of
                  Just (A.Height Int
n) -> [(Text
"height", FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"px")]
                  Maybe Height
Nothing -> []
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.imageWith (Text
"",[], [(Text, Text)]
width [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
height) Text
url Text
"" Inlines
alt
    A.Footnote Maybe FootnoteId
_ [Inline]
ils -> Blocks -> Inlines
B.note (Blocks -> Inlines) -> (Inlines -> Blocks) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
B.para (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.InlineAnchor Text
t [Inline]
_ -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
t, [], []) Inlines
forall a. Monoid a => a
mempty
    A.BibliographyAnchor Text
t [Inline]
_ -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
t, [], []) Inlines
forall a. Monoid a => a
mempty
    A.CrossReference Text
t Maybe [Inline]
Nothing ->
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith (Text
"",[Text
"cross-reference"],[]) (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Text
"" (Text -> Inlines
B.str Text
t)
    A.CrossReference Text
t (Just [Inline]
ils) -> do
      Attr -> Text -> Text -> Inlines -> Inlines
B.linkWith (Text
"",[Text
"cross-reference"],[]) (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Text
"" (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.AttributeReference (A.AttributeName Text
t) -> -- if this is here, it's unresolved
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}")
    A.Span [Inline]
ils -> Attr -> Inlines -> Inlines
B.spanWith Attr
B.nullAttr (Inlines -> Inlines) -> m Inlines -> m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m Inlines
forall (m :: * -> *). PandocMonad m => [Inline] -> m Inlines
doInlines [Inline]
ils
    A.IndexEntry (A.TermInText Text
t) ->
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"index"],[(Text
"term",Text
t)]) (Text -> Inlines
B.text Text
t)
    A.IndexEntry (A.TermConcealed [Text]
ts) ->
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"index"],[(Text
"term",Text -> [Text] -> Text
T.intercalate Text
"," [Text]
ts)]) Inlines
forall a. Monoid a => a
mempty
    A.Counter Text
name CounterType
ctype Int
val ->
      Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
B.spanWith (Text
"",[Text
"counter"],[(Text
"name",Text
name)]) (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
B.str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
        case CounterType
ctype of
          CounterType
A.DecimalCounter -> Int -> Text
forall a. Show a => a -> Text
tshow Int
val
          CounterType
A.UpperAlphaCounter -> Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          CounterType
A.LowerAlphaCounter -> Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
val Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    -- Passthrough is hard to get right, because pandoc's RawInline needs
    -- a format specifier. Often in asciidoc passthrough is used as a form
    -- of escaping, so the best approach seems to be treating it as HTML
    -- and parsing it:
    A.Passthrough Text
t -> do
      case PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
forall a. Default a => a
def{
                               readerExtensions = extensionsFromList [Ext_raw_html]
                               } Text
t) of
        Left PandocError
_ -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"html" Text
t
        Right (Pandoc Meta
_ [Block]
bs) -> Inlines -> m Inlines
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines)
-> ([Block] -> [Inline]) -> [Block] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
blocksToInlines ([Block] -> Inlines) -> [Block] -> Inlines
forall a b. (a -> b) -> a -> b
$ [Block]
bs

monospaceStr :: Inline -> Inline
monospaceStr :: Inline -> Inline
monospaceStr (Str Text
t) = Attr -> Text -> Inline
Code Attr
B.nullAttr Text
t
monospaceStr Inline
x = Inline
x