{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
--   Module      : Text.Pandoc.Readers.XML
--   Copyright   : Copyright (C) 2025- Massimiliano Farinella and John MacFarlane
--   License     : GNU GPL, version 2 or above
--
--   Maintainer  : Massimiliano Farinella <massifrg@gmail.com>
--   Stability   : WIP
--   Portability : portable
--
-- Conversion of (Pandoc specific) xml to 'Pandoc' document.
module Text.Pandoc.Readers.XML (readXML) where

import Control.Monad (msum)
import Control.Monad.Except (throwError)
import Control.Monad.State.Strict (StateT (runStateT), modify)
import Data.Char (isSpace)
import Data.Default (Default (..))
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import qualified Data.Set as S (Set, fromList, member)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy (fromStrict)
import Data.Version (Version, makeVersion)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Options
import Text.Pandoc.Parsing (ToSources, toSources)
import Text.Pandoc.Sources (sourcesToText)
import Text.Pandoc.Version (pandocVersion)
import Text.Pandoc.XML (lookupEntity)
import Text.Pandoc.XML.Light
import Text.Pandoc.XMLFormat
import Text.Read (readMaybe)

-- TODO: use xmlPath state to give better context when an error occurs

type XMLReader m = StateT XMLReaderState m

data XMLReaderState = XMLReaderState
  { XMLReaderState -> Version
xmlApiVersion :: Version,
    XMLReaderState -> Meta
xmlMeta :: Meta,
    XMLReaderState -> [Content]
xmlContent :: [Content],
    XMLReaderState -> [Text]
xmlPath :: [Text]
  }
  deriving (Int -> XMLReaderState -> ShowS
[XMLReaderState] -> ShowS
XMLReaderState -> String
(Int -> XMLReaderState -> ShowS)
-> (XMLReaderState -> String)
-> ([XMLReaderState] -> ShowS)
-> Show XMLReaderState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XMLReaderState -> ShowS
showsPrec :: Int -> XMLReaderState -> ShowS
$cshow :: XMLReaderState -> String
show :: XMLReaderState -> String
$cshowList :: [XMLReaderState] -> ShowS
showList :: [XMLReaderState] -> ShowS
Show)

instance Default XMLReaderState where
  def :: XMLReaderState
def =
    XMLReaderState
      { xmlApiVersion :: Version
xmlApiVersion = Version
pandocVersion,
        xmlMeta :: Meta
xmlMeta = Meta
forall a. Monoid a => a
mempty,
        xmlContent :: [Content]
xmlContent = [],
        xmlPath :: [Text]
xmlPath = [Text
"root"]
      }

readXML :: (PandocMonad m, ToSources a) => ReaderOptions -> a -> m Pandoc
readXML :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readXML ReaderOptions
_ a
inp = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
  [Content]
tree <-
    (Text -> m [Content])
-> ([Content] -> m [Content])
-> Either Text [Content]
-> m [Content]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> m [Content]
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m [Content])
-> (Text -> PandocError) -> Text -> m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") [Content] -> m [Content]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [Content] -> m [Content])
-> Either Text [Content] -> m [Content]
forall a b. (a -> b) -> a -> b
$
      Text -> Either Text [Content]
parseXMLContents (Text -> Text
fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ Sources
sources)
  ([Blocks]
bs, XMLReaderState
st') <- (StateT XMLReaderState m [Blocks]
 -> XMLReaderState -> m ([Blocks], XMLReaderState))
-> XMLReaderState
-> StateT XMLReaderState m [Blocks]
-> m ([Blocks], XMLReaderState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT XMLReaderState m [Blocks]
-> XMLReaderState -> m ([Blocks], XMLReaderState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (XMLReaderState
forall a. Default a => a
def {xmlContent = tree}) (StateT XMLReaderState m [Blocks] -> m ([Blocks], XMLReaderState))
-> StateT XMLReaderState m [Blocks] -> m ([Blocks], XMLReaderState)
forall a b. (a -> b) -> a -> b
$ (Content -> StateT XMLReaderState m Blocks)
-> [Content] -> StateT XMLReaderState 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 Content -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Blocks
parseBlock [Content]
tree
  let blockList :: [Block]
blockList = Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> Blocks -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. [Many a] -> Many a
concatMany [Blocks]
bs
  Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (XMLReaderState -> Meta
xmlMeta XMLReaderState
st') [Block]
blockList

concatMany :: [Many a] -> Many a
concatMany :: forall a. [Many a] -> Many a
concatMany = Seq a -> Many a
forall a. Seq a -> Many a
Many (Seq a -> Many a) -> ([Many a] -> Seq a) -> [Many a] -> Many a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Seq a] -> Seq a
forall a. Monoid a => [a] -> a
mconcat ([Seq a] -> Seq a) -> ([Many a] -> [Seq a]) -> [Many a] -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many a -> Seq a) -> [Many a] -> [Seq a]
forall a b. (a -> b) -> [a] -> [b]
map Many a -> Seq a
forall a. Many a -> Seq a
unMany

parseBlocks :: (PandocMonad m) => [Content] -> XMLReader m Blocks
parseBlocks :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Blocks
parseBlocks [Content]
contents = [Blocks] -> Blocks
forall a. [Many a] -> Many a
concatMany ([Blocks] -> Blocks)
-> StateT XMLReaderState m [Blocks]
-> StateT XMLReaderState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT XMLReaderState m Blocks)
-> [Content] -> StateT XMLReaderState 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 Content -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Blocks
parseBlock [Content]
contents

getBlocks :: (PandocMonad m) => Element -> XMLReader m Blocks
getBlocks :: forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e = [Content] -> XMLReader m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Blocks
parseBlocks (Element -> [Content]
elContent Element
e)

elementName :: Element -> Text
elementName :: Element -> Text
elementName Element
e = QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e

attrValue :: Text -> Element -> Text
attrValue :: Text -> Element -> Text
attrValue Text
attr =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (Element -> Maybe Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element -> Maybe Text
maybeAttrValue Text
attr

maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue Text
attr Element
elt =
  (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrBy (\QName
x -> QName -> Text
qName QName
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
attr) (Element -> [Attr]
elAttribs Element
elt)

parseBlock :: (PandocMonad m) => Content -> XMLReader m Blocks
parseBlock :: forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Blocks
parseBlock (Text (CData CDataKind
CDataRaw Text
_ Maybe Line
_)) = Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty -- DOCTYPE
parseBlock (Text (CData CDataKind
_ Text
s Maybe Line
_)) =
  if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
    then Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
    else do
      PandocError -> StateT XMLReaderState m Blocks
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m Blocks)
-> PandocError -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
"non-space characters out of inline context"
parseBlock (CRef Text
x) = do
  PandocError -> StateT XMLReaderState m Blocks
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m Blocks)
-> PandocError -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" (Text
"reference \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" out of inline context")
parseBlock (Elem Element
e) = do
  let name :: Text
name = Element -> Text
elementName Element
e
   in case (Text
name) of
        Text
"Pandoc" -> StateT XMLReaderState m Blocks
parsePandoc
        Text
"?xml" -> Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
        Text
"blocks" -> Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e
        Text
"meta" ->
          let entry_els :: [Element]
entry_els = Text -> Element -> [Element]
childrenNamed Text
tgNameMetaMapEntry Element
e
           in do
                [(Text, MetaValue)]
entries <- [Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> StateT XMLReaderState m [Maybe (Text, MetaValue)]
-> StateT XMLReaderState m [(Text, MetaValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT XMLReaderState m (Maybe (Text, MetaValue)))
-> [Element] -> StateT XMLReaderState m [Maybe (Text, MetaValue)]
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 Element -> StateT XMLReaderState m (Maybe (Text, MetaValue))
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m (Maybe (Text, MetaValue))
parseMetaMapEntry [Element]
entry_els
                ((Text, MetaValue) -> StateT XMLReaderState m ())
-> [(Text, MetaValue)] -> StateT XMLReaderState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Text -> MetaValue -> StateT XMLReaderState m ())
-> (Text, MetaValue) -> StateT XMLReaderState m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> MetaValue -> StateT XMLReaderState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> XMLReader m ()
addMeta) [(Text, MetaValue)]
entries
                Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
        Text
"Para" -> Inlines -> Blocks
para (Inlines -> Blocks)
-> StateT XMLReaderState m Inlines
-> StateT XMLReaderState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Content] -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Element -> [Content]
elContent Element
e)
        Text
"Plain" -> do
          Inlines
ils <- [Content] -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Element -> [Content]
elContent Element
e)
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Blocks
forall a. a -> Many a
singleton (Block -> Blocks) -> (Inlines -> Block) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain ([Inline] -> Block) -> (Inlines -> [Inline]) -> Inlines -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inline]
forall a. Many a -> [a]
toList (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
ils
        Text
"Header" -> (Attr -> Int -> Inlines -> Blocks
headerWith Attr
attr Int
level) (Inlines -> Blocks)
-> StateT XMLReaderState m Inlines
-> StateT XMLReaderState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Content] -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Element -> [Content]
elContent Element
e)
          where
            level :: Int
level = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameLevel Element
e) Int
1
            attr :: Attr
attr = [Text] -> Attr -> Attr
filterAttrAttributes [Text
atNameLevel] (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Element -> Attr
attrFromElement Element
e
        Text
"HorizontalRule" -> Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
horizontalRule
        Text
"BlockQuote" -> do
          Blocks
contents <- Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote Blocks
contents
        Text
"Div" -> do
          Blocks
contents <- Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (Element -> Attr
attrFromElement Element
e) Blocks
contents
        Text
"BulletList" -> do
          [Blocks]
items <- Element -> XMLReader m [Blocks]
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m [Blocks]
getListItems Element
e
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
bulletList [Blocks]
items
        Text
"OrderedList" -> do
          [Blocks]
items <- Element -> XMLReader m [Blocks]
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m [Blocks]
getListItems Element
e
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ ListAttributes -> [Blocks] -> Blocks
orderedListWith (Element -> ListAttributes
getListAttributes Element
e) [Blocks]
items
        Text
"DefinitionList" -> do
          let items_contents :: [[Content]]
items_contents = (Content -> Bool) -> [Content] -> [[Content]]
getContentsOfElements (Text -> Content -> Bool
isElementNamed Text
tgNameDefListItem) (Element -> [Content]
elContent Element
e)
          [(Inlines, [Blocks])]
items <- ([Content] -> StateT XMLReaderState m (Inlines, [Blocks]))
-> [[Content]] -> StateT XMLReaderState 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 [Content] -> StateT XMLReaderState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m (Inlines, [Blocks])
parseDefinitionListItem [[Content]]
items_contents
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ [(Inlines, [Blocks])] -> Blocks
definitionList [(Inlines, [Blocks])]
items
        Text
"Figure" -> do
          let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
              (Maybe Element
maybe_caption_el, [Content]
contents) = Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
"Caption" ([Content] -> (Maybe Element, [Content]))
-> [Content] -> (Maybe Element, [Content])
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
          Caption
figure_caption <- case (Maybe Element
maybe_caption_el) of
            Just (Element
caption_el) -> [Content] -> StateT XMLReaderState m Caption
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Caption
parseCaption ([Content] -> StateT XMLReaderState m Caption)
-> [Content] -> StateT XMLReaderState m Caption
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
caption_el
            Maybe Element
Nothing -> Caption -> StateT XMLReaderState m Caption
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Caption
emptyCaption
          Blocks
blocks <- [Content] -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Blocks
parseBlocks [Content]
contents
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> Blocks -> Blocks
figureWith Attr
attr Caption
figure_caption Blocks
blocks
        Text
"CodeBlock" -> do
          let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith Attr
attr (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
        Text
"RawBlock" -> do
          let format :: Text
format = (Text -> Element -> Text
attrValue Text
atNameFormat Element
e)
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Blocks
rawBlock Text
format (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
        Text
"LineBlock" -> do
          [Inlines]
lins <- ([Content] -> StateT XMLReaderState m Inlines)
-> [[Content]] -> StateT XMLReaderState 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 [Content] -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Text -> [Content] -> [[Content]]
contentsOfChildren Text
tgNameLineItem (Element -> [Content]
elContent Element
e))
          Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Blocks
lineBlock [Inlines]
lins
        Text
"Table" -> do
          -- TODO: check unexpected items
          let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
              (Maybe Element
maybe_caption_el, [Content]
after_caption) = Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
"Caption" ([Content] -> (Maybe Element, [Content]))
-> [Content] -> (Maybe Element, [Content])
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
              children :: [Element]
children = Set Text -> [Content] -> [Element]
elementsWithNames ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text
tgNameColspecs, Text
"TableHead", Text
"TableBody", Text
"TableFoot"]) [Content]
after_caption
              is_element :: Text -> Element -> Bool
is_element Text
tag Element
el = Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Element -> Text
elementName Element
el
          Maybe [ColSpec]
colspecs <- Maybe Element -> XMLReader m (Maybe [ColSpec])
forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m (Maybe [ColSpec])
getColspecs (Maybe Element -> XMLReader m (Maybe [ColSpec]))
-> Maybe Element -> XMLReader m (Maybe [ColSpec])
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> Maybe Element
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> Element -> Bool
is_element Text
tgNameColspecs) [Element]
children
          [TableBody]
tbs <- [Element] -> XMLReader m [TableBody]
forall (m :: * -> *).
PandocMonad m =>
[Element] -> XMLReader m [TableBody]
getTableBodies ([Element] -> XMLReader m [TableBody])
-> [Element] -> XMLReader m [TableBody]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Element -> Bool
is_element Text
"TableBody") [Element]
children
          TableHead
th <- Maybe Element -> XMLReader m TableHead
forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m TableHead
getTableHead (Maybe Element -> XMLReader m TableHead)
-> Maybe Element -> XMLReader m TableHead
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> Maybe Element
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> Element -> Bool
is_element Text
"TableHead") [Element]
children
          TableFoot
tf <- Maybe Element -> XMLReader m TableFoot
forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m TableFoot
getTableFoot (Maybe Element -> XMLReader m TableFoot)
-> Maybe Element -> XMLReader m TableFoot
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> Maybe Element
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> Element -> Bool
is_element Text
"TableFoot") [Element]
children
          Caption
capt <- Maybe Element -> StateT XMLReaderState m Caption
forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m Caption
parseMaybeCaptionElement Maybe Element
maybe_caption_el
          case Maybe [ColSpec]
colspecs of
            Maybe [ColSpec]
Nothing -> Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
            Just [ColSpec]
cs -> Blocks -> StateT XMLReaderState m Blocks
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT XMLReaderState m Blocks)
-> Blocks -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> Blocks
forall a. [a] -> Many a
fromList [Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
capt [ColSpec]
cs TableHead
th [TableBody]
tbs TableFoot
tf]
        Text
_ -> do
          PandocError -> StateT XMLReaderState m Blocks
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m Blocks)
-> PandocError -> StateT XMLReaderState m Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" (Text
"unexpected element \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" in blocks context")
  where
    parsePandoc :: StateT XMLReaderState m Blocks
parsePandoc = do
      let version :: Maybe Text
version = Text -> Element -> Maybe Text
maybeAttrValue Text
atNameApiVersion Element
e
          apiversion :: Version
apiversion = case (Maybe Text
version) of
            Just (Text
v) -> [Int] -> Version
makeVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Text -> String) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
v
            Maybe Text
Nothing -> Version
pandocVersion
       in (XMLReaderState -> XMLReaderState) -> StateT XMLReaderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XMLReaderState -> XMLReaderState) -> StateT XMLReaderState m ())
-> (XMLReaderState -> XMLReaderState) -> StateT XMLReaderState m ()
forall a b. (a -> b) -> a -> b
$ \XMLReaderState
st -> XMLReaderState
st {xmlApiVersion = apiversion}
      Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e

getListItems :: (PandocMonad m) => Element -> XMLReader m [Blocks]
getListItems :: forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m [Blocks]
getListItems Element
e =
  let items_els :: [Element]
items_els = Text -> Element -> [Element]
childrenNamed Text
tgNameListItem Element
e
   in do
        (Element -> StateT XMLReaderState m Blocks)
-> [Element] -> XMLReader 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 Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks [Element]
items_els

getContentsOfElements :: (Content -> Bool) -> [Content] -> [[Content]]
getContentsOfElements :: (Content -> Bool) -> [Content] -> [[Content]]
getContentsOfElements Content -> Bool
filter_element [Content]
contents = (Content -> Maybe [Content]) -> [Content] -> [[Content]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe [Content]
element_contents ([Content] -> [[Content]]) -> [Content] -> [[Content]]
forall a b. (a -> b) -> a -> b
$ (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter Content -> Bool
filter_element [Content]
contents
  where
    element_contents :: Content -> Maybe [Content]
    element_contents :: Content -> Maybe [Content]
element_contents Content
c = case (Content
c) of
      Elem Element
e -> [Content] -> Maybe [Content]
forall a. a -> Maybe a
Just (Element -> [Content]
elContent Element
e)
      Content
_ -> Maybe [Content]
forall a. Maybe a
Nothing

strContentRecursive :: Element -> Text
strContentRecursive :: Element -> Text
strContentRecursive =
  Element -> Text
strContent
    (Element -> Text) -> (Element -> Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Element
e' -> Element
e' {elContent = map elementToStr $ elContent e'})

elementToStr :: Content -> Content
elementToStr :: Content -> Content
elementToStr (Elem Element
e') = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> Text
strContentRecursive Element
e') Maybe Line
forall a. Maybe a
Nothing
elementToStr Content
x = Content
x

textToInt :: Text -> Int -> Int
textToInt :: Text -> Int -> Int
textToInt Text
t Int
deflt =
  let safe_to_int :: Text -> Maybe Int
      safe_to_int :: Text -> Maybe Int
safe_to_int Text
s = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
   in case (Text -> Maybe Int
safe_to_int Text
t) of
        Maybe Int
Nothing -> Int
deflt
        Just (Int
n) -> Int
n

parseInline :: (PandocMonad m) => Content -> XMLReader m Inlines
parseInline :: forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Inlines
parseInline (Text (CData CDataKind
_ Text
s Maybe Line
_)) =
  Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseInline (CRef Text
ref) =
  Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$
    Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
ref) Text -> Inlines
text (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe Text
lookupEntity Text
ref
parseInline (Elem Element
e) =
  let name :: Text
name = Element -> Text
elementName Element
e
   in case (Text
name) of
        Text
"Space" ->
          let count :: Int
count = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameSpaceCount Element
e) Int
1
           in Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
forall a b. (a -> b) -> a -> b
$ Int -> Inline -> [Inline]
forall a. Int -> a -> [a]
replicate Int
count Inline
Space
        Text
"Str" -> Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inlines
forall a. [a] -> Many a
fromList [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
atNameStrContent Element
e]
        Text
"Emph" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
emph
        Text
"Strong" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
strong
        Text
"Strikeout" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
strikeout
        Text
"Subscript" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
subscript
        Text
"Superscript" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
superscript
        Text
"Underline" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
underline
        Text
"SoftBreak" -> Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
softbreak
        Text
"LineBreak" -> Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
        Text
"SmallCaps" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
smallcaps
        Text
"Quoted" -> case (Text -> Element -> Text
attrValue Text
atNameQuoteType Element
e) of
          Text
"SingleQuote" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
singleQuoted
          Text
_ -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> Inlines
doubleQuoted
        Text
"Math" -> case (Text -> Element -> Text
attrValue Text
atNameMathType Element
e) of
          Text
"DisplayMath" -> Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
displayMath (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
          Text
_ -> Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
math (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
        Text
"Span" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines ((Inlines -> Inlines) -> StateT XMLReaderState m Inlines)
-> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (Element -> Attr
attrFromElement Element
e)
        Text
"Code" -> do
          let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
          Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith Attr
attr (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
        Text
"Link" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines ((Inlines -> Inlines) -> StateT XMLReaderState m Inlines)
-> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
attr Text
url Text
title
          where
            url :: Text
url = Text -> Element -> Text
attrValue Text
atNameLinkUrl Element
e
            title :: Text
title = Text -> Element -> Text
attrValue Text
atNameTitle Element
e
            attr :: Attr
attr = [Text] -> Attr -> Attr
filterAttrAttributes [Text
atNameLinkUrl, Text
atNameTitle] (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Element -> Attr
attrFromElement Element
e
        Text
"Image" -> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
(Inlines -> b) -> StateT XMLReaderState m b
innerInlines ((Inlines -> Inlines) -> StateT XMLReaderState m Inlines)
-> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
attr Text
url Text
title
          where
            url :: Text
url = Text -> Element -> Text
attrValue Text
atNameImageUrl Element
e
            title :: Text
title = Text -> Element -> Text
attrValue Text
atNameTitle Element
e
            attr :: Attr
attr = [Text] -> Attr -> Attr
filterAttrAttributes [Text
atNameImageUrl, Text
atNameTitle] (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Element -> Attr
attrFromElement Element
e
        Text
"RawInline" -> do
          let format :: Text
format = (Text -> Element -> Text
attrValue Text
atNameFormat Element
e)
          Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
rawInline Text
format (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
        Text
"Note" -> do
          Blocks
contents <- Element -> XMLReader m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e
          Inlines -> StateT XMLReaderState m Inlines
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT XMLReaderState m Inlines)
-> Inlines -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Blocks -> Inlines
note Blocks
contents
        Text
"Cite" ->
          let (Maybe Element
maybe_citations_el, [Content]
contents) = Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
tgNameCitations ([Content] -> (Maybe Element, [Content]))
-> [Content] -> (Maybe Element, [Content])
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
           in case (Maybe Element
maybe_citations_el) of
                Just Element
citations_el -> do
                  [Citation]
citations <- [Content] -> XMLReader m [Citation]
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m [Citation]
parseCitations ([Content] -> XMLReader m [Citation])
-> [Content] -> XMLReader m [Citation]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
citations_el
                  ([Content]
-> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall {m :: * -> *} {b}.
PandocMonad m =>
[Content] -> (Inlines -> b) -> StateT XMLReaderState m b
innerInlines' [Content]
contents) ((Inlines -> Inlines) -> StateT XMLReaderState m Inlines)
-> (Inlines -> Inlines) -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ [Citation] -> Inlines -> Inlines
cite [Citation]
citations
                Maybe Element
Nothing -> [Content] -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines [Content]
contents
        Text
_ -> do
          PandocError -> StateT XMLReaderState m Inlines
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m Inlines)
-> PandocError -> StateT XMLReaderState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" (Text
"unexpected element \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" in inline context")
  where
    innerInlines' :: [Content] -> (Inlines -> b) -> StateT XMLReaderState m b
innerInlines' [Content]
contents Inlines -> b
f =
      Inlines -> b
f (Inlines -> b) -> ([Inlines] -> Inlines) -> [Inlines] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. [Many a] -> Many a
concatMany
        ([Inlines] -> b)
-> StateT XMLReaderState m [Inlines] -> StateT XMLReaderState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT XMLReaderState m Inlines)
-> [Content] -> StateT XMLReaderState 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 Content -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Inlines
parseInline [Content]
contents
    innerInlines :: (Inlines -> b) -> StateT XMLReaderState m b
innerInlines Inlines -> b
f = [Content] -> (Inlines -> b) -> StateT XMLReaderState m b
forall {m :: * -> *} {b}.
PandocMonad m =>
[Content] -> (Inlines -> b) -> StateT XMLReaderState m b
innerInlines' (Element -> [Content]
elContent Element
e) Inlines -> b
f

getInlines :: (PandocMonad m) => [Content] -> XMLReader m Inlines
getInlines :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines [Content]
contents = [Inlines] -> Inlines
forall a. [Many a] -> Many a
concatMany ([Inlines] -> Inlines)
-> StateT XMLReaderState m [Inlines]
-> StateT XMLReaderState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT XMLReaderState m Inlines)
-> [Content] -> StateT XMLReaderState 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 Content -> StateT XMLReaderState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m Inlines
parseInline [Content]
contents

getListAttributes :: Element -> ListAttributes
getListAttributes :: Element -> ListAttributes
getListAttributes Element
e = (Int
start, ListNumberStyle
style, ListNumberDelim
delim)
  where
    start :: Int
start = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameStart Element
e) Int
1
    style :: ListNumberStyle
style = case (Text -> Element -> Text
attrValue Text
atNameNumberStyle Element
e) of
      Text
"Example" -> ListNumberStyle
Example
      Text
"Decimal" -> ListNumberStyle
Decimal
      Text
"LowerRoman" -> ListNumberStyle
LowerRoman
      Text
"UpperRoman" -> ListNumberStyle
UpperRoman
      Text
"LowerAlpha" -> ListNumberStyle
LowerAlpha
      Text
"UpperAlpha" -> ListNumberStyle
UpperAlpha
      Text
_ -> ListNumberStyle
DefaultStyle
    delim :: ListNumberDelim
delim = case (Text -> Element -> Text
attrValue Text
atNameNumberDelim Element
e) of
      Text
"Period" -> ListNumberDelim
Period
      Text
"OneParen" -> ListNumberDelim
OneParen
      Text
"TwoParens" -> ListNumberDelim
TwoParens
      Text
_ -> ListNumberDelim
DefaultDelim

contentsOfChildren :: Text -> [Content] -> [[Content]]
contentsOfChildren :: Text -> [Content] -> [[Content]]
contentsOfChildren Text
tag [Content]
contents = (Content -> Maybe [Content]) -> [Content] -> [[Content]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe [Content]
childrenElementWithTag [Content]
contents
  where
    childrenElementWithTag :: Content -> Maybe [Content]
    childrenElementWithTag :: Content -> Maybe [Content]
childrenElementWithTag Content
c = case (Content
c) of
      (Elem Element
e) -> if Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Element -> Text
elementName Element
e then [Content] -> Maybe [Content]
forall a. a -> Maybe a
Just (Element -> [Content]
elContent Element
e) else Maybe [Content]
forall a. Maybe a
Nothing
      Content
_ -> Maybe [Content]
forall a. Maybe a
Nothing

alignmentFromText :: Text -> Alignment
alignmentFromText :: Text -> Alignment
alignmentFromText Text
t = case Text
t of
  Text
"AlignLeft" -> Alignment
AlignLeft
  Text
"AlignRight" -> Alignment
AlignRight
  Text
"AlignCenter" -> Alignment
AlignCenter
  Text
_ -> Alignment
AlignDefault

getColWidth :: Text -> ColWidth
getColWidth :: Text -> ColWidth
getColWidth Text
txt = case ReadS Double
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
txt) of
  [(Double
value, String
"")] -> if Double
value Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 then ColWidth
ColWidthDefault else Double -> ColWidth
ColWidth Double
value
  [(Double, String)]
_ -> ColWidth
ColWidthDefault

getColspecs :: (PandocMonad m) => Maybe Element -> XMLReader m (Maybe [ColSpec])
getColspecs :: forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m (Maybe [ColSpec])
getColspecs Maybe Element
Nothing = Maybe [ColSpec] -> StateT XMLReaderState m (Maybe [ColSpec])
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [ColSpec]
forall a. Maybe a
Nothing
getColspecs (Just Element
cs) = do
  Maybe [ColSpec] -> StateT XMLReaderState m (Maybe [ColSpec])
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ColSpec] -> StateT XMLReaderState m (Maybe [ColSpec]))
-> Maybe [ColSpec] -> StateT XMLReaderState m (Maybe [ColSpec])
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> Maybe [ColSpec]
forall a. a -> Maybe a
Just ([ColSpec] -> Maybe [ColSpec]) -> [ColSpec] -> Maybe [ColSpec]
forall a b. (a -> b) -> a -> b
$ (Element -> ColSpec) -> [Element] -> [ColSpec]
forall a b. (a -> b) -> [a] -> [b]
map Element -> ColSpec
elementToColSpec (Text -> Element -> [Element]
childrenNamed Text
"ColSpec" Element
cs)
  where
    elementToColSpec :: Element -> ColSpec
elementToColSpec Element
e = (Text -> Alignment
alignmentFromText (Text -> Alignment) -> Text -> Alignment
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
atNameAlignment Element
e, Text -> ColWidth
getColWidth (Text -> ColWidth) -> Text -> ColWidth
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
atNameColWidth Element
e)

getTableBody :: (PandocMonad m) => Element -> XMLReader m (Maybe TableBody)
getTableBody :: forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m (Maybe TableBody)
getTableBody Element
body_el = do
  let attr :: Attr
attr = [Text] -> Attr -> Attr
filterAttrAttributes [Text
atNameRowHeadColumns] (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Element -> Attr
attrFromElement Element
body_el
      bh :: [Element]
bh = Text -> Element -> [Element]
childrenNamed Text
tgNameBodyHeader Element
body_el
      bb :: [Element]
bb = Text -> Element -> [Element]
childrenNamed Text
tgNameBodyBody Element
body_el
      headcols :: Int
headcols = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameRowHeadColumns Element
body_el) Int
0
  [Row]
hrows <- [[Row]] -> [Row]
forall a. Monoid a => [a] -> a
mconcat ([[Row]] -> [Row])
-> StateT XMLReaderState m [[Row]] -> StateT XMLReaderState m [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT XMLReaderState m [Row])
-> [Element] -> StateT XMLReaderState 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 Element -> StateT XMLReaderState m [Row]
forall (m :: * -> *). PandocMonad m => Element -> XMLReader m [Row]
getRows [Element]
bh
  [Row]
brows <- [[Row]] -> [Row]
forall a. Monoid a => [a] -> a
mconcat ([[Row]] -> [Row])
-> StateT XMLReaderState m [[Row]] -> StateT XMLReaderState m [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT XMLReaderState m [Row])
-> [Element] -> StateT XMLReaderState 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 Element -> StateT XMLReaderState m [Row]
forall (m :: * -> *). PandocMonad m => Element -> XMLReader m [Row]
getRows [Element]
bb
  Maybe TableBody -> XMLReader m (Maybe TableBody)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TableBody -> XMLReader m (Maybe TableBody))
-> Maybe TableBody -> XMLReader m (Maybe TableBody)
forall a b. (a -> b) -> a -> b
$ TableBody -> Maybe TableBody
forall a. a -> Maybe a
Just (TableBody -> Maybe TableBody) -> TableBody -> Maybe TableBody
forall a b. (a -> b) -> a -> b
$ Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
attr (Int -> RowHeadColumns
RowHeadColumns Int
headcols) [Row]
hrows [Row]
brows

getTableBodies :: (PandocMonad m) => [Element] -> XMLReader m [TableBody]
getTableBodies :: forall (m :: * -> *).
PandocMonad m =>
[Element] -> XMLReader m [TableBody]
getTableBodies [Element]
body_elements = do
  [Maybe TableBody] -> [TableBody]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TableBody] -> [TableBody])
-> StateT XMLReaderState m [Maybe TableBody]
-> XMLReader m [TableBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT XMLReaderState m (Maybe TableBody))
-> [Element] -> StateT XMLReaderState m [Maybe TableBody]
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 Element -> StateT XMLReaderState m (Maybe TableBody)
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m (Maybe TableBody)
getTableBody [Element]
body_elements

getTableHead :: (PandocMonad m) => Maybe Element -> XMLReader m TableHead
getTableHead :: forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m TableHead
getTableHead Maybe Element
maybe_e = case Maybe Element
maybe_e of
  Just Element
e -> do
    let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
    [Row]
rows <- Element -> XMLReader m [Row]
forall (m :: * -> *). PandocMonad m => Element -> XMLReader m [Row]
getRows Element
e
    TableHead -> XMLReader m TableHead
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableHead -> XMLReader m TableHead)
-> TableHead -> XMLReader m TableHead
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableHead
TableHead Attr
attr [Row]
rows
  Maybe Element
Nothing -> TableHead -> XMLReader m TableHead
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableHead -> XMLReader m TableHead)
-> TableHead -> XMLReader m TableHead
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableHead
TableHead Attr
nullAttr []

getTableFoot :: (PandocMonad m) => Maybe Element -> XMLReader m TableFoot
getTableFoot :: forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m TableFoot
getTableFoot Maybe Element
maybe_e = case Maybe Element
maybe_e of
  Just Element
e -> do
    let attr :: Attr
attr = Element -> Attr
attrFromElement Element
e
    [Row]
rows <- Element -> XMLReader m [Row]
forall (m :: * -> *). PandocMonad m => Element -> XMLReader m [Row]
getRows Element
e
    TableFoot -> XMLReader m TableFoot
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableFoot -> XMLReader m TableFoot)
-> TableFoot -> XMLReader m TableFoot
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableFoot
TableFoot Attr
attr [Row]
rows
  Maybe Element
Nothing -> TableFoot -> XMLReader m TableFoot
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TableFoot -> XMLReader m TableFoot)
-> TableFoot -> XMLReader m TableFoot
forall a b. (a -> b) -> a -> b
$ Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []

getCell :: (PandocMonad m) => Element -> XMLReader m Cell
getCell :: forall (m :: * -> *). PandocMonad m => Element -> XMLReader m Cell
getCell Element
c = do
  let alignment :: Alignment
alignment = Text -> Alignment
alignmentFromText (Text -> Alignment) -> Text -> Alignment
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
atNameAlignment Element
c
      rowspan :: RowSpan
rowspan = Int -> RowSpan
RowSpan (Int -> RowSpan) -> Int -> RowSpan
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameRowspan Element
c) Int
1
      colspan :: ColSpan
colspan = Int -> ColSpan
ColSpan (Int -> ColSpan) -> Int -> ColSpan
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameColspan Element
c) Int
1
      attr :: Attr
attr = [Text] -> Attr -> Attr
filterAttrAttributes [Text
atNameAlignment, Text
atNameRowspan, Text
atNameColspan] (Attr -> Attr) -> Attr -> Attr
forall a b. (a -> b) -> a -> b
$ Element -> Attr
attrFromElement Element
c
  Blocks
blocks <- Element -> XMLReader m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
c
  Cell -> XMLReader m Cell
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> XMLReader m Cell) -> Cell -> XMLReader m Cell
forall a b. (a -> b) -> a -> b
$ Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
attr Alignment
alignment RowSpan
rowspan ColSpan
colspan (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blocks)

getRows :: (PandocMonad m) => Element -> XMLReader m [Row]
getRows :: forall (m :: * -> *). PandocMonad m => Element -> XMLReader m [Row]
getRows Element
e = (Element -> StateT XMLReaderState m Row)
-> [Element] -> StateT XMLReaderState 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 Element -> StateT XMLReaderState m Row
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT XMLReaderState m Row
getRow ([Element] -> StateT XMLReaderState m [Row])
-> [Element] -> StateT XMLReaderState m [Row]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> [Element]
childrenNamed Text
"Row" Element
e
  where
    getRow :: Element -> StateT XMLReaderState m Row
getRow Element
r = do
      [Cell]
cells <- (Element -> StateT XMLReaderState m Cell)
-> [Element] -> StateT XMLReaderState m [Cell]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT XMLReaderState m Cell
forall (m :: * -> *). PandocMonad m => Element -> XMLReader m Cell
getCell (Text -> Element -> [Element]
childrenNamed Text
"Cell" Element
r)
      Row -> StateT XMLReaderState m Row
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> StateT XMLReaderState m Row)
-> Row -> StateT XMLReaderState m Row
forall a b. (a -> b) -> a -> b
$ Attr -> [Cell] -> Row
Row (Element -> Attr
attrFromElement Element
r) [Cell]
cells

parseCitations :: (PandocMonad m) => [Content] -> XMLReader m [Citation]
parseCitations :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m [Citation]
parseCitations [Content]
contents = do
  [Maybe Citation]
maybecitations <- (Content -> StateT XMLReaderState m (Maybe Citation))
-> [Content] -> StateT XMLReaderState m [Maybe Citation]
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 Content -> StateT XMLReaderState m (Maybe Citation)
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m (Maybe Citation)
getCitation [Content]
contents
  [Citation] -> XMLReader m [Citation]
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation] -> XMLReader m [Citation])
-> [Citation] -> XMLReader m [Citation]
forall a b. (a -> b) -> a -> b
$ [Maybe Citation] -> [Citation]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Citation]
maybecitations
  where
    getCitation :: (PandocMonad m) => Content -> XMLReader m (Maybe Citation)
    getCitation :: forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m (Maybe Citation)
getCitation Content
content = case (Content
content) of
      (Elem Element
e) ->
        if QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Citation"
          then do
            Inlines
p <- Text -> Element -> XMLReader m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> XMLReader m Inlines
inlinesOfChildrenNamed Text
tgNameCitationPrefix Element
e
            Inlines
s <- Text -> Element -> XMLReader m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> XMLReader m Inlines
inlinesOfChildrenNamed Text
tgNameCitationSuffix Element
e
            Maybe Citation -> XMLReader m (Maybe Citation)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Citation -> XMLReader m (Maybe Citation))
-> Maybe Citation -> XMLReader m (Maybe Citation)
forall a b. (a -> b) -> a -> b
$
              Citation -> Maybe Citation
forall a. a -> Maybe a
Just
                ( Citation
                    { citationId :: Text
citationId = Text -> Element -> Text
attrValue Text
"id" Element
e,
                      citationPrefix :: [Inline]
citationPrefix = Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
p,
                      citationSuffix :: [Inline]
citationSuffix = Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
s,
                      citationMode :: CitationMode
citationMode = case (Text -> Element -> Text
attrValue Text
atNameCitationMode Element
e) of
                        Text
"AuthorInText" -> CitationMode
AuthorInText
                        Text
"SuppressAuthor" -> CitationMode
SuppressAuthor
                        Text
_ -> CitationMode
NormalCitation,
                      citationNoteNum :: Int
citationNoteNum = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameCitationNoteNum Element
e) Int
0,
                      citationHash :: Int
citationHash = Text -> Int -> Int
textToInt (Text -> Element -> Text
attrValue Text
atNameCitationHash Element
e) Int
0
                    }
                )
          else do
            Maybe Citation -> XMLReader m (Maybe Citation)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Citation
forall a. Maybe a
Nothing
      Content
_ -> do
        Maybe Citation -> XMLReader m (Maybe Citation)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Citation
forall a. Maybe a
Nothing
      where
        inlinesOfChildrenNamed :: Text -> Element -> XMLReader m Inlines
inlinesOfChildrenNamed Text
tag Element
e = [Content] -> XMLReader m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines ([Content] -> XMLReader m Inlines)
-> [Content] -> XMLReader m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> [Content]) -> [Element] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Element
e' -> Element -> [Content]
elContent Element
e') (Text -> Element -> [Element]
childrenNamed Text
tag Element
e)

parseMaybeCaptionElement :: (PandocMonad m) => Maybe Element -> XMLReader m Caption
parseMaybeCaptionElement :: forall (m :: * -> *).
PandocMonad m =>
Maybe Element -> XMLReader m Caption
parseMaybeCaptionElement Maybe Element
Nothing = Caption -> StateT XMLReaderState m Caption
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Caption
emptyCaption
parseMaybeCaptionElement (Just Element
e) = [Content] -> StateT XMLReaderState m Caption
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Caption
parseCaption ([Content] -> StateT XMLReaderState m Caption)
-> [Content] -> StateT XMLReaderState m Caption
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e

parseCaption :: (PandocMonad m) => [Content] -> XMLReader m Caption
parseCaption :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Caption
parseCaption [Content]
contents =
  let (Maybe Element
maybe_shortcaption_el, [Content]
caption_contents) = Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
tgNameShortCaption [Content]
contents
   in do
        Blocks
blocks <- [Content] -> XMLReader m Blocks
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Blocks
parseBlocks [Content]
caption_contents
        case (Maybe Element
maybe_shortcaption_el) of
          Just Element
shortcaption_el -> do
            Inlines
short_caption <- [Content] -> XMLReader m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Element -> [Content]
elContent Element
shortcaption_el)
            Caption -> XMLReader m Caption
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> XMLReader m Caption) -> Caption -> XMLReader m Caption
forall a b. (a -> b) -> a -> b
$ Maybe [Inline] -> Blocks -> Caption
caption ([Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just ([Inline] -> Maybe [Inline]) -> [Inline] -> Maybe [Inline]
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
short_caption) Blocks
blocks
          Maybe Element
Nothing -> Caption -> XMLReader m Caption
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Caption -> XMLReader m Caption) -> Caption -> XMLReader m Caption
forall a b. (a -> b) -> a -> b
$ Maybe [Inline] -> Blocks -> Caption
caption Maybe [Inline]
forall a. Maybe a
Nothing Blocks
blocks

parseDefinitionListItem :: (PandocMonad m) => [Content] -> XMLReader m (Inlines, [Blocks])
parseDefinitionListItem :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m (Inlines, [Blocks])
parseDefinitionListItem [Content]
contents = do
  let term_contents :: [[Content]]
term_contents = (Content -> Bool) -> [Content] -> [[Content]]
getContentsOfElements (Text -> Content -> Bool
isElementNamed Text
tgNameDefListTerm) [Content]
contents
      defs_elements :: [Element]
defs_elements = [Content] -> [Element]
elementContents ([Content] -> [Element]) -> [Content] -> [Element]
forall a b. (a -> b) -> a -> b
$ (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Content -> Bool
isElementNamed Text
tgNameDefListDef) [Content]
contents
  Inlines
term_inlines <- [Content] -> XMLReader m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines ([[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Content]]
term_contents)
  [Blocks]
defs <- (Element -> StateT XMLReaderState m Blocks)
-> [Element] -> StateT XMLReaderState 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 Element -> StateT XMLReaderState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks [Element]
defs_elements
  (Inlines, [Blocks]) -> XMLReader m (Inlines, [Blocks])
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
term_inlines, [Blocks]
defs)

elementContents :: [Content] -> [Element]
elementContents :: [Content] -> [Element]
elementContents [Content]
contents = (Content -> Maybe Element) -> [Content] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe Element
toElement [Content]
contents
  where
    toElement :: Content -> Maybe Element
    toElement :: Content -> Maybe Element
toElement (Elem Element
e) = Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e
    toElement Content
_ = Maybe Element
forall a. Maybe a
Nothing

isElementNamed :: Text -> Content -> Bool
isElementNamed :: Text -> Content -> Bool
isElementNamed Text
t Content
c = case (Content
c) of
  Elem Element
e -> Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Element -> Text
elementName Element
e
  Content
_ -> Bool
False

childrenNamed :: Text -> Element -> [Element]
childrenNamed :: Text -> Element -> [Element]
childrenNamed Text
tag Element
e = [Content] -> [Element]
elementContents ([Content] -> [Element]) -> [Content] -> [Element]
forall a b. (a -> b) -> a -> b
$ (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Content -> Bool
isElementNamed Text
tag) (Element -> [Content]
elContent Element
e)

elementsWithNames :: S.Set Text -> [Content] -> [Element]
elementsWithNames :: Set Text -> [Content] -> [Element]
elementsWithNames Set Text
tags [Content]
contents = (Content -> Maybe Element) -> [Content] -> [Element]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Content -> Maybe Element
isElementWithNameInSet [Content]
contents
  where
    isElementWithNameInSet :: Content -> Maybe Element
isElementWithNameInSet Content
c = case (Content
c) of
      Elem Element
el ->
        if (Element -> Text
elementName Element
el) Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
tags
          then Element -> Maybe Element
forall a. a -> Maybe a
Just Element
el
          else Maybe Element
forall a. Maybe a
Nothing
      Content
_ -> Maybe Element
forall a. Maybe a
Nothing

partitionFirstChildNamed :: Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed :: Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
tag [Content]
contents = case ([Content]
contents) of
  (Text (CData CDataKind
_ Text
s Maybe Line
_) : [Content]
rest) ->
    if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
      then Text -> [Content] -> (Maybe Element, [Content])
partitionFirstChildNamed Text
tag [Content]
rest
      else (Maybe Element
forall a. Maybe a
Nothing, [Content]
contents)
  (Elem Element
e : [Content]
rest) ->
    if Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Element -> Text
elementName Element
e
      then (Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e, [Content]
rest)
      else (Maybe Element
forall a. Maybe a
Nothing, [Content]
contents)
  [Content]
_ -> (Maybe Element
forall a. Maybe a
Nothing, [Content]
contents)

type PandocAttr = (Text, [Text], [(Text, Text)])

filterAttributes :: S.Set Text -> [(Text, Text)] -> [(Text, Text)]
filterAttributes :: Set Text -> [(Text, Text)] -> [(Text, Text)]
filterAttributes Set Text
to_be_removed [(Text, Text)]
a = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text, Text) -> Bool
forall {b}. (Text, b) -> Bool
keep_attr [(Text, Text)]
a
  where
    keep_attr :: (Text, b) -> Bool
keep_attr (Text
k, b
_) = Bool -> Bool
not (Text
k Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
to_be_removed)

filterAttrAttributes :: [Text] -> PandocAttr -> PandocAttr
filterAttrAttributes :: [Text] -> Attr -> Attr
filterAttrAttributes [Text]
to_be_removed (Text
idn, [Text]
classes, [(Text, Text)]
a) = (Text
idn, [Text]
classes, [(Text, Text)]
filtered)
  where
    filtered :: [(Text, Text)]
filtered = Set Text -> [(Text, Text)] -> [(Text, Text)]
filterAttributes ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
to_be_removed) [(Text, Text)]
a

attrFromElement :: Element -> PandocAttr
attrFromElement :: Element -> Attr
attrFromElement Element
e = [Text] -> Attr -> Attr
filterAttrAttributes [Text
"id", Text
"class"] (Text
idn, [Text]
classes, [(Text, Text)]
attributes)
  where
    idn :: Text
idn = Text -> Element -> Text
attrValue Text
"id" Element
e
    classes :: [Text]
classes = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"class" Element
e
    attributes :: [(Text, Text)]
attributes = (Attr -> (Text, Text)) -> [Attr] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Attr
a -> (QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Attr -> QName
attrKey Attr
a, Attr -> Text
attrVal Attr
a)) ([Attr] -> [(Text, Text)]) -> [Attr] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Element -> [Attr]
elAttribs Element
e

addMeta :: (PandocMonad m) => (ToMetaValue a) => Text -> a -> XMLReader m ()
addMeta :: forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> XMLReader m ()
addMeta Text
field a
val = (XMLReaderState -> XMLReaderState) -> StateT XMLReaderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> a -> XMLReaderState -> XMLReaderState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b.
ToMetaValue b =>
Text -> b -> XMLReaderState -> XMLReaderState
setMeta Text
field a
val)

instance HasMeta XMLReaderState where
  setMeta :: forall b.
ToMetaValue b =>
Text -> b -> XMLReaderState -> XMLReaderState
setMeta Text
field b
v XMLReaderState
s = XMLReaderState
s {xmlMeta = setMeta field v (xmlMeta s)}

  deleteMeta :: Text -> XMLReaderState -> XMLReaderState
deleteMeta Text
field XMLReaderState
s = XMLReaderState
s {xmlMeta = deleteMeta field (xmlMeta s)}

parseMetaMapEntry :: (PandocMonad m) => Element -> XMLReader m (Maybe (Text, MetaValue))
parseMetaMapEntry :: forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m (Maybe (Text, MetaValue))
parseMetaMapEntry Element
e =
  let key :: Text
key = Text -> Element -> Text
attrValue Text
atNameMetaMapEntryKey Element
e
   in case (Text
key) of
        Text
"" -> Maybe (Text, MetaValue) -> XMLReader m (Maybe (Text, MetaValue))
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
        Text
k -> do
          Maybe MetaValue
maybe_value <- [Content] -> XMLReader m (Maybe MetaValue)
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m (Maybe MetaValue)
parseMetaMapEntryContents ([Content] -> XMLReader m (Maybe MetaValue))
-> [Content] -> XMLReader m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
          case (Maybe MetaValue
maybe_value) of
            Maybe MetaValue
Nothing -> Maybe (Text, MetaValue) -> XMLReader m (Maybe (Text, MetaValue))
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
            Just MetaValue
v -> Maybe (Text, MetaValue) -> XMLReader m (Maybe (Text, MetaValue))
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, MetaValue) -> XMLReader m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> XMLReader m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
k, MetaValue
v)

parseMetaMapEntryContents :: (PandocMonad m) => [Content] -> XMLReader m (Maybe MetaValue)
parseMetaMapEntryContents :: forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m (Maybe MetaValue)
parseMetaMapEntryContents [Content]
cs = [Maybe MetaValue] -> Maybe MetaValue
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe MetaValue] -> Maybe MetaValue)
-> StateT XMLReaderState m [Maybe MetaValue]
-> StateT XMLReaderState m (Maybe MetaValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT XMLReaderState m (Maybe MetaValue))
-> [Content] -> StateT XMLReaderState m [Maybe MetaValue]
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 Content -> StateT XMLReaderState m (Maybe MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m (Maybe MetaValue)
parseMeta [Content]
cs

parseMeta :: (PandocMonad m) => Content -> XMLReader m (Maybe MetaValue)
parseMeta :: forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m (Maybe MetaValue)
parseMeta (Text (CData CDataKind
CDataRaw Text
_ Maybe Line
_)) = Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaValue
forall a. Maybe a
Nothing
parseMeta (Text (CData CDataKind
_ Text
s Maybe Line
_)) =
  if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
    then Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaValue
forall a. Maybe a
Nothing
    else do
      PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m (Maybe MetaValue))
-> PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" Text
"non-space characters out of inline context in metadata"
parseMeta (CRef Text
x) =
  PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m (Maybe MetaValue))
-> PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" (Text
"reference \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" out of inline context")
parseMeta (Elem Element
e) = do
  let name :: Text
name = Element -> Text
elementName Element
e
   in case (Text
name) of
        Text
"MetaBool" -> case (Text -> Element -> Text
attrValue Text
atNameMetaBoolValue Element
e) of
          Text
"true" -> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
True
          Text
_ -> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ Bool -> MetaValue
MetaBool Bool
False
        Text
"MetaString" -> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe MetaValue
forall a. Maybe a
Nothing
        Text
"MetaInlines" -> do
          Inlines
inlines <- [Content] -> XMLReader m Inlines
forall (m :: * -> *).
PandocMonad m =>
[Content] -> XMLReader m Inlines
getInlines (Element -> [Content]
elContent Element
e)
          Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ [Inline] -> MetaValue
MetaInlines ([Inline] -> MetaValue) -> [Inline] -> MetaValue
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inline]
forall a. Many a -> [a]
toList Inlines
inlines
        Text
"MetaBlocks" -> do
          Blocks
blocks <- Element -> XMLReader m Blocks
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m Blocks
getBlocks Element
e
          Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ [Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> [Block] -> MetaValue
forall a b. (a -> b) -> a -> b
$ Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
blocks
        Text
"MetaList" -> do
          [Maybe MetaValue]
maybe_items <- (Content -> StateT XMLReaderState m (Maybe MetaValue))
-> [Content] -> StateT XMLReaderState m [Maybe MetaValue]
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 Content -> StateT XMLReaderState m (Maybe MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Content -> XMLReader m (Maybe MetaValue)
parseMeta ([Content] -> StateT XMLReaderState m [Maybe MetaValue])
-> [Content] -> StateT XMLReaderState m [Maybe MetaValue]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e
          let items :: [MetaValue]
items = [Maybe MetaValue] -> [MetaValue]
forall a. [Maybe a] -> [a]
catMaybes [Maybe MetaValue]
maybe_items
           in -- TODO: report empty MetaList?
              Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ [MetaValue] -> MetaValue
MetaList [MetaValue]
items
        Text
"MetaMap" ->
          let entry_els :: [Element]
entry_els = Text -> Element -> [Element]
childrenNamed Text
tgNameMetaMapEntry Element
e
           in do
                [(Text, MetaValue)]
entries <- [Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> StateT XMLReaderState m [Maybe (Text, MetaValue)]
-> StateT XMLReaderState m [(Text, MetaValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT XMLReaderState m (Maybe (Text, MetaValue)))
-> [Element] -> StateT XMLReaderState m [Maybe (Text, MetaValue)]
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 Element -> StateT XMLReaderState m (Maybe (Text, MetaValue))
forall (m :: * -> *).
PandocMonad m =>
Element -> XMLReader m (Maybe (Text, MetaValue))
parseMetaMapEntry [Element]
entry_els
                if [(Text, MetaValue)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, MetaValue)]
entries
                  then
                    -- TODO: report empty MetaMap
                    Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MetaValue
forall a. Maybe a
Nothing
                  else Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a. a -> StateT XMLReaderState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue))
-> Maybe MetaValue -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ MetaValue -> Maybe MetaValue
forall a. a -> Maybe a
Just (MetaValue -> Maybe MetaValue) -> MetaValue -> Maybe MetaValue
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> MetaValue
MetaMap (Map Text MetaValue -> MetaValue)
-> Map Text MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ [(Text, MetaValue)] -> Map Text MetaValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, MetaValue)]
entries
        Text
_ -> do
          PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a. PandocError -> StateT XMLReaderState m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> StateT XMLReaderState m (Maybe MetaValue))
-> PandocError -> StateT XMLReaderState m (Maybe MetaValue)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocXMLError Text
"" (Text
"unexpected element \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" in metadata")