{-# 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 qualified Data.List as L
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) ->
     ([Char] -> m Text)
-> ([Char] -> Int -> [Char] -> m Document)
-> [Char]
-> Text
-> m Document
forall (m :: * -> *).
Monad m =>
([Char] -> m Text)
-> ([Char] -> Int -> [Char] -> m Document)
-> [Char]
-> Text
-> m Document
A.parseDocument [Char] -> m Text
forall {f :: * -> *}. PandocMonad f => [Char] -> f Text
getIncludeFile [Char] -> Int -> [Char] -> m Document
forall {m :: * -> *} {a} {a} {a}.
(MonadError PandocError m, Show a, Show a) =>
a -> a -> [Char] -> m a
raiseError (SourcePos -> [Char]
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 :: [Char] -> f Text
getIncludeFile [Char]
fp = ByteString -> Text
UTF8.toText (ByteString -> Text) -> f ByteString -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> f ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
fp
  raiseError :: a -> a -> [Char] -> m a
raiseError a
fp a
pos [Char]
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
$ [Char] -> Text
T.pack
                            ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
msg [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
fp [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
                              [Char]
" char " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
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
<*> (Many Block -> [Block]
forall a. Many a -> [a]
B.toList (Many Block -> [Block]) -> m (Many Block) -> m [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
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
     fnmap <- m (Map Text [Inline])
forall s (m :: * -> *). MonadState s m => m s
get
     case M.lookup fnid 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 -> Many Block -> Many Block
addAttribution Maybe Attribution
Nothing Many Block
bs = Many Block
bs
addAttribution (Just (A.Attribution Text
t)) Many Block
bs = [Block] -> Many Block
forall a. [a] -> Many a
B.fromList ([Block] -> Many Block) -> [Block] -> Many Block
forall a b. (a -> b) -> a -> b
$
  case Many Block -> [Block]
forall a. Many a -> [a]
B.toList Many Block
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 (Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text (Text -> Many Inline) -> Text -> Many Inline
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
  tit' <- [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines (Meta -> [Inline]
A.docTitle Meta
meta)
  pure $
    (if tit' == mempty
        then id
        else B.setMeta "title" tit') .
    (case A.docAuthors meta of
       [] -> Meta -> Meta
forall a. a -> a
id
       [Author]
as -> Text -> [Many Inline] -> 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 -> Many Inline) -> [Author] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map Author -> Many Inline
fromAuthor [Author]
as)) .
    (case A.docRevision 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) .
    flip (L.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))
      (M.toList (A.docAttributes meta))
    $ mempty

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

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

addBlockAttr :: A.Attr -> B.Blocks -> B.Blocks
addBlockAttr :: Attr -> Many Block -> Many Block
addBlockAttr (A.Attr [Text]
_ Map Text Text
kvs') Many Block
bs =
  case Many Block -> [Block]
forall a. Many a -> [a]
B.toList Many Block
bs of
    x :: Block
x@(B.OrderedList{}) : [Block]
xs -> -- "start" is handled in list attribs
      [(Text, Text)] -> Many Block -> Many Block
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 -> Many Block
forall a. a -> Many a
B.singleton Block
x) Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> [Block] -> Many Block
forall a. [a] -> Many a
B.fromList [Block]
xs
    Block
x:[Block]
xs -> [(Text, Text)] -> Many Block -> Many Block
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 -> Many Block
forall a. a -> Many a
B.singleton Block
x)
                Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> [Block] -> Many Block
forall a. [a] -> Many a
B.fromList [Block]
xs
    [] -> Many Block
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 :: Many Inline -> Many Block -> Many Block
addBlockTitle Many Inline
tit' Many Block
bs =
  let tit :: [Inline]
tit = Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList Many Inline
tit'
  in case Many Block -> [Block]
forall a. Many a -> [a]
B.toList Many Block
bs of
    [B.Table Attr
attr Caption
_ [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot] ->
      Block -> Many Block
forall a. a -> Many a
B.singleton (Block -> Many Block) -> Block -> Many Block
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 -> Many Block
forall a. a -> Many a
B.singleton (Block -> Many Block) -> Block -> Many Block
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 -> Many Block
forall a. a -> Many a
B.singleton (Block -> Many Block) -> Block -> Many Block
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 -> Many Block
forall a. a -> Many a
B.singleton (Block -> Many Block) -> Block -> Many Block
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 -> Many Block -> Many Block
B.divWith Attr
B.nullAttr (Attr -> Many Block -> Many Block
B.divWith (Text
"",[Text
"title"],[]) (Many Inline -> Many Block
B.para Many Inline
tit') Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
bs)

doBlock :: PandocMonad m => A.Block -> m B.Blocks
doBlock :: forall (m :: * -> *). PandocMonad m => Block -> m (Many Block)
doBlock (A.Block attr :: Attr
attr@(A.Attr [Text]
ps Map Text Text
kvs) Maybe BlockTitle
mbtitle BlockType
bt) = do
  mbtitle' <- case Maybe BlockTitle
mbtitle of
                Maybe BlockTitle
Nothing -> Maybe (Many Inline) -> m (Maybe (Many Inline))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Many Inline)
forall a. Maybe a
Nothing
                Just (A.BlockTitle [Inline]
ils) -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> m (Many Inline) -> m (Maybe (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
  addBlockAttr attr . maybe id addBlockTitle mbtitle' <$>
   case bt of
    A.Section (A.Level Int
lev) [Inline]
ils [Block]
bs -> do
      ils' <- [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
      bs' <- doBlocks bs
      pure $ (B.header lev ils') <> bs'
    A.DiscreteHeading (A.Level Int
lev) [Inline]
ils ->
      Int -> Many Inline -> Many Block
B.header Int
lev (Many Inline -> Many Block) -> m (Many Inline) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Paragraph [Inline]
ils -> Many Inline -> Many Block
B.para (Many Inline -> Many Block) -> m (Many Inline) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.LiteralBlock Text
t -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Text -> Many Block
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 = [Char] -> 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]
      Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
B.codeBlockWith (Text
"", [Text]
classes, []) Text
code
    A.IncludeListing Maybe Language
_ [Char]
_ Maybe [SourceLine]
Nothing -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Block
forall a. Monoid a => a
mempty
    A.IncludeListing Maybe Language
mblang [Char]
_fp (Just [SourceLine]
lns) ->
      Block -> m (Many Block)
forall (m :: * -> *). PandocMonad m => Block -> m (Many Block)
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 -> Many Block -> Many Block
B.divWith (Text
"",[Text
"example"],[]) (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    A.Sidebar [Block]
bs -> Attr -> Many Block -> Many Block
B.divWith (Text
"",[Text
"sidebar"],[]) (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    A.OpenBlock [Block]
bs -> Attr -> Many Block -> Many Block
B.divWith (Text
"",[],[]) (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    A.QuoteBlock Maybe Attribution
mbattrib [Block]
bs ->
      Maybe Attribution -> Many Block -> Many Block
addAttribution Maybe Attribution
mbattrib (Many Block -> Many Block)
-> (Many Block -> Many Block) -> Many Block -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> Many Block
B.blockQuote (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    A.Verse Maybe Attribution
mbattrib [Block]
bs ->
      Maybe Attribution -> Many Block -> Many Block
addAttribution Maybe Attribution
mbattrib (Many Block -> Many Block)
-> (Many Block -> Many Block) -> Many Block -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> Many Block
B.blockQuote (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    -- TODO when texmath's asciimath parser works, convert:
    A.MathBlock (Just MathType
A.AsciiMath) Text
t -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.para (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.displayMath Text
t
    A.MathBlock (Just MathType
A.LaTeXMath) Text
t -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.para (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.displayMath Text
t
    A.MathBlock Maybe MathType
Nothing Text
_ ->
      PandocError -> m (Many Block)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Many Block)) -> PandocError -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Encountered math type Nothing"
    A.List (A.BulletList Level
_) [ListItem]
items ->
      [Many Block] -> Many Block
B.bulletList ([Many Block] -> Many Block) -> m [Many Block] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m (Many Block)) -> [ListItem] -> m [Many Block]
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 (Many Block)
forall (m :: * -> *). PandocMonad m => ListItem -> m (Many Block)
doItem [ListItem]
items
    A.List ListType
A.CheckList [ListItem]
items ->
      [Many Block] -> Many Block
B.bulletList ([Many Block] -> Many Block) -> m [Many Block] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m (Many Block)) -> [ListItem] -> m [Many Block]
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 (Many Block)
forall (m :: * -> *). PandocMonad m => ListItem -> m (Many Block)
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 -> [Many Block] -> Many Block
B.orderedListWith (Int
start, ListNumberStyle
sty, ListNumberDelim
delim) ([Many Block] -> Many Block) -> m [Many Block] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m (Many Block)) -> [ListItem] -> m [Many Block]
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 (Many Block)
forall (m :: * -> *). PandocMonad m => ListItem -> m (Many Block)
doItem [ListItem]
items
    A.List ListType
A.CalloutList [ListItem]
items ->
      Attr -> Many Block -> Many Block
B.divWith (Text
"",[Text
"callout-list"],[]) (Many Block -> Many Block)
-> ([Many Block] -> Many Block) -> [Many Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> Many Block
B.orderedList ([Many Block] -> Many Block) -> m [Many Block] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ListItem -> m (Many Block)) -> [ListItem] -> m [Many Block]
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 (Many Block)
forall (m :: * -> *). PandocMonad m => ListItem -> m (Many Block)
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 ->
          [Many Block] -> Many Block
B.orderedList ([Many Block] -> Many Block) -> m [Many Block] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (([Inline], [Block]) -> m (Many Block))
-> [([Inline], [Block])] -> m [Many Block]
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 (((Many Inline, [Many Block]) -> Many Block)
-> m (Many Inline, [Many Block]) -> m (Many Block)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Many Inline, [Many Block])] -> Many Block
B.definitionList ([(Many Inline, [Many Block])] -> Many Block)
-> ((Many Inline, [Many Block]) -> [(Many Inline, [Many Block])])
-> (Many Inline, [Many Block])
-> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Many Inline, [Many Block])
-> [(Many Inline, [Many Block])] -> [(Many Inline, [Many Block])]
forall a. a -> [a] -> [a]
:[])) (m (Many Inline, [Many Block]) -> m (Many Block))
-> (([Inline], [Block]) -> m (Many Inline, [Many Block]))
-> ([Inline], [Block])
-> m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline], [Block]) -> m (Many Inline, [Many Block])
forall (m :: * -> *).
PandocMonad m =>
([Inline], [Block]) -> m (Many Inline, [Many Block])
doDefListItem) [([Inline], [Block])]
items
      | Bool
otherwise -> [(Many Inline, [Many Block])] -> Many Block
B.definitionList ([(Many Inline, [Many Block])] -> Many Block)
-> m [(Many Inline, [Many Block])] -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [Block]) -> m (Many Inline, [Many Block]))
-> [([Inline], [Block])] -> m [(Many Inline, [Many Block])]
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 (Many Inline, [Many Block])
forall (m :: * -> *).
PandocMonad m =>
([Inline], [Block]) -> m (Many Inline, [Many Block])
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) -> (Many Block -> [Block]) -> Many Block -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Block -> [Block]
forall a. Many a -> [a]
B.toList
                   (Many Block -> Cell) -> f (Many Block) -> f Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> f (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
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
      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
      thead <- B.TableHead B.nullAttr <$> maybe (pure []) (mapM fromRow) mbHeader
      tfoot <- B.TableFoot B.nullAttr <$> maybe (pure []) (mapM fromRow) mbFooter
      let 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
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 = (ColumnSpec -> ColSpec) -> [ColumnSpec] -> [ColSpec]
forall a b. (a -> b) -> [a] -> [b]
map ColumnSpec -> ColSpec
toColSpec [ColumnSpec]
specs
      pure $ B.table (B.Caption Nothing mempty) -- added by addBlockTitle
                colspecs thead [tbody] tfoot
    A.BlockImage Target
target Maybe AltText
mbalt Maybe Width
mbw Maybe Height
mbh -> do
      img' <- Inline -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => Inline -> m (Many Inline)
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:
      pure $ B.figure (Caption Nothing mempty) -- added by addBlockTitle
                      (B.plain img')
    -- TODO alt text?
    A.BlockAudio (A.Target Text
t) ->
      Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.image Text
t Text
"" (Text -> Many Inline
B.str Text
t)
    -- TODO alt text?
    A.BlockVideo (A.Target Text
t) ->
      Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
B.plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
B.image Text
t Text
"" (Text -> Many Inline
B.str Text
t)
    BlockType
A.TOC -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
"toc",[],[]) Many Block
forall a. Monoid a => a
mempty
    A.Admonition AdmonitionType
admonitionType [Block]
bs -> do
      let admon :: Text
admon = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ AdmonitionType -> [Char]
forall a. Show a => a -> [Char]
show AdmonitionType
admonitionType
      bs' <- [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
      pure $ B.divWith ("",[T.toLower admon],[])
           $ B.divWith ("",["title"],[]) (B.para (B.str admon)) <> bs'
    BlockType
A.PageBreak ->
      Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
B.divWith (Text
"", [Text
"page-break"], [(Text
"wrapper", Text
"1")]) Many Block
B.horizontalRule
    BlockType
A.ThematicBreak -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Block
B.horizontalRule
    A.Include [Char]
fp (Just [Block]
bs) ->
      Attr -> Many Block -> Many Block
B.divWith (Text
"",[Text
"included"],[(Text
"path",[Char] -> Text
T.pack [Char]
fp)]) (Many Block -> Many Block) -> m (Many Block) -> m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
    A.Include [Char]
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 ([Char] -> Text
T.pack [Char]
fp) ([Char] -> Int -> Int -> SourcePos
newPos [Char]
"" Int
0 Int
0)
      Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Block
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
_ -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Block
B.rawBlock Text
"html" Text
t
        Right (Pandoc Meta
_ [Block]
bs) -> Many Block -> m (Many Block)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Block -> m (Many Block)) -> Many Block -> m (Many Block)
forall a b. (a -> b) -> a -> b
$ [Block] -> Many Block
forall a. [a] -> Many a
B.fromList [Block]
bs

doItem :: PandocMonad m => A.ListItem -> m B.Blocks
doItem :: forall (m :: * -> *). PandocMonad m => ListItem -> m (Many Block)
doItem (A.ListItem Maybe CheckboxState
Nothing [Block]
bs) = [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
doItem (A.ListItem (Just CheckboxState
checkstate) [Block]
bs) = do
  bs' <- [Block] -> m (Many Block)
forall (m :: * -> *). PandocMonad m => [Block] -> m (Many Block)
doBlocks [Block]
bs
  let check = case CheckboxState
checkstate of
                CheckboxState
A.Checked -> Text -> Inline
Str Text
"\9746"
                CheckboxState
A.Unchecked -> Text -> Inline
Str Text
"\9744"
  pure $ B.fromList
       $ case B.toList 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 (Many Inline, [Many Block])
doDefListItem ([Inline]
lab, [Block]
bs) = do
  lab' <- [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
lab
  bs' <- doBlocks bs
  pure (lab', [bs'])

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

doInline :: PandocMonad m => A.Inline -> m B.Inlines
doInline :: forall (m :: * -> *). PandocMonad m => Inline -> m (Many Inline)
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)] -> Many Inline -> Many Inline
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) (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
   case InlineType
it of
    A.Str Text
t -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text Text
t
    InlineType
A.HardBreak -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Many Inline
B.linebreak
    A.Bold [Inline]
ils -> Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Italic [Inline]
ils -> Many Inline -> Many Inline
B.emph (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Monospace [Inline]
ils -> (Inline -> Inline) -> Many Inline -> Many Inline
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
monospaceStr (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Superscript [Inline]
ils -> Many Inline -> Many Inline
B.superscript (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Subscript [Inline]
ils -> Many Inline -> Many Inline
B.subscript (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Highlight [Inline]
ils -> Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"mark"],[]) (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.Strikethrough [Inline]
ils -> Many Inline -> Many Inline
B.strikeout (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.DoubleQuoted [Inline]
ils -> Many Inline -> Many Inline
B.doubleQuoted (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.SingleQuoted [Inline]
ils -> Many Inline -> Many Inline
B.singleQuoted (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    -- TODO when texmath's asciimath parser works, convert:
    A.Math (Just MathType
A.AsciiMath) Text
t -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.math Text
t
    A.Math (Just MathType
A.LaTeXMath) Text
t -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.math Text
t
    A.Math Maybe MathType
Nothing Text
_ ->
      PandocError -> m (Many Inline)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Many Inline)) -> PandocError -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocParseError Text
"Encountered math type Nothing"
    A.Icon Text
t -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"icon"],[(Text
"name",Text
t)])
                         (Text -> Many Inline
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 -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"button"],[])
                         (Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
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 -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
L.intersperse (Text -> Many Inline
B.str Text
"+") ([Many Inline] -> [Many Inline]) -> [Many Inline] -> [Many Inline]
forall a b. (a -> b) -> a -> b
$
         (Text -> Many Inline) -> [Text] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"kbd"],[]) (Many Inline -> Many Inline)
-> (Text -> Many Inline) -> Text -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline)
-> (Text -> Many Inline) -> Text -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Many Inline
B.str) [Text]
ts
    A.Menu [Text]
ts -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"menu"],[]) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$
        Many Inline -> Many Inline
B.strong (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text (Text -> Many Inline) -> Text -> Many Inline
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 -> Many Inline -> Many Inline
B.link Text
t Text
"" (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.InlineImage (A.Target Text
url) Maybe AltText
mbalt Maybe Width
mbwidth Maybe Height
mbheight -> do
      let alt :: Many Inline
alt = case Maybe AltText
mbalt of
                  Just (A.AltText Text
t) -> Text -> Many Inline
B.text Text
t
                  Maybe AltText
Nothing -> Many Inline
forall a. Monoid a => a
mempty
          width :: [(Text, Text)]
width = case Maybe Width
mbwidth of
                  Just (A.Width Int
n) -> [(Text
"width", [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"px")]
                  Maybe Width
Nothing -> []
          height :: [(Text, Text)]
height = case Maybe Height
mbheight of
                  Just (A.Height Int
n) -> [(Text
"height", [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"px")]
                  Maybe Height
Nothing -> []
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.imageWith (Text
"",[], [(Text, Text)]
width [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
height) Text
url Text
"" Many Inline
alt
    A.Footnote Maybe FootnoteId
_ [Inline]
ils -> Many Block -> Many Inline
B.note (Many Block -> Many Inline)
-> (Many Inline -> Many Block) -> Many Inline -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Block
B.para (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.InlineAnchor Text
t [Inline]
_ -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
t, [], []) Many Inline
forall a. Monoid a => a
mempty
    A.BibliographyAnchor Text
t [Inline]
_ -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
t, [], []) Many Inline
forall a. Monoid a => a
mempty
    A.CrossReference Text
t Maybe [Inline]
Nothing ->
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Many Inline -> Many Inline
B.linkWith (Text
"",[Text
"cross-reference"],[]) (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Text
"" (Text -> Many Inline
B.str Text
t)
    A.CrossReference Text
t (Just [Inline]
ils) -> do
      Attr -> Text -> Text -> Many Inline -> Many Inline
B.linkWith (Text
"",[Text
"cross-reference"],[]) (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) Text
"" (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.AttributeReference (A.AttributeName Text
t) -> -- if this is here, it's unresolved
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
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 -> Many Inline -> Many Inline
B.spanWith Attr
B.nullAttr (Many Inline -> Many Inline) -> m (Many Inline) -> m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> m (Many Inline)
forall (m :: * -> *). PandocMonad m => [Inline] -> m (Many Inline)
doInlines [Inline]
ils
    A.IndexEntry (A.TermInText Text
t) ->
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"index"],[(Text
"term",Text
t)]) (Text -> Many Inline
B.text Text
t)
    A.IndexEntry (A.TermConcealed [Text]
ts) ->
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"index"],[(Text
"term",Text -> [Text] -> Text
T.intercalate Text
"," [Text]
ts)]) Many Inline
forall a. Monoid a => a
mempty
    A.Counter Text
name CounterType
ctype Int
val ->
      Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
B.spanWith (Text
"",[Text
"counter"],[(Text
"name",Text
name)]) (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.str (Text -> Many Inline) -> Text -> Many Inline
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
_ -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline
B.rawInline Text
"html" Text
t
        Right (Pandoc Meta
_ [Block]
bs) -> Many Inline -> m (Many Inline)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> Many Inline)
-> ([Block] -> [Inline]) -> [Block] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> [Inline]
blocksToInlines ([Block] -> Many Inline) -> [Block] -> Many Inline
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