{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.DocBook ( readDocBook ) where
import Control.Monad.State.Strict
import Data.Char (isSpace, toUpper)
import Data.Default
import Data.Either (rights)
import Data.Foldable (asum)
import Data.Generics
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Options
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Shared (crFilter, safeRead)
import Text.TeXMath (readMathML, writeTeX)
import Text.XML.Light
type DB m = StateT DBState m
data DBState = DBState{ DBState -> Int
dbSectionLevel :: Int
, DBState -> QuoteType
dbQuoteType :: QuoteType
, DBState -> Meta
dbMeta :: Meta
, DBState -> Bool
dbBook :: Bool
, DBState -> Inlines
dbFigureTitle :: Inlines
, DBState -> [Content]
dbContent :: [Content]
} deriving Int -> DBState -> ShowS
[DBState] -> ShowS
DBState -> String
(Int -> DBState -> ShowS)
-> (DBState -> String) -> ([DBState] -> ShowS) -> Show DBState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBState] -> ShowS
$cshowList :: [DBState] -> ShowS
show :: DBState -> String
$cshow :: DBState -> String
showsPrec :: Int -> DBState -> ShowS
$cshowsPrec :: Int -> DBState -> ShowS
Show
instance Default DBState where
def :: DBState
def = DBState :: Int -> QuoteType -> Meta -> Bool -> Inlines -> [Content] -> DBState
DBState{ dbSectionLevel :: Int
dbSectionLevel = 0
, dbQuoteType :: QuoteType
dbQuoteType = QuoteType
DoubleQuote
, dbMeta :: Meta
dbMeta = Meta
forall a. Monoid a => a
mempty
, dbBook :: Bool
dbBook = Bool
False
, dbFigureTitle :: Inlines
dbFigureTitle = Inlines
forall a. Monoid a => a
mempty
, dbContent :: [Content]
dbContent = [] }
readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readDocBook :: ReaderOptions -> Text -> m Pandoc
readDocBook _ inp :: Text
inp = do
let tree :: [Content]
tree = [Content] -> [Content]
normalizeTree ([Content] -> [Content])
-> (Text -> [Content]) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML (Text -> [Content]) -> (Text -> Text) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
handleInstructions (Text -> [Content]) -> Text -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
inp
(bs :: [Blocks]
bs, st' :: DBState
st') <- (StateT DBState m [Blocks] -> DBState -> m ([Blocks], DBState))
-> DBState -> StateT DBState m [Blocks] -> m ([Blocks], DBState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT DBState m [Blocks] -> DBState -> m ([Blocks], DBState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DBState
forall a. Default a => a
def{ dbContent :: [Content]
dbContent = [Content]
tree }) (StateT DBState m [Blocks] -> m ([Blocks], DBState))
-> StateT DBState m [Blocks] -> m ([Blocks], DBState)
forall a b. (a -> b) -> a -> b
$ (Content -> StateT DBState m Blocks)
-> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock [Content]
tree
Pandoc -> m Pandoc
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 (DBState -> Meta
dbMeta DBState
st') (Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> [Block]) -> [Blocks] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks]
bs)
handleInstructions :: Text -> Text
handleInstructions :: Text -> Text
handleInstructions = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
handleInstructions' ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
handleInstructions' :: String -> String
handleInstructions' :: ShowS
handleInstructions' ('<':'?':'a':'s':'c':'i':'i':'d':'o':'c':'-':'b':'r':'?':'>':xs :: String
xs) = '<'Char -> ShowS
forall a. a -> [a] -> [a]
:'b'Char -> ShowS
forall a. a -> [a] -> [a]
:'r'Char -> ShowS
forall a. a -> [a] -> [a]
:'/'Char -> ShowS
forall a. a -> [a] -> [a]
:'>'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
handleInstructions' String
xs
handleInstructions' xs :: String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='<') String
xs of
(ys :: String
ys, []) -> String
ys
([], '<':zs :: String
zs) -> '<' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
handleInstructions' String
zs
(ys :: String
ys, zs :: String
zs) -> String
ys String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
handleInstructions' String
zs
getFigure :: PandocMonad m => Element -> DB m Blocks
getFigure :: Element -> DB m Blocks
getFigure e :: Element
e = do
Inlines
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e of
Just t :: Element
t -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
Nothing -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbFigureTitle :: Inlines
dbFigureTitle = Inlines
tit }
Blocks
res <- Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbFigureTitle :: Inlines
dbFigureTitle = Inlines
forall a. Monoid a => a
mempty }
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res
normalizeTree :: [Content] -> [Content]
normalizeTree :: [Content] -> [Content]
normalizeTree = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([Content] -> [Content]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [Content] -> [Content]
go)
where go :: [Content] -> [Content]
go :: [Content] -> [Content]
go (Text (CData CDataRaw _ _):xs :: [Content]
xs) = [Content]
xs
go (Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):Text (CData CDataText s2 :: String
s2 _):xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):CRef r :: String
r:xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (CRef r :: String
r:Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s1) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (CRef r1 :: String
r1:CRef r2 :: String
r2:xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r2) Maybe Line
forall a. Maybe a
Nothing)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go xs :: [Content]
xs = [Content]
xs
convertEntity :: String -> String
convertEntity :: ShowS
convertEntity e :: String
e = String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
e) (String -> Maybe String
lookupEntity String
e)
attrValue :: String -> Element -> Text
attrValue :: String -> Element -> Text
attrValue attr :: String
attr elt :: Element
elt =
Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" String -> Text
T.pack ((QName -> Bool) -> [Attr] -> Maybe String
lookupAttrBy (\x :: QName
x -> QName -> String
qName QName
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
attr) (Element -> [Attr]
elAttribs Element
elt))
named :: Text -> Element -> Bool
named :: Text -> Element -> Bool
named s :: Text
s e :: Element
e = QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> String
T.unpack Text
s
addMetadataFromElement :: PandocMonad m => Element -> DB m Blocks
addMetadataFromElement :: Element -> DB m Blocks
addMetadataFromElement e :: Element
e = do
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e of
Nothing -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just z :: Element
z -> do
Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
z DB m Inlines
-> (Inlines -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta "title"
Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "subtitle" Element
z
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "authorgroup") Element
e of
Nothing -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just z :: Element
z -> Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "author" Element
z
Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "subtitle" Element
e
Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "author" Element
e
Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "date" Element
e
Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField "release" Element
e
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
where addMetaField :: Text -> Element -> StateT DBState m ()
addMetaField fieldname :: Text
fieldname elt :: Element
elt =
case (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
fieldname) Element
elt of
[] -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[z :: Element
z] -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
z DB m Inlines
-> (Inlines -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname
zs :: [Element]
zs -> (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
zs StateT DBState m [Inlines]
-> ([Inlines] -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Inlines] -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname
addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> DB m ()
addMeta :: Text -> a -> DB m ()
addMeta field :: Text
field val :: a
val = (DBState -> DBState) -> DB m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> a -> DBState -> DBState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field a
val)
instance HasMeta DBState where
setMeta :: Text -> b -> DBState -> DBState
setMeta field :: Text
field v :: b
v s :: DBState
s = DBState
s {dbMeta :: Meta
dbMeta = Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
v (DBState -> Meta
dbMeta DBState
s)}
deleteMeta :: Text -> DBState -> DBState
deleteMeta field :: Text
field s :: DBState
s = DBState
s {dbMeta :: Meta
dbMeta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (DBState -> Meta
dbMeta DBState
s)}
isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem e :: Element
e) = QName -> String
qName (Element -> QName
elName Element
e) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
blockTags
isBlockElement _ = Bool
False
blockTags :: [String]
blockTags :: [String]
blockTags = ["toc","index","para","formalpara","simpara",
"ackno","epigraph","blockquote","bibliography","bibliodiv",
"biblioentry","glossee","glosseealso","glossary",
"glossdiv","glosslist","chapter","appendix","preface",
"bridgehead","sect1","sect2","sect3","sect4","sect5","section",
"refsect1","refsect2","refsect3","refsection", "qandadiv",
"question","answer","abstract","itemizedlist","orderedlist",
"variablelist","article","book","table","informaltable",
"informalexample", "linegroup",
"screen","programlisting","example","calloutlist"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
admonitionTags
admonitionTags :: [String]
admonitionTags :: [String]
admonitionTags = ["important","caution","note","tip","warning"]
trimNl :: Text -> Text
trimNl :: Text -> Text
trimNl = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n')
addToStart :: Inlines -> Blocks -> Blocks
addToStart :: Inlines -> Blocks -> Blocks
addToStart toadd :: Inlines
toadd bs :: Blocks
bs =
case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs of
(Para xs :: [Inline]
xs : rest :: [Block]
rest) -> Inlines -> Blocks
para (Inlines
toadd Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Inlines
forall a. [a] -> Many a
fromList [Inline]
xs) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Block] -> Blocks
forall a. [a] -> Many a
fromList [Block]
rest
_ -> Blocks
bs
getMediaobject :: PandocMonad m => Element -> DB m Inlines
getMediaobject :: Element -> DB m Inlines
getMediaobject e :: Element
e = do
(imageUrl :: Text
imageUrl, attr :: Attr
attr) <-
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "imageobject") Element
e of
Nothing -> (Text, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
Just z :: Element
z -> case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "imagedata") Element
z of
Nothing -> (Text, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
Just i :: Element
i -> let atVal :: String -> Text
atVal a :: String
a = String -> Element -> Text
attrValue String
a Element
i
w :: [(Text, Text)]
w = case String -> Text
atVal "width" of
"" -> []
d :: Text
d -> [("width", Text
d)]
h :: [(Text, Text)]
h = case String -> Text
atVal "depth" of
"" -> []
d :: Text
d -> [("height", Text
d)]
atr :: Attr
atr = (String -> Text
atVal "id", Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
atVal "role", [(Text, Text)]
w [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
h)
in (Text, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
atVal "fileref", Attr
atr)
let getCaption :: Element -> StateT DBState m Inlines
getCaption el :: Element
el = case (Element -> Bool) -> Element -> Maybe Element
filterChild (\x :: Element
x -> Text -> Element -> Bool
named "caption" Element
x
Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "textobject" Element
x
Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "alt" Element
x) Element
el of
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Just z :: Element
z -> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> StateT DBState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
z)
Inlines
figTitle <- (DBState -> Inlines) -> DB m Inlines
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Inlines
dbFigureTitle
let (caption :: DB m Inlines
caption, title :: Text
title) = if Inlines -> Bool
forall a. Many a -> Bool
isNull Inlines
figTitle
then (Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getCaption Element
e, "")
else (Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
figTitle, "fig:")
(Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
attr Text
imageUrl Text
title) DB m Inlines
caption
getBlocks :: PandocMonad m => Element -> DB m Blocks
getBlocks :: Element -> DB m Blocks
getBlocks e :: Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> DB m Blocks) -> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
parseBlock :: PandocMonad m => Content -> DB m Blocks
parseBlock :: Content -> DB m Blocks
parseBlock (Text (CData CDataRaw _ _)) = Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseBlock (Text (CData _ s :: String
s _)) = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s
then Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseBlock (CRef x :: String
x) = Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
parseBlock (Elem e :: Element
e) =
case QName -> String
qName (Element -> QName
elName Element
e) of
"toc" -> DB m Blocks
skip
"index" -> DB m Blocks
skip
"para" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"formalpara" -> do
Blocks
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e of
Just t :: Element
t -> (Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
strong (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str ".")) (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
Nothing -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
(Blocks
tit Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>) (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"simpara" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"ackno" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"epigraph" -> DB m Blocks
parseBlockquote
"blockquote" -> DB m Blocks
parseBlockquote
"attribution" -> DB m Blocks
skip
"titleabbrev" -> DB m Blocks
skip
"authorinitials" -> DB m Blocks
skip
"bibliography" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 0
"bibliodiv" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 1
"biblioentry" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"bibliomixed" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"equation" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Inlines) -> StateT DBState m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
"informalequation" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Inlines) -> StateT DBState m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
"glosssee" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ils :: Inlines
ils -> Text -> Inlines
text "See " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str ".")
(Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
"glossseealso" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ils :: Inlines
ils -> Text -> Inlines
text "See also " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str ".")
(Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
"glossary" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 0
"glossdiv" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "glossentry") Element
e)
"glosslist" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "glossentry") Element
e)
"chapter" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
True}) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 0
"appendix" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 0
"preface" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 0
"bridgehead" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
strong (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
"sect1" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 1
"sect2" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 2
"sect3" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 3
"sect4" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 4
"sect5" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 5
"section" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
"refsect1" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 1
"refsect2" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 2
"refsect3" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect 3
"refsection" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
l :: String
l | String
l String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
admonitionTags -> Text -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT DBState m Blocks
parseAdmonition (Text -> DB m Blocks) -> Text -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l
"area" -> DB m Blocks
skip
"areaset" -> DB m Blocks
skip
"areaspec" -> DB m Blocks
skip
"qandadiv" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
"question" -> Inlines -> Blocks -> Blocks
addToStart (Inlines -> Inlines
strong (Text -> Inlines
str "Q:") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str " ") (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"answer" -> Inlines -> Blocks -> Blocks
addToStart (Inlines -> Inlines
strong (Text -> Inlines
str "A:") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str " ") (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"abstract" -> Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"calloutlist" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
callouts
"itemizedlist" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
listitems
"orderedlist" -> do
let listStyle :: ListNumberStyle
listStyle = case String -> Element -> Text
attrValue "numeration" Element
e of
"arabic" -> ListNumberStyle
Decimal
"loweralpha" -> ListNumberStyle
LowerAlpha
"upperalpha" -> ListNumberStyle
UpperAlpha
"lowerroman" -> ListNumberStyle
LowerRoman
"upperroman" -> ListNumberStyle
UpperRoman
_ -> ListNumberStyle
Decimal
let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
(String -> Element -> Text
attrValue "override" (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named "listitem") Element
e)
Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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
ListAttributes -> [Blocks] -> Blocks
orderedListWith (Int
start,ListNumberStyle
listStyle,ListNumberDelim
DefaultDelim)
([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
listitems
"variablelist" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [(Inlines, [Blocks])]
deflistitems
"figure" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getFigure Element
e
"mediaobject" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getMediaobject Element
e
"caption" -> DB m Blocks
skip
"info" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
"articleinfo" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
"sectioninfo" -> DB m Blocks
skip
"refsectioninfo" -> DB m Blocks
skip
"refsect1info" -> DB m Blocks
skip
"refsect2info" -> DB m Blocks
skip
"refsect3info" -> DB m Blocks
skip
"sect1info" -> DB m Blocks
skip
"sect2info" -> DB m Blocks
skip
"sect3info" -> DB m Blocks
skip
"sect4info" -> DB m Blocks
skip
"sect5info" -> DB m Blocks
skip
"chapterinfo" -> DB m Blocks
skip
"glossaryinfo" -> DB m Blocks
skip
"appendixinfo" -> DB m Blocks
skip
"bookinfo" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
"article" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
False }) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"book" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
True }) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"table" -> DB m Blocks
parseTable
"informaltable" -> DB m Blocks
parseTable
"informalexample" -> Attr -> Blocks -> Blocks
divWith ("", ["informalexample"], []) (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
"linegroup" -> [Inlines] -> Blocks
lineBlock ([Inlines] -> Blocks) -> StateT DBState m [Inlines] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Inlines]
lineItems
"literallayout" -> DB m Blocks
codeBlockWithLang
"screen" -> DB m Blocks
codeBlockWithLang
"programlisting" -> DB m Blocks
codeBlockWithLang
"?xml" -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
"title" -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
"subtitle" -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
_ -> DB m Blocks
skip DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
where skip :: DB m Blocks
skip = do
m () -> StateT DBState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT DBState m ()) -> m () -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
e)
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseMixed :: (Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed container :: Inlines -> Blocks
container conts :: [Content]
conts = do
let (ils :: [Content]
ils,rest :: [Content]
rest) = (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Content -> Bool
isBlockElement [Content]
conts
Inlines
ils' <- (Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat) ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> StateT DBState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline [Content]
ils
let p :: Blocks
p = if Inlines
ils' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Blocks
forall a. Monoid a => a
mempty else Inlines -> Blocks
container Inlines
ils'
case [Content]
rest of
[] -> Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
p
(r :: Content
r:rs :: [Content]
rs) -> do
Blocks
b <- Content -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock Content
r
Blocks
x <- (Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
container [Content]
rs
Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT DBState m Blocks)
-> Blocks -> StateT DBState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
p Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
x
codeBlockWithLang :: DB m Blocks
codeBlockWithLang = do
let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue "language" Element
e of
"" -> []
x :: Text
x -> [Text
x]
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (String -> Element -> Text
attrValue "id" Element
e, [Text]
classes', [])
(Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContentRecursive Element
e
parseBlockquote :: DB m Blocks
parseBlockquote = do
Blocks
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "attribution") Element
e of
Nothing -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Just z :: Element
z -> (Inlines -> Blocks
para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str "— " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat)
([Inlines] -> Blocks) -> StateT DBState m [Inlines] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
z)
Blocks
contents <- Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks
contents Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
attrib)
listitems :: StateT DBState m [Blocks]
listitems = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks ([Element] -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "listitem") Element
e
callouts :: StateT DBState m [Blocks]
callouts = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks ([Element] -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "callout") Element
e
deflistitems :: StateT DBState m [(Inlines, [Blocks])]
deflistitems = (Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseVarListEntry ([Element] -> StateT DBState m [(Inlines, [Blocks])])
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren
(Text -> Element -> Bool
named "varlistentry") Element
e
parseVarListEntry :: Element -> StateT DBState m (Inlines, [Blocks])
parseVarListEntry e' :: Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "term") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "listitem") Element
e'
[Inlines]
terms' <- (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
terms
[Blocks]
items' <- (Element -> StateT DBState m Blocks)
-> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks [Element]
items
(Inlines, [Blocks]) -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str "; ") [Inlines]
terms', [Blocks]
items')
parseGlossEntry :: Element -> StateT DBState m (Inlines, [Blocks])
parseGlossEntry e' :: Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "glossterm") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "glossdef") Element
e'
[Inlines]
terms' <- (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
terms
[Blocks]
items' <- (Element -> StateT DBState m Blocks)
-> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks [Element]
items
(Inlines, [Blocks]) -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str "; ") [Inlines]
terms', [Blocks]
items')
parseTable :: DB m Blocks
parseTable = do
let isCaption :: Element -> Bool
isCaption x :: Element
x = Text -> Element -> Bool
named "title" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "caption" Element
x
Inlines
caption <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
Just t :: Element
t -> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
let e' :: Element
e' = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "tgroup") Element
e
let isColspec :: Element -> Bool
isColspec x :: Element
x = Text -> Element -> Bool
named "colspec" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "col" Element
x
let colspecs :: [Element]
colspecs = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "colgroup") Element
e' of
Just c :: Element
c -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
c
_ -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
e'
let isRow :: Element -> Bool
isRow x :: Element
x = Text -> Element -> Bool
named "row" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "tr" Element
x
[Blocks]
headrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "thead") Element
e' of
Just h :: Element
h -> case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isRow Element
h of
Just x :: Element
x -> Element -> StateT DBState m [Blocks]
parseRow Element
x
Nothing -> [Blocks] -> StateT DBState m [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Nothing -> [Blocks] -> StateT DBState m [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[[Blocks]]
bodyrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "tbody") Element
e' of
Just b :: Element
b -> (Element -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m [Blocks]
parseRow
([Element] -> StateT DBState m [[Blocks]])
-> [Element] -> StateT DBState m [[Blocks]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
b
Nothing -> (Element -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m [Blocks]
parseRow
([Element] -> StateT DBState m [[Blocks]])
-> [Element] -> StateT DBState m [[Blocks]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
e'
let toAlignment :: Element -> Alignment
toAlignment c :: Element
c = case QName -> Element -> Maybe String
findAttr (String -> QName
unqual "align") Element
c of
Just "left" -> Alignment
AlignLeft
Just "right" -> Alignment
AlignRight
Just "center" -> Alignment
AlignCenter
_ -> Alignment
AlignDefault
let toWidth :: Element -> Double
toWidth c :: Element
c = case QName -> Element -> Maybe String
findAttr (String -> QName
unqual "colwidth") Element
c of
Just w :: String
w -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0
(Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ "0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter (\x :: Char
x ->
(Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9')
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') (String -> Text
T.pack String
w)
Nothing -> 0 :: Double
let numrows :: Int
numrows = case [[Blocks]]
bodyrows of
[] -> 0
xs :: [[Blocks]]
xs -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Int) -> [[Blocks]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Blocks]]
xs
let aligns :: [Alignment]
aligns = case [Element]
colspecs of
[] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
cs :: [Element]
cs -> (Element -> Alignment) -> [Element] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
let widths :: [Double]
widths = case [Element]
colspecs of
[] -> Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
numrows 0
cs :: [Element]
cs -> let ws :: [Double]
ws = (Element -> Double) -> [Element] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Double
toWidth [Element]
cs
tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws
in if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0) [Double]
ws
then (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) [Double]
ws
else Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
numrows 0
let headrows' :: [Blocks]
headrows' = if [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
headrows
then Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate Int
numrows Blocks
forall a. Monoid a => a
mempty
else [Blocks]
headrows
Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
-> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
table Inlines
caption ([Alignment] -> [Double] -> [(Alignment, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [Double]
widths)
[Blocks]
headrows' [[Blocks]]
bodyrows
isEntry :: Element -> Bool
isEntry x :: Element
x = Text -> Element -> Bool
named "entry" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "td" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "th" Element
x
parseRow :: Element -> StateT DBState m [Blocks]
parseRow = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
parseMixed Inlines -> Blocks
plain ([Content] -> DB m Blocks)
-> (Element -> [Content]) -> Element -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) ([Element] -> StateT DBState m [Blocks])
-> (Element -> [Element]) -> Element -> StateT DBState m [Blocks]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry
sect :: Int -> StateT DBState m Blocks
sect n :: Int
n = do Bool
isbook <- (DBState -> Bool) -> StateT DBState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Bool
dbBook
let n' :: Int
n' = if Bool
isbook Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 else Int
n
Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e Maybe Element -> Maybe Element -> Maybe Element
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "info") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title")) of
Just t :: Element
t -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
Nothing -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbSectionLevel :: Int
dbSectionLevel = Int
n }
Blocks
b <- Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
let ident :: Text
ident = String -> Element -> Text
attrValue "id" Element
e
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbSectionLevel :: Int
dbSectionLevel = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 }
Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT DBState m Blocks)
-> Blocks -> StateT DBState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
headerWith (Text
ident,[],[]) Int
n' Inlines
headerText Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b
lineItems :: StateT DBState m [Inlines]
lineItems = (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "line") Element
e
parseAdmonition :: Text -> StateT DBState m Blocks
parseAdmonition label :: Text
label = do
Blocks
title <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e of
Just t :: Element
t -> Attr -> Blocks -> Blocks
divWith ("", ["title"], []) (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
plain (Inlines -> Blocks)
-> StateT DBState m Inlines -> StateT DBState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
Nothing -> Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Blocks
b <- Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT DBState m Blocks)
-> Blocks -> StateT DBState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue "id" Element
e,[Text
label],[]) (Blocks
title Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b)
getInlines :: PandocMonad m => Element -> DB m Inlines
getInlines :: Element -> DB m Inlines
getInlines e' :: Element
e' = (Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat) ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e')
strContentRecursive :: Element -> String
strContentRecursive :: Element -> String
strContentRecursive = Element -> String
strContent (Element -> String) -> (Element -> Element) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\e' :: Element
e' -> Element
e'{ elContent :: [Content]
elContent = (Content -> Content) -> [Content] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Content
elementToStr ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e' })
elementToStr :: Content -> Content
elementToStr :: Content -> Content
elementToStr (Elem e' :: Element
e') = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> String
strContentRecursive Element
e') Maybe Line
forall a. Maybe a
Nothing
elementToStr x :: Content
x = Content
x
parseInline :: PandocMonad m => Content -> DB m Inlines
parseInline :: Content -> DB m Inlines
parseInline (Text (CData _ s :: String
s _)) = Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseInline (CRef ref :: String
ref) =
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
ref) String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
lookupEntity String
ref
parseInline (Elem e :: Element
e) =
case QName -> String
qName (Element -> QName
elName Element
e) of
"equation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
"informalequation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
"inlineequation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
math
"subscript" -> Inlines -> Inlines
subscript (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"superscript" -> Inlines -> Inlines
superscript (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"inlinemediaobject" -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getMediaobject Element
e
"quote" -> do
QuoteType
qt <- (DBState -> QuoteType) -> StateT DBState m QuoteType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> QuoteType
dbQuoteType
let qt' :: QuoteType
qt' = if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbQuoteType :: QuoteType
dbQuoteType = QuoteType
qt' }
Inlines
contents <- DB m Inlines
innerInlines
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \st :: DBState
st -> DBState
st{ dbQuoteType :: QuoteType
dbQuoteType = QuoteType
qt }
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote
then Inlines -> Inlines
singleQuoted Inlines
contents
else Inlines -> Inlines
doubleQuoted Inlines
contents
"simplelist" -> DB m Inlines
simpleList
"segmentedlist" -> DB m Inlines
segmentedList
"classname" -> DB m Inlines
codeWithLang
"code" -> DB m Inlines
codeWithLang
"filename" -> DB m Inlines
codeWithLang
"literal" -> DB m Inlines
codeWithLang
"computeroutput" -> DB m Inlines
codeWithLang
"prompt" -> DB m Inlines
codeWithLang
"parameter" -> DB m Inlines
codeWithLang
"option" -> DB m Inlines
codeWithLang
"optional" -> do Inlines
x <- Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str "[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str "]"
"markup" -> DB m Inlines
codeWithLang
"wordasword" -> Inlines -> Inlines
emph (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"command" -> DB m Inlines
codeWithLang
"varname" -> DB m Inlines
codeWithLang
"function" -> DB m Inlines
codeWithLang
"type" -> DB m Inlines
codeWithLang
"symbol" -> DB m Inlines
codeWithLang
"constant" -> DB m Inlines
codeWithLang
"userinput" -> DB m Inlines
codeWithLang
"varargs" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code "(...)"
"keycap" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e)
"keycombo" -> [Inlines] -> Inlines
keycombo ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e)
"menuchoice" -> [Inlines] -> Inlines
menuchoice ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (
(Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter Content -> Bool
isGuiMenu ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e)
"xref" -> do
[Content]
content <- DBState -> [Content]
dbContent (DBState -> [Content])
-> StateT DBState m DBState -> StateT DBState m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m DBState
forall s (m :: * -> *). MonadState s m => m s
get
let linkend :: Text
linkend = String -> Element -> Text
attrValue "linkend" Element
e
let title :: Text
title = case String -> Element -> Text
attrValue "endterm" Element
e of
"" -> Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "???" Element -> Text
xrefTitleByElem
(Text -> [Content] -> Maybe Element
findElementById Text
linkend [Content]
content)
endterm :: Text
endterm -> Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "???" (String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent)
(Text -> [Content] -> Maybe Element
findElementById Text
endterm [Content]
content)
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
linkend) "" (Text -> Inlines
text Text
title)
"email" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link ("mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Element -> String
strContent Element
e)) ""
(Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
"uri" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e) "" (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
"ulink" -> Text -> Text -> Inlines -> Inlines
link (String -> Element -> Text
attrValue "url" Element
e) "" (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"link" -> do
Inlines
ils <- DB m Inlines
innerInlines
let href :: Text
href = case QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName "href" (String -> Maybe String
forall a. a -> Maybe a
Just "http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e of
Just h :: String
h -> String -> Text
T.pack String
h
_ -> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Element -> Text
attrValue "linkend" Element
e
let ils' :: Inlines
ils' = if Inlines
ils Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Text -> Inlines
str Text
href else Inlines
ils
let attr :: (Text, [Text], [a])
attr = (String -> Element -> Text
attrValue "id" Element
e, Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Element -> Text
attrValue "role" Element
e, [])
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall a. (Text, [Text], [a])
attr Text
href "" Inlines
ils'
"foreignphrase" -> Inlines -> Inlines
emph (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"emphasis" -> case String -> Element -> Text
attrValue "role" Element
e of
"bold" -> Inlines -> Inlines
strong (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"strong" -> Inlines -> Inlines
strong (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"strikethrough" -> Inlines -> Inlines
strikeout (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
_ -> Inlines -> Inlines
emph (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m Inlines
innerInlines
"footnote" -> (Blocks -> Inlines
note (Blocks -> Inlines) -> ([Blocks] -> Blocks) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat) ([Blocks] -> Inlines) -> StateT DBState m [Blocks] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m Blocks)
-> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
"title" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
"affiliation" -> DB m Inlines
skip
"br" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
_ -> DB m Inlines
skip DB m Inlines -> DB m Inlines -> DB m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DB m Inlines
innerInlines
where skip :: DB m Inlines
skip = do
m () -> StateT DBState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT DBState m ()) -> m () -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
e)
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
innerInlines :: DB m Inlines
innerInlines = (Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat) ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e)
codeWithLang :: DB m Inlines
codeWithLang = do
let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue "language" Element
e of
"" -> []
l :: Text
l -> [Text
l]
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith (String -> Element -> Text
attrValue "id" Element
e,[Text]
classes',[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContentRecursive Element
e
simpleList :: DB m Inlines
simpleList = ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str "," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)) ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines
((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "member") Element
e)
segmentedList :: DB m Inlines
segmentedList = do
Inlines
tit <- DB m Inlines
-> (Element -> DB m Inlines) -> Maybe Element -> DB m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines (Maybe Element -> DB m Inlines) -> Maybe Element -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named "title") Element
e
[Inlines]
segtits <- (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "segtitle") Element
e
[[Inlines]]
segitems <- (Element -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [[Inlines]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> (Element -> [Element]) -> Element -> StateT DBState m [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "seg"))
([Element] -> StateT DBState m [[Inlines]])
-> [Element] -> StateT DBState m [[Inlines]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named "seglistitem") Element
e
let toSeg :: [Inlines] -> Inlines
toSeg = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> Inlines -> Inlines)
-> [Inlines] -> [Inlines] -> [Inlines]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\x :: Inlines
x y :: Inlines
y -> Inlines -> Inlines
strong (Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str ":") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
Inlines
y Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
linebreak) [Inlines]
segtits
let segs :: Inlines
segs = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Inlines] -> Inlines) -> [[Inlines]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Inlines] -> Inlines
toSeg [[Inlines]]
segitems
let tit' :: Inlines
tit' = if Inlines
tit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Inlines
forall a. Monoid a => a
mempty
else Inlines -> Inlines
strong Inlines
tit Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
linebreak
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
linebreak Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
tit' Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
segs
keycombo :: [Inlines] -> Inlines
keycombo = Attr -> Inlines -> Inlines
spanWith ("",["keycombo"],[]) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str "+")
menuchoice :: [Inlines] -> Inlines
menuchoice = Attr -> Inlines -> Inlines
spanWith ("",["menuchoice"],[]) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
text " > ")
isGuiMenu :: Content -> Bool
isGuiMenu (Elem x :: Element
x) = Text -> Element -> Bool
named "guimenu" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named "guisubmenu" Element
x Bool -> Bool -> Bool
||
Text -> Element -> Bool
named "guimenuitem" Element
x
isGuiMenu _ = Bool
False
findElementById :: Text -> [Content] -> Maybe Element
findElementById idString :: Text
idString content :: [Content]
content
= [Maybe Element] -> Maybe Element
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [(Element -> Bool) -> Element -> Maybe Element
filterElement (\x :: Element
x -> String -> Element -> Text
attrValue "id" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
idString) Element
el | Elem el :: Element
el <- [Content]
content]
xrefTitleByElem :: Element -> Text
xrefTitleByElem el :: Element
el
| Bool -> Bool
not (Text -> Bool
T.null Text
xrefLabel) = Text
xrefLabel
| Bool
otherwise = case QName -> String
qName (Element -> QName
elName Element
el) of
"chapter" -> String -> Element -> Text
descendantContent "title" Element
el
"section" -> String -> Element -> Text
descendantContent "title" Element
el
"sect1" -> String -> Element -> Text
descendantContent "title" Element
el
"sect2" -> String -> Element -> Text
descendantContent "title" Element
el
"sect3" -> String -> Element -> Text
descendantContent "title" Element
el
"sect4" -> String -> Element -> Text
descendantContent "title" Element
el
"sect5" -> String -> Element -> Text
descendantContent "title" Element
el
"cmdsynopsis" -> String -> Element -> Text
descendantContent "command" Element
el
"funcsynopsis" -> String -> Element -> Text
descendantContent "function" Element
el
_ -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
el) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_title"
where
xrefLabel :: Text
xrefLabel = String -> Element -> Text
attrValue "xreflabel" Element
el
descendantContent :: String -> Element -> Text
descendantContent name :: String
name = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "???" (String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent)
(Maybe Element -> Text)
-> (Element -> Maybe Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Bool) -> Element -> Maybe Element
filterElementName (\n :: QName
n -> QName -> String
qName QName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name)
equation
:: Monad m
=> Element
-> (Text -> Inlines)
-> m Inlines
equation :: Element -> (Text -> Inlines) -> m Inlines
equation e :: Element
e constructor :: Text -> Inlines
constructor =
Inlines -> m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
constructor ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Text]
mathMLEquations [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
latexEquations
where
mathMLEquations :: [Text]
mathMLEquations :: [Text]
mathMLEquations = ([Exp] -> Text) -> [[Exp]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
writeTeX ([[Exp]] -> [Text]) -> [[Exp]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Either Text [Exp]] -> [[Exp]]
forall a b. [Either a b] -> [b]
rights ([Either Text [Exp]] -> [[Exp]]) -> [Either Text [Exp]] -> [[Exp]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool)
-> (Element -> Either Text [Exp]) -> [Either Text [Exp]]
forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath
(\x :: Element
x -> QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "math" Bool -> Bool -> Bool
&& QName -> Maybe String
qPrefix (Element -> QName
elName Element
x) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "mml")
(Text -> Either Text [Exp]
readMathML (Text -> Either Text [Exp])
-> (Element -> Text) -> Element -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
showElement)
latexEquations :: [Text]
latexEquations :: [Text]
latexEquations = (Element -> Bool) -> (Element -> Text) -> [Text]
forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath (\x :: Element
x -> QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "mathphrase")
([Text] -> Text
T.concat ([Text] -> Text) -> (Element -> [Text]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Text) -> [Content] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Content -> Text
showVerbatimCData ([Content] -> [Text])
-> (Element -> [Content]) -> Element -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent)
readMath :: (Element -> Bool) -> (Element -> b) -> [b]
readMath :: (Element -> Bool) -> (Element -> b) -> [b]
readMath childPredicate :: Element -> Bool
childPredicate fromElement :: Element -> b
fromElement =
(Element -> b) -> [Element] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> b
fromElement (Element -> b) -> (Element -> Element) -> Element -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
removePrefix))
([Element] -> [b]) -> [Element] -> [b]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
childPredicate Element
e
showVerbatimCData :: Content -> Text
showVerbatimCData :: Content -> Text
showVerbatimCData (Text (CData _ d :: String
d _)) = String -> Text
T.pack String
d
showVerbatimCData c :: Content
c = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Content -> String
showContent Content
c
removePrefix :: QName -> QName
removePrefix :: QName -> QName
removePrefix elname :: QName
elname = QName
elname { qPrefix :: Maybe String
qPrefix = Maybe String
forall a. Maybe a
Nothing }