{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Pandoc.Readers.DocBook ( readDocBook ) where
import Control.Monad (MonadPlus(mplus))
import Control.Applicative ()
import Control.Monad.State.Strict
( MonadTrans(lift),
StateT(runStateT),
MonadState(get),
gets,
modify )
import Data.ByteString (ByteString)
import Data.FileEmbed
import Data.Char (isSpace, isLetter, chr)
import Data.Default
import Data.List.Split (splitWhen)
import Data.Either (rights)
import Data.Foldable (asum)
import Data.Generics
import Data.List (intersperse,elemIndex)
import qualified Data.Set as Set
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (catMaybes,fromMaybe,mapMaybe,maybeToList)
import Data.Text (Text)
import Data.Text.Read as TR
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Control.Monad.Except (throwError)
import Text.Pandoc.XML (lookupEntity)
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Options
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Shared (safeRead, addPandocAttributes)
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
import Text.Pandoc.Transforms (headerShift)
import Text.TeXMath (readMathML, writeTeX)
import qualified Data.Map as M
import Text.Pandoc.XML.Light
import Text.Pandoc.Walk (query)
import Text.Read (readMaybe)
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 -> [Content]
dbContent :: [Content]
, DBState -> Bool
dbLiteralLayout :: Bool
, DBState -> [Text]
dbElementStack :: [Text]
} 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
$cshowsPrec :: Int -> DBState -> ShowS
showsPrec :: Int -> DBState -> ShowS
$cshow :: DBState -> String
show :: DBState -> String
$cshowList :: [DBState] -> ShowS
showList :: [DBState] -> ShowS
Show
instance Default DBState where
def :: DBState
def = DBState{ dbSectionLevel :: Int
dbSectionLevel = Int
0
, dbQuoteType :: QuoteType
dbQuoteType = QuoteType
DoubleQuote
, dbMeta :: Meta
dbMeta = Meta
forall a. Monoid a => a
mempty
, dbBook :: Bool
dbBook = Bool
False
, dbContent :: [Content]
dbContent = []
, dbLiteralLayout :: Bool
dbLiteralLayout = Bool
False
, dbElementStack :: [Text]
dbElementStack = []
}
readDocBook :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readDocBook :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readDocBook ReaderOptions
_ a
inp = do
let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
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
$
Map Text Text -> Text -> Either Text [Content]
parseXMLContentsWithEntities
Map Text Text
docbookEntityMap
(Text -> Text
TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
handleInstructions (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)
(bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree
let headerLevel (Header Int
n Attr
_ [Inline]
_) = [Int
n]
headerLevel Block
_ = []
let bottomLevel = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ (Block -> [Int]) -> [Many Block] -> [Int]
forall c. Monoid c => (Block -> c) -> [Many Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Int]
headerLevel [Many Block]
bs
return $
(if bottomLevel < 1
then headerShift (1 - bottomLevel)
else id) $ Pandoc (dbMeta st') $ toList $ mconcat bs
handleInstructions :: Text -> Text
handleInstructions :: Text -> Text
handleInstructions Text
t =
let (Text
x,Text
y) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"<?" Text
t
in if Text -> Bool
T.null Text
y
then Text
x
else
let (Text
w,Text
z) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"?>" Text
y
in (if (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
(Int -> Text -> Text
T.drop Int
2 Text
w) Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"asciidoc-br", Text
"dbfo"]
then Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<pi-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>"
else Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
2 Text
z) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
handleInstructions (Int -> Text -> Text
T.drop Int
2 Text
z)
getFigure :: PandocMonad m => Element -> DB m Blocks
getFigure :: forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getFigure Element
e = do
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
Just Element
t -> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
t
Maybe Element
Nothing -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
contents <- getBlocks e
let contents' =
case Many Block -> [Block]
forall a. Many a -> [a]
toList Many Block
contents of
[Para [img :: Inline
img@Image{}]] -> Many Inline -> Many Block
plain ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline
img])
[Block]
_ -> Many Block
contents
return $ figureWith
(attrValue "id" e, [], [])
(simpleCaption $ plain tit)
contents'
attrValue :: Text -> Element -> Text
attrValue :: Text -> Element -> Text
attrValue Text
attr Element
elt =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" ((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))
named :: Text -> Element -> Bool
named :: Text -> Element -> Bool
named Text
s Element
e = QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s
addMetadataFromElement :: PandocMonad m => Element -> DB m Blocks
addMetadataFromElement :: forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e = do
elementStack <- (DBState -> [Text]) -> StateT DBState m [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> [Text]
dbElementStack
if take 1 elementStack `elem` [[], ["book"], ["article"]]
then mempty <$ mapM_ handleMetadataElement
(filterChildren ((isMetadataField . qName . elName)) e)
else return mempty
where
handleMetadataElement :: Element -> StateT DBState m ()
handleMetadataElement Element
elt =
case QName -> Text
qName (Element -> QName
elName Element
elt) of
Text
"title" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"title" Element
elt
Text
"subtitle" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"subtitle" Element
elt
Text
"abstract" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"abstract" Element
elt
Text
"date" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"date" Element
elt
Text
"release" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"release" Element
elt
Text
"releaseinfo" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"releaseinfo" Element
elt
Text
"address" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"address" Element
elt
Text
"copyright" -> Text -> Element -> StateT DBState m ()
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
"copyright" Element
elt
Text
"author" -> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
fromAuthor Element
elt StateT DBState m (Many Inline)
-> (Many Inline -> StateT DBState m ()) -> StateT DBState m ()
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Many Inline -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
"author"
Text
"authorgroup" ->
(Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
fromAuthor ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"author") Element
elt) StateT DBState m [Many Inline]
-> ([Many Inline] -> StateT DBState m ()) -> StateT DBState m ()
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Many Inline] -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
"author"
Text
_ -> LogMessage -> StateT DBState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT DBState m ())
-> (Element -> LogMessage) -> Element -> StateT DBState m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> (Element -> Text) -> Element -> LogMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName (Element -> StateT DBState m ()) -> Element -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ Element
elt
fromAuthor :: Element -> StateT DBState m (Many Inline)
fromAuthor Element
elt =
[Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Many Inline] -> [Many Inline]) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
intersperse Many Inline
space ([Many Inline] -> [Many Inline])
-> ([Many Inline] -> [Many Inline])
-> [Many Inline]
-> [Many Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Inline -> Bool) -> [Many Inline] -> [Many Inline]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Many Inline -> Bool) -> Many Inline -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Bool
forall a. Many a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines (Element -> [Element]
elChildren Element
elt)
addContentsToMetadata :: Text -> Element -> StateT DBState m ()
addContentsToMetadata Text
fieldname Element
elt =
if (Element -> Bool) -> [Element] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags) (Text -> Bool) -> (Element -> Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
qName (QName -> Text) -> (Element -> QName) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
elName) (Element -> [Element]
elChildren Element
elt)
then Element -> DB m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
elt DB m (Many Block)
-> (Many Block -> StateT DBState m ()) -> StateT DBState m ()
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Many Block -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname
else Element -> DB m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
elt DB m (Many Inline)
-> (Many Inline -> StateT DBState m ()) -> StateT DBState m ()
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Many Inline -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname
isMetadataField :: a -> Bool
isMetadataField a
"abstract" = Bool
True
isMetadataField a
"address" = Bool
True
isMetadataField a
"annotation" = Bool
True
isMetadataField a
"artpagenums" = Bool
True
isMetadataField a
"author" = Bool
True
isMetadataField a
"authorgroup" = Bool
True
isMetadataField a
"authorinitials" = Bool
True
isMetadataField a
"bibliocoverage" = Bool
True
isMetadataField a
"biblioid" = Bool
True
isMetadataField a
"bibliomisc" = Bool
True
isMetadataField a
"bibliomset" = Bool
True
isMetadataField a
"bibliorelation" = Bool
True
isMetadataField a
"biblioset" = Bool
True
isMetadataField a
"bibliosource" = Bool
True
isMetadataField a
"collab" = Bool
True
isMetadataField a
"confgroup" = Bool
True
isMetadataField a
"contractnum" = Bool
True
isMetadataField a
"contractsponsor" = Bool
True
isMetadataField a
"copyright" = Bool
True
isMetadataField a
"cover" = Bool
True
isMetadataField a
"date" = Bool
True
isMetadataField a
"edition" = Bool
True
isMetadataField a
"editor" = Bool
True
isMetadataField a
"extendedlink" = Bool
True
isMetadataField a
"issuenum" = Bool
True
isMetadataField a
"itermset" = Bool
True
isMetadataField a
"keywordset" = Bool
True
isMetadataField a
"legalnotice" = Bool
True
isMetadataField a
"mediaobject" = Bool
True
isMetadataField a
"org" = Bool
True
isMetadataField a
"orgname" = Bool
True
isMetadataField a
"othercredit" = Bool
True
isMetadataField a
"pagenums" = Bool
True
isMetadataField a
"printhistory" = Bool
True
isMetadataField a
"productname" = Bool
True
isMetadataField a
"productnumber" = Bool
True
isMetadataField a
"pubdate" = Bool
True
isMetadataField a
"publisher" = Bool
True
isMetadataField a
"publishername" = Bool
True
isMetadataField a
"releaseinfo" = Bool
True
isMetadataField a
"revhistory" = Bool
True
isMetadataField a
"seriesvolnums" = Bool
True
isMetadataField a
"subjectset" = Bool
True
isMetadataField a
"subtitle" = Bool
True
isMetadataField a
"title" = Bool
True
isMetadataField a
"titleabbrev" = Bool
True
isMetadataField a
"volumenum" = Bool
True
isMetadataField a
_ = Bool
False
addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> DB m ()
addMeta :: forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
field a
val = (DBState -> DBState) -> StateT DBState 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
forall b. ToMetaValue b => Text -> b -> DBState -> DBState
setMeta Text
field a
val)
instance HasMeta DBState where
setMeta :: forall b. ToMetaValue b => Text -> b -> DBState -> DBState
setMeta Text
field b
v DBState
s = DBState
s {dbMeta = setMeta field v (dbMeta s)}
deleteMeta :: Text -> DBState -> DBState
deleteMeta Text
field DBState
s = DBState
s {dbMeta = deleteMeta field (dbMeta s)}
isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem Element
e) = QName -> Text
qName (Element -> QName
elName Element
e) Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
blockTags
isBlockElement Content
_ = Bool
False
blockTags :: Set.Set Text
blockTags :: Set Text
blockTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$
[ Text
"abstract"
, Text
"ackno"
, Text
"answer"
, Text
"appendix"
, Text
"appendixinfo"
, Text
"area"
, Text
"areaset"
, Text
"areaspec"
, Text
"article"
, Text
"articleinfo"
, Text
"attribution"
, Text
"authorinitials"
, Text
"biblioentry"
, Text
"bibliomisc"
, Text
"bibliomixed"
, Text
"blockquote"
, Text
"book"
, Text
"bookinfo"
, Text
"bridgehead"
, Text
"calloutlist"
, Text
"caption"
, Text
"chapter"
, Text
"chapterinfo"
, Text
"epigraph"
, Text
"example"
, Text
"figure"
, Text
"formalpara"
, Text
"glossary"
, Text
"glossaryinfo"
, Text
"glossdiv"
, Text
"glossee"
, Text
"glosseealso"
, Text
"glosslist"
, Text
"glosssee"
, Text
"glossseealso"
, Text
"index"
, Text
"info"
, Text
"informalexample"
, Text
"informalfigure"
, Text
"informaltable"
, Text
"itemizedlist"
, Text
"linegroup"
, Text
"literallayout"
, Text
"mediaobject"
, Text
"orderedlist"
, Text
"para"
, Text
"part"
, Text
"partinfo"
, Text
"preface"
, Text
"procedure"
, Text
"programlisting"
, Text
"question"
, Text
"refsect1info"
, Text
"refsect2info"
, Text
"refsect3info"
, Text
"refsectioninfo"
, Text
"screen"
, Text
"sect1info"
, Text
"sect2info"
, Text
"sect3info"
, Text
"sect4info"
, Text
"sect5info"
, Text
"sectioninfo"
, Text
"simpara"
, Text
"substeps"
, Text
"subtitle"
, Text
"table"
, Text
"title"
, Text
"titleabbrev"
, Text
"toc"
, Text
"variablelist"
] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sectionTags [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
admonitionTags
sectionTags :: [Text]
sectionTags :: [Text]
sectionTags = [Text
"bibliography", Text
"bibliodiv"
, Text
"sect1", Text
"sect2", Text
"sect3", Text
"sect4", Text
"sect5", Text
"section", Text
"simplesect"
, Text
"refsect1", Text
"refsect2", Text
"refsect3", Text
"refsection", Text
"qandadiv"
]
admonitionTags :: [Text]
admonitionTags :: [Text]
admonitionTags = [Text
"caution",Text
"danger",Text
"important",Text
"note",Text
"tip",Text
"warning"]
titledBlockElements :: [Text]
titledBlockElements :: [Text]
titledBlockElements = [Text
"example", Text
"formalpara", Text
"sidebar"]
trimNl :: Text -> Text
trimNl :: Text -> Text
trimNl = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
addToStart :: Inlines -> Blocks -> Blocks
addToStart :: Many Inline -> Many Block -> Many Block
addToStart Many Inline
toadd Many Block
bs =
case Many Block -> [Block]
forall a. Many a -> [a]
toList Many Block
bs of
(Para [Inline]
xs : [Block]
rest) -> Many Inline -> Many Block
para (Many Inline
toadd Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
xs) Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> [Block] -> Many Block
forall a. [a] -> Many a
fromList [Block]
rest
[Block]
_ -> Many Block
bs
getMediaobject :: PandocMonad m => Element -> DB m Inlines
getMediaobject :: forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getMediaobject Element
e = do
let (Text
imageUrl, Text
tit, Attr
attr) =
case (Element -> Bool) -> Element -> [Element]
filterElements (Text -> Element -> Bool
named Text
"imageobject") Element
e of
[] -> (Text
forall a. Monoid a => a
mempty, Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
(Element
z:[Element]
_) ->
let tit' :: Text
tit' = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Element -> Text
strContent (Maybe Element -> Text) -> Maybe Element -> Text
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"objectinfo") Element
z Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title")
(Text
imageUrl', Attr
attr') =
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"imagedata") Element
z of
Maybe Element
Nothing -> (Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
Just Element
i -> let atVal :: Text -> Text
atVal Text
a = Text -> Element -> Text
attrValue Text
a Element
i
w :: [(Text, Text)]
w = case Text -> Text
atVal Text
"width" of
Text
"" -> []
Text
d -> [(Text
"width", Text
d)]
h :: [(Text, Text)]
h = case Text -> Text
atVal Text
"depth" of
Text
"" -> []
Text
d -> [(Text
"height", Text
d)]
id' :: Text
id' = Text -> Text
atVal Text
"id"
cs :: [Text]
cs = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
atVal Text
"role"
atr :: Attr
atr = (Text
id', [Text]
cs, [(Text, Text)]
w [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
h)
in (Text -> Text
atVal Text
"fileref", Attr
atr)
in (Text
imageUrl', Text
tit', Attr
attr')
let capt :: StateT DBState m (Many Inline)
capt = case (Element -> Bool) -> Element -> Maybe Element
filterChild (\Element
x -> Text -> Element -> Bool
named Text
"caption" Element
x
Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"textobject" Element
x
Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"alt" Element
x) Element
e of
Maybe Element
Nothing -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
Just Element
z -> Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Element -> [Content]
elContent Element
z)
(Many Inline -> Many Inline)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> StateT DBState m a -> StateT DBState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Text -> Text -> Many Inline -> Many Inline
imageWith Attr
attr Text
imageUrl Text
tit) StateT DBState m (Many Inline)
capt
getBlocks :: PandocMonad m => Element -> DB m Blocks
getBlocks :: forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e = do
(DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbElementStack = qName (elName e) : dbElementStack st })
blocks <- [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT DBState m (Many Block))
-> [Content] -> StateT DBState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Content -> DB m (Many Block)
parseBlock (Element -> [Content]
elContent Element
e)
modify (\DBState
st -> DBState
st{ dbElementStack = drop 1 $ dbElementStack st })
return blocks
getRoleAttr :: Element -> [(Text, Text)]
getRoleAttr :: Element -> [(Text, Text)]
getRoleAttr Element
e = case Text -> Element -> Text
attrValue Text
"role" Element
e of
Text
"" -> []
Text
r -> [(Text
"role", Text
r)]
parseBlock :: PandocMonad m => Content -> DB m Blocks
parseBlock :: forall (m :: * -> *). PandocMonad m => Content -> DB m (Many Block)
parseBlock (Text (CData CDataKind
CDataRaw Text
_ Maybe Integer
_)) = Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
parseBlock (Text (CData CDataKind
_ Text
s Maybe Integer
_)) = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
then Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
else Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT DBState m (Many Block))
-> Many Block -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text Text
s
parseBlock (CRef Text
x) = Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT DBState m (Many Block))
-> Many Block -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Inline -> Many Block
plain (Many Inline -> Many Block) -> Many Inline -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
str (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
x
parseBlock (Elem Element
e) = do
parsedBlock <- case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"toc" -> StateT DBState m (Many Block)
skip
Text
"index" -> StateT DBState m (Many Block)
skip
Text
"para" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"simpara" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"ackno" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"epigraph" -> StateT DBState m (Many Block)
parseBlockquote
Text
"blockquote" -> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
withOptionalTitle StateT DBState m (Many Block)
parseBlockquote
Text
"attribution" -> StateT DBState m (Many Block)
skip
Text
"titleabbrev" -> StateT DBState m (Many Block)
skip
Text
"authorinitials" -> StateT DBState m (Many Block)
skip
Text
"bibliography" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
0
Text
"bibliodiv" ->
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
Just Element
_ -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
1
Maybe Element
Nothing -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
Text
"biblioentry" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"bibliomisc" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"bibliomixed" -> (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
para (Element -> [Content]
elContent Element
e)
Text
"equation" -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Many Inline) -> StateT DBState m (Many Inline)
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
displayMath
Text
"informalequation" -> Attr -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e,[Text
"informalequation"],[]) (Many Block -> Many Block)
-> (Many Inline -> Many Block) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Many Inline -> Many Block
para (Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Many Inline) -> StateT DBState m (Many Inline)
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
displayMath
Text
"glosssee" -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> (Many Inline -> Many Inline) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Many Inline
ils -> Text -> Many Inline
text Text
"See " Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
ils Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
".")
(Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e
Text
"glossseealso" -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> (Many Inline -> Many Inline) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Many Inline
ils -> Text -> Many Inline
text Text
"See also " Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
ils Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
".")
(Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e
Text
"glossary" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
0
Text
"glossdiv" -> [(Many Inline, [Many Block])] -> Many Block
definitionList ([(Many Inline, [Many Block])] -> Many Block)
-> StateT DBState m [(Many Inline, [Many Block])]
-> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> StateT DBState m (Many Inline, [Many Block]))
-> [Element] -> StateT DBState m [(Many Inline, [Many Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline, [Many Block])
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT DBState m (Many Inline, [Many Block])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossentry") Element
e)
Text
"glosslist" -> [(Many Inline, [Many Block])] -> Many Block
definitionList ([(Many Inline, [Many Block])] -> Many Block)
-> StateT DBState m [(Many Inline, [Many Block])]
-> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> StateT DBState m (Many Inline, [Many Block]))
-> [Element] -> StateT DBState m [(Many Inline, [Many Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline, [Many Block])
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT DBState m (Many Inline, [Many Block])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossentry") Element
e)
Text
"chapter" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook = True}) StateT DBState m ()
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
0
Text
"part" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook = True}) StateT DBState m ()
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect (-Int
1)
Text
"appendix" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
0
Text
"preface" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
0
Text
"bridgehead" -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> (Many Inline -> Many Inline) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Inline
strong (Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e
Text
"sect1" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
1
Text
"sect2" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
2
Text
"sect3" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
3
Text
"sect4" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
4
Text
"sect5" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
5
Text
"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 -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block)
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect (Int -> StateT DBState m (Many Block))
-> (Int -> Int) -> Int -> StateT DBState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Text
"simplesect" ->
(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 -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block)
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text
-> [Text] -> [(Text, Text)] -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Text
-> [Text] -> [(Text, Text)] -> Int -> StateT DBState m (Many Block)
sectWith(Text -> Element -> Text
attrValue Text
"id" Element
e) [Text
"unnumbered"] [] (Int -> StateT DBState m (Many Block))
-> (Int -> Int) -> Int -> StateT DBState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Text
"refsect1" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
1
Text
"refsect2" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
2
Text
"refsect3" -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect Int
3
Text
"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 -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block)
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect (Int -> StateT DBState m (Many Block))
-> (Int -> Int) -> Int -> StateT DBState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Text
l | Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
titledBlockElements -> Bool -> Text -> StateT DBState m (Many Block)
parseAdmonition Bool
False Text
l
Text
l | Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitionTags -> Bool -> Text -> StateT DBState m (Many Block)
parseAdmonition Bool
True Text
l
Text
"area" -> StateT DBState m (Many Block)
skip
Text
"areaset" -> StateT DBState m (Many Block)
skip
Text
"areaspec" -> StateT DBState m (Many Block)
skip
Text
"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 -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block)
forall a b.
StateT DBState m a
-> (a -> StateT DBState m b) -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT DBState m (Many Block)
sect (Int -> StateT DBState m (Many Block))
-> (Int -> Int) -> Int -> StateT DBState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Text
"question" -> Many Inline -> Many Block -> Many Block
addToStart (Many Inline -> Many Inline
strong (Text -> Many Inline
str Text
"Q:") Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
" ") (Many Block -> Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"answer" -> Many Inline -> Many Block -> Many Block
addToStart (Many Inline -> Many Inline
strong (Text -> Many Inline
str Text
"A:") Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
" ") (Many Block -> Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"abstract" -> Many Block -> Many Block
blockQuote (Many Block -> Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"calloutlist" -> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
withOptionalTitle (StateT DBState m (Many Block) -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ [Many Block] -> Many Block
bulletList ([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Block]
callouts
Text
"itemizedlist" -> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
withOptionalTitle (StateT DBState m (Many Block) -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$
[Many Block] -> Many Block
bulletList ([Many Block] -> Many Block)
-> ([Many Block] -> [Many Block]) -> [Many Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> [Many Block]
handleCompact ([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Block]
listitems
Text
"orderedlist" -> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
withOptionalTitle (StateT DBState m (Many Block) -> StateT DBState m (Many Block))
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ do
let listStyle :: ListNumberStyle
listStyle = case Text -> Element -> Text
attrValue Text
"numeration" Element
e of
Text
"arabic" -> ListNumberStyle
Decimal
Text
"loweralpha" -> ListNumberStyle
LowerAlpha
Text
"upperalpha" -> ListNumberStyle
UpperAlpha
Text
"lowerroman" -> ListNumberStyle
LowerRoman
Text
"upperroman" -> ListNumberStyle
UpperRoman
Text
_ -> ListNumberStyle
Decimal
let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"startingnumber" Element
e
ListAttributes -> [Many Block] -> Many Block
orderedListWith (Int
start,ListNumberStyle
listStyle,ListNumberDelim
DefaultDelim) ([Many Block] -> Many Block)
-> ([Many Block] -> [Many Block]) -> [Many Block] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> [Many Block]
handleCompact
([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Block]
listitems
Text
"variablelist" -> [(Many Inline, [Many Block])] -> Many Block
definitionList ([(Many Inline, [Many Block])] -> Many Block)
-> StateT DBState m [(Many Inline, [Many Block])]
-> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [(Many Inline, [Many Block])]
deflistitems
Text
"procedure" -> [Many Block] -> Many Block
orderedList ([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Block]
steps
Text
"substeps" -> [Many Block] -> Many Block
orderedList ([Many Block] -> Many Block)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Block]
steps
Text
"figure" -> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getFigure Element
e
Text
"informalfigure" -> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getFigure Element
e
Text
"mediaobject" -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getMediaobject Element
e
Text
"caption" -> StateT DBState m (Many Block)
skip
Text
"info" -> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e
Text
"articleinfo" -> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e
Text
"sectioninfo" -> StateT DBState m (Many Block)
skip
Text
"refsectioninfo" -> StateT DBState m (Many Block)
skip
Text
"refsect1info" -> StateT DBState m (Many Block)
skip
Text
"refsect2info" -> StateT DBState m (Many Block)
skip
Text
"refsect3info" -> StateT DBState m (Many Block)
skip
Text
"sect1info" -> StateT DBState m (Many Block)
skip
Text
"sect2info" -> StateT DBState m (Many Block)
skip
Text
"sect3info" -> StateT DBState m (Many Block)
skip
Text
"sect4info" -> StateT DBState m (Many Block)
skip
Text
"sect5info" -> StateT DBState m (Many Block)
skip
Text
"chapterinfo" -> StateT DBState m (Many Block)
skip
Text
"partinfo" -> StateT DBState m (Many Block)
skip
Text
"glossaryinfo" -> StateT DBState m (Many Block)
skip
Text
"appendixinfo" -> StateT DBState m (Many Block)
skip
Text
"bookinfo" -> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e
Text
"article" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook = False }) StateT DBState m ()
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e StateT DBState m (Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"book" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook = True }) StateT DBState m ()
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
addMetadataFromElement Element
e StateT DBState m (Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"table" -> StateT DBState m (Many Block)
parseTable
Text
"informaltable" -> StateT DBState m (Many Block)
parseTable
Text
"informalexample" -> Attr -> Many Block -> Many Block
divWith (Text
"", [Text
"informalexample"], []) (Many Block -> Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
Text
"linegroup" -> [Many Inline] -> Many Block
lineBlock ([Many Inline] -> Many Block)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Many Inline]
lineItems
Text
"literallayout" -> StateT DBState m (Many Block)
literalLayout
Text
"screen" -> StateT DBState m (Many Block)
codeBlockWithLang
Text
"programlisting" -> StateT DBState m (Many Block)
codeBlockWithLang
Text
"?xml" -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
Text
"title" -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
Text
"subtitle" -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
Text
_ -> StateT DBState m (Many Block)
skip StateT DBState m (Many Block)
-> StateT DBState m (Many Block) -> StateT DBState m (Many Block)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks Element
e
if qName (elName e) `elem` sectionTags
then return parsedBlock
else return $ addPandocAttributes (getRoleAttr e) parsedBlock
where skip :: StateT DBState m (Many Block)
skip = do
let qn :: Text
qn = QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e
let name :: Text
name = if Text
"pi-" Text -> Text -> Bool
`T.isPrefixOf` Text
qn
then Text
"<?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?>"
else Text
qn
m () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT DBState m a
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
name
Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
compactSpacing :: Bool
compactSpacing = case Text -> Element -> Text
attrValue Text
"spacing" Element
e of
Text
"compact" -> Bool
True
Text
_ -> Bool
False
handleCompact :: [Many Block] -> [Many Block]
handleCompact = if Bool
compactSpacing
then (Many Block -> Many Block) -> [Many Block] -> [Many Block]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Block) -> Many Block -> Many Block
forall a b. (a -> b) -> Many a -> Many b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Block
paraToPlain)
else [Many Block] -> [Many Block]
forall a. a -> a
id
literalLayout :: StateT DBState m (Many Block)
literalLayout
| Text
"monospaced" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> [Text]
T.words (Text -> Element -> Text
attrValue Text
"class" Element
e))
= StateT DBState m (Many Block)
codeBlockWithLang
| Bool
otherwise = do
oldLiteralLayout <- (DBState -> Bool) -> StateT DBState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Bool
dbLiteralLayout
modify $ \DBState
st -> DBState
st{ dbLiteralLayout = True }
content <- mconcat <$> mapM parseInline (elContent e)
let ls = ([Inline] -> Many Inline) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([[Inline]] -> [Many Inline])
-> (Many Inline -> [[Inline]]) -> Many Inline -> [Many Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) ([Inline] -> [[Inline]])
-> (Many Inline -> [Inline]) -> Many Inline -> [[Inline]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Many Inline]) -> Many Inline -> [Many Inline]
forall a b. (a -> b) -> a -> b
$ Many Inline
content
modify $ \DBState
st -> DBState
st{ dbLiteralLayout = oldLiteralLayout }
return $ lineBlock ls
codeBlockWithLang :: StateT DBState m (Many Block)
codeBlockWithLang = do
let classes' :: [Text]
classes' = case Text -> Element -> Text
attrValue Text
"language" Element
e of
Text
"" -> []
Text
x -> [Text
x]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"numberLines" | Text -> Element -> Text
attrValue Text
"linenumbering" Element
e Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"numbered"]
Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT DBState m (Many Block))
-> Many Block -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
codeBlockWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text]
classes', [])
(Text -> Many Block) -> Text -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
parseBlockquote :: StateT DBState m (Many Block)
parseBlockquote = do
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"attribution") Element
e of
Maybe Element
Nothing -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
Just Element
z -> Many Inline -> Many Block
para (Many Inline -> Many Block)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Many Inline
str Text
"— " Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<>) (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat
([Many Inline] -> Many Block)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Element -> [Content]
elContent Element
z)
contents <- getBlocks e
return $ blockQuote (contents <> attrib)
listitems :: StateT DBState m [Many Block]
listitems = (Element -> StateT DBState m (Many Block))
-> [Element] -> StateT DBState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks ([Element] -> StateT DBState m [Many Block])
-> [Element] -> StateT DBState m [Many Block]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"listitem") Element
e
callouts :: StateT DBState m [Many Block]
callouts = (Element -> StateT DBState m (Many Block))
-> [Element] -> StateT DBState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks ([Element] -> StateT DBState m [Many Block])
-> [Element] -> StateT DBState m [Many Block]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"callout") Element
e
deflistitems :: StateT DBState m [(Many Inline, [Many Block])]
deflistitems = (Element -> StateT DBState m (Many Inline, [Many Block]))
-> [Element] -> StateT DBState m [(Many Inline, [Many Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline, [Many Block])
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT DBState m (Many Inline, [Many Block])
parseVarListEntry ([Element] -> StateT DBState m [(Many Inline, [Many Block])])
-> [Element] -> StateT DBState m [(Many Inline, [Many Block])]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren
(Text -> Element -> Bool
named Text
"varlistentry") Element
e
steps :: StateT DBState m [Many Block]
steps = (Element -> StateT DBState m (Many Block))
-> [Element] -> StateT DBState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Element -> DB m (Many Block)
getBlocks ([Element] -> StateT DBState m [Many Block])
-> [Element] -> StateT DBState m [Many Block]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"step") Element
e
parseVarListEntry :: Element -> StateT DBState m (Many Inline, [Many Block])
parseVarListEntry Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"term") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"listitem") Element
e'
terms' <- (Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines [Element]
terms
items' <- mapM getBlocks items
return (mconcat $ intersperse (str "; ") terms', items')
parseGlossEntry :: Element -> StateT DBState m (Many Inline, [Many Block])
parseGlossEntry Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossterm") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossdef") Element
e'
terms' <- (Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines [Element]
terms
items' <- mapM getBlocks items
return (mconcat $ intersperse (str "; ") terms', items')
parseTable :: StateT DBState m (Many Block)
parseTable = do
let elId :: Text
elId = Text -> Element -> Text
attrValue Text
"id" Element
e
let attrs :: [(Text, Text)]
attrs = case Text -> Element -> Text
attrValue Text
"tabstyle" Element
e of
Text
"" -> []
Text
x -> [(Text
"custom-style", Text
x)]
let 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
let isCaption :: Element -> Bool
isCaption Element
x = Text -> Element -> Bool
named Text
"title" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"caption" Element
x
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
Just Element
t -> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
t
Maybe Element
Nothing -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
let 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 Text
"tgroup") Element
e
let isColspec Element
x = Text -> Element -> Bool
named Text
"colspec" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"col" Element
x
let colspecs = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"colgroup") Element
e' of
Just Element
c -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
c
Maybe Element
_ -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
e'
let colnames = case [Element]
colspecs of
[] -> []
[Element]
cs -> (Element -> Maybe Text) -> [Element] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"colname" )) [Element]
cs
let isRow Element
x = Text -> Element -> Bool
named Text
"row" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"tr" Element
x
headrows <- case filterChild (named "thead") e' of
Just Element
h -> (Element -> StateT DBState m [Cell])
-> [Element] -> StateT DBState 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 ([Text] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m [Cell]
parseRow [Text]
colnames)
([Element] -> StateT DBState m [[Cell]])
-> [Element] -> StateT DBState m [[Cell]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
h
Maybe Element
Nothing -> [[Cell]] -> StateT DBState m [[Cell]]
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
bodyrows <- case filterChild (named "tbody") e' of
Just Element
b -> (Element -> StateT DBState m [Cell])
-> [Element] -> StateT DBState 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 ([Text] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m [Cell]
parseRow [Text]
colnames)
([Element] -> StateT DBState m [[Cell]])
-> [Element] -> StateT DBState m [[Cell]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
b
Maybe Element
Nothing -> (Element -> StateT DBState m [Cell])
-> [Element] -> StateT DBState 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 ([Text] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m [Cell]
parseRow [Text]
colnames)
([Element] -> StateT DBState m [[Cell]])
-> [Element] -> StateT DBState m [[Cell]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
e'
let toWidth Element
c = do
w <- QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"colwidth") Element
c
n <- safeRead $ "0" <> T.filter (\Char
x ->
(Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') w
if n > 0 then Just n else Nothing
let numrows = Int -> (NonEmpty Int -> Int) -> Maybe (NonEmpty Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 NonEmpty Int -> Int
forall a. Ord a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe (NonEmpty Int) -> Int) -> Maybe (NonEmpty Int) -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
([Int] -> Maybe (NonEmpty Int)) -> [Int] -> Maybe (NonEmpty Int)
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Int) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Cell]]
bodyrows [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. [a] -> [a] -> [a]
++ [[Cell]]
headrows)
let aligns = case [Element]
colspecs of
[] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
[Element]
cs -> (Element -> Alignment) -> [Element] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
let parseWidth Text
s = Text -> m a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead ((Char -> Bool) -> Text -> Text
T.filter (\Char
x -> (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
s)
let textWidth = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"pi-dbfo") Element
e of
Just Element
d -> case Text -> Element -> Text
attrValue Text
"table-width" Element
d of
Text
"" -> Double
1.0
Text
w -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
100.0 (Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
parseWidth Text
w) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0
Maybe Element
Nothing -> Double
1.0
let widths = case [Element]
colspecs of
[] -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
[Element]
cs -> let ws :: [Maybe Double]
ws = (Element -> Maybe Double) -> [Element] -> [Maybe Double]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Maybe Double
forall {b}. (Read b, Ord b, Num b) => Element -> Maybe b
toWidth [Element]
cs
in case [Maybe Double] -> Maybe [Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Maybe Double]
ws of
Just [Double]
ws' -> let colTot :: Double
colTot = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws'
scale :: Double -> Double
scale
| Double
textWidth Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1.0 = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
colTot)
| Bool
otherwise = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
textWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
colTot) )
in Double -> ColWidth
ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
scale (Double -> ColWidth) -> [Double] -> [ColWidth]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ws'
Maybe [Double]
Nothing -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
let toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr
return $ tableWith (elId,classes,attrs)
(simpleCaption $ plain capt)
(zip aligns widths)
(TableHead nullAttr $ map toRow headrows)
[TableBody nullAttr 0 [] $ map toRow bodyrows]
(TableFoot nullAttr [])
sect :: Int -> StateT DBState m (Many Block)
sect Int
n = Text
-> [Text] -> [(Text, Text)] -> Int -> StateT DBState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Text
-> [Text] -> [(Text, Text)] -> Int -> StateT DBState m (Many Block)
sectWith(Text -> Element -> Text
attrValue Text
"id" Element
e) [] [] Int
n
sectWith :: Text
-> [Text] -> [(Text, Text)] -> Int -> StateT DBState m (Many Block)
sectWith Text
elId [Text]
classes [(Text, Text)]
attrs Int
n = do
isbook <- (DBState -> Bool) -> StateT DBState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Bool
dbBook
let n' = if Bool
isbook Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
headerText <- case filterChild (named "title") e `mplus`
(filterChild (named "info") e >>=
filterChild (named "title")) of
Just Element
t -> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
t
Maybe Element
Nothing -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
modify $ \DBState
st -> DBState
st{ dbSectionLevel = n }
b <- getBlocks e
modify $ \DBState
st -> DBState
st{ dbSectionLevel = n - 1 }
let hdr = [(Text, Text)] -> Many Block -> Many Block
forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes (Element -> [(Text, Text)]
getRoleAttr Element
e)
(Many Block -> Many Block) -> Many Block -> Many Block
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Many Inline -> Many Block
headerWith (Text
elId, [Text]
classes, Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList Maybe (Text, Text)
titleabbrevElAsAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
attrs)
Int
n' Many Inline
headerText
return $ hdr <> b
titleabbrevElAsAttr :: Maybe (Text, Text)
titleabbrevElAsAttr =
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"titleabbrev") Element
e Maybe Element -> Maybe Element -> Maybe Element
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"info") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"titleabbrev")) of
Just Element
t -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
"titleabbrev", Element -> Text
strContentRecursive Element
t)
Maybe Element
Nothing -> Maybe (Text, Text)
forall a. Maybe a
Nothing
lineItems :: StateT DBState m [Many Inline]
lineItems = (Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines ([Element] -> StateT DBState m [Many Inline])
-> [Element] -> StateT DBState m [Many Inline]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"line") Element
e
getTitle :: StateT DBState m (Maybe (Many Inline))
getTitle = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
Just Element
t -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just (Many Inline -> Maybe (Many Inline))
-> StateT DBState m (Many Inline)
-> StateT DBState m (Maybe (Many Inline))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
t
Maybe Element
Nothing -> Maybe (Many Inline) -> StateT DBState m (Maybe (Many Inline))
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Many Inline)
forall a. Maybe a
Nothing
withOptionalTitle :: StateT DBState m (Many Block) -> StateT DBState m (Many Block)
withOptionalTitle StateT DBState m (Many Block)
p = do
mbt <- StateT DBState m (Maybe (Many Inline))
getTitle
b <- p
case mbt of
Maybe (Many Inline)
Nothing -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
b
Just Many Inline
t -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT DBState m (Many Block))
-> Many Block -> StateT DBState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [], Element -> [(Text, Text)]
getRoleAttr Element
e)
(Attr -> Many Block -> Many Block
divWith (Text
"", [Text
"title"], []) (Many Inline -> Many Block
plain Many Inline
t) Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
b)
parseAdmonition :: Bool -> Text -> StateT DBState m (Many Block)
parseAdmonition Bool
alwaysIncludeTitle Text
label = do
mbt <- StateT DBState m (Maybe (Many Inline))
getTitle
b <- getBlocks e
let t = Many Block
-> (Many Inline -> Many Block) -> Maybe (Many Inline) -> Many Block
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Many Block
forall a. Monoid a => a
mempty (Attr -> Many Block -> Many Block
divWith (Text
"", [Text
"title"], []) (Many Block -> Many Block)
-> (Many Inline -> Many Block) -> Many Inline -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Many Block
plain)
(case Maybe (Many Inline)
mbt of
Maybe (Many Inline)
Nothing | Bool
alwaysIncludeTitle -> Many Inline -> Maybe (Many Inline)
forall a. a -> Maybe a
Just Many Inline
forall a. Monoid a => a
mempty
Maybe (Many Inline)
_ -> Maybe (Many Inline)
mbt)
return $ divWith (attrValue "id" e,[label],[]) (t <> b)
toAlignment :: Element -> Alignment
toAlignment :: Element -> Alignment
toAlignment Element
c = case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"align") Element
c of
Just Text
"left" -> Alignment
AlignLeft
Just Text
"right" -> Alignment
AlignRight
Just Text
"center" -> Alignment
AlignCenter
Maybe Text
_ -> Alignment
AlignDefault
parseMixed :: PandocMonad m => (Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed :: forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
container [Content]
conts = do
let ([Content]
ils,[Content]
rest) = (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Content -> Bool
isBlockElement [Content]
conts
ils' <- Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline [Content]
ils
let p = if Many Inline
ils' Many Inline -> Many Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Many Inline
forall a. Monoid a => a
mempty then Many Block
forall a. Monoid a => a
mempty else Many Inline -> Many Block
container Many Inline
ils'
case rest of
[] -> Many Block -> StateT DBState m (Many Block)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
p
(Content
r:[Content]
rs) -> do
b <- Content -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Content -> DB m (Many Block)
parseBlock Content
r
x <- parseMixed container rs
return $ p <> b <> x
parseRow :: PandocMonad m => [Text] -> Element -> DB m [Cell]
parseRow :: forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m [Cell]
parseRow [Text]
cn = do
let isEntry :: Element -> Bool
isEntry Element
x = Text -> Element -> Bool
named Text
"entry" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"td" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"th" Element
x
(Element -> StateT DBState m Cell)
-> [Element] -> StateT DBState 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 ([Text] -> Element -> StateT DBState m Cell
forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m Cell
parseEntry [Text]
cn) ([Element] -> StateT DBState m [Cell])
-> (Element -> [Element]) -> Element -> StateT DBState m [Cell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry
parseEntry :: PandocMonad m => [Text] -> Element -> DB m Cell
parseEntry :: forall (m :: * -> *).
PandocMonad m =>
[Text] -> Element -> DB m Cell
parseEntry [Text]
cn Element
el = do
let colDistance :: Text -> Text -> ColSpan
colDistance Text
sa Text
ea = do
let iStrt :: Maybe Int
iStrt = Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Text
sa [Text]
cn
let iEnd :: Maybe Int
iEnd = Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Text
ea [Text]
cn
case (Maybe Int
iStrt, Maybe Int
iEnd) of
(Just Int
start, Just Int
end) -> Int -> ColSpan
ColSpan (Int -> ColSpan) -> Int -> ColSpan
forall a b. (a -> b) -> a -> b
$ Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
(Maybe Int, Maybe Int)
_ -> ColSpan
1
let toColSpan :: Element -> ColSpan
toColSpan Element
en = do
let mStrt :: Maybe Text
mStrt = QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"namest") Element
en
let mEnd :: Maybe Text
mEnd = QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"nameend") Element
en
case (Maybe Text
mStrt, Maybe Text
mEnd) of
(Just Text
start, Just Text
end) -> Text -> Text -> ColSpan
colDistance Text
start Text
end
(Maybe Text, Maybe Text)
_ -> ColSpan
1
let rowDistance :: Text -> RowSpan
rowDistance Text
mr = do
case 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
mr :: Maybe Int of
Just Int
moreRow -> Int -> RowSpan
RowSpan (Int -> RowSpan) -> Int -> RowSpan
forall a b. (a -> b) -> a -> b
$ Int
moreRow Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Maybe Int
_ -> RowSpan
1
let toRowSpan :: Element -> RowSpan
toRowSpan Element
en = do
case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"morerows") Element
en of
Just Text
moreRow -> Text -> RowSpan
rowDistance Text
moreRow
Maybe Text
_ -> RowSpan
1
let colSpan :: ColSpan
colSpan = Element -> ColSpan
toColSpan Element
el
let rowSpan :: RowSpan
rowSpan = Element -> RowSpan
toRowSpan Element
el
let align :: Alignment
align = Element -> Alignment
toAlignment Element
el
((Many Block -> Cell)
-> StateT DBState m (Many Block) -> StateT DBState m Cell
forall a b. (a -> b) -> StateT DBState m a -> StateT DBState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alignment -> RowSpan -> ColSpan -> Many Block -> Cell
cell Alignment
align RowSpan
rowSpan ColSpan
colSpan) (StateT DBState m (Many Block) -> StateT DBState m Cell)
-> (Element -> StateT DBState m (Many Block))
-> Element
-> StateT DBState m Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Inline -> Many Block)
-> [Content] -> StateT DBState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
(Many Inline -> Many Block) -> [Content] -> DB m (Many Block)
parseMixed Many Inline -> Many Block
plain ([Content] -> StateT DBState m (Many Block))
-> (Element -> [Content])
-> Element
-> StateT DBState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) Element
el
getInlines :: PandocMonad m => Element -> DB m Inlines
getInlines :: forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e' = Many Inline -> Many Inline
trimInlines (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Element -> [Content]
elContent Element
e')
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 Integer -> CData
CData CDataKind
CDataText (Element -> Text
strContentRecursive Element
e') Maybe Integer
forall a. Maybe a
Nothing
elementToStr Content
x = Content
x
childElTextAsAttr :: Text -> Element -> Maybe (Text, Text)
childElTextAsAttr :: Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
n Element
e = case QName -> Element -> Maybe Element
findChild QName
q Element
e of
Maybe Element
Nothing -> Maybe (Text, Text)
forall a. Maybe a
Nothing
Just Element
childEl -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
n, Element -> Text
strContentRecursive Element
childEl)
where q :: QName
q = Text -> Maybe Text -> Maybe Text -> QName
QName Text
n (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://docbook.org/ns/docbook") Maybe Text
forall a. Maybe a
Nothing
attrValueAsOptionalAttr :: Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr :: Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr Text
n Element
e = case Text -> Element -> Text
attrValue Text
n Element
e of
Text
"" -> Maybe (Text, Text)
forall a. Maybe a
Nothing
Text
_ -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
n, Text -> Element -> Text
attrValue Text
n Element
e)
parseInline :: PandocMonad m => Content -> DB m Inlines
parseInline :: forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Text (CData CDataKind
_ Text
s Maybe Integer
_)) = do
literalLayout <- (DBState -> Bool) -> StateT DBState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Bool
dbLiteralLayout
if literalLayout
then do
let ls = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" Text
s
let toLiteralLine = Text -> Many Inline
str (Text -> Many Inline) -> (Text -> Text) -> Text -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Char
'\xa0' else Char
c)
return $ mconcat $ intersperse linebreak $ map toLiteralLine ls
else return $ text s
parseInline (CRef Text
ref) =
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
T.toUpper Text
ref) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
lookupEntity Text
ref
parseInline (Elem Element
e) = do
parsedInline <- case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"anchor" -> do
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
spanWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [], []) Many Inline
forall a. Monoid a => a
mempty
Text
"phrase" -> do
let ident :: Text
ident = Text -> Element -> Text
attrValue Text
"id" Element
e
let classes :: [Text]
classes = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"role" Element
e
if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
|| [Text]
classes [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines (Attr -> Many Inline -> Many Inline
spanWith (Text
ident,[Text]
classes,[]))
else (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
forall a. a -> a
id
Text
"indexterm" -> do
let ident :: Text
ident = Text -> Element -> Text
attrValue Text
"id" Element
e
let classes :: [Text]
classes = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"role" Element
e
let attrs :: [Maybe (Text, Text)]
attrs =
[ Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
"primary" Element
e
, Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
"secondary" Element
e
, Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
"tertiary" Element
e
, Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
"see" Element
e
, Text -> Element -> Maybe (Text, Text)
childElTextAsAttr Text
"seealso" Element
e
, Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr Text
"significance" Element
e
, Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr Text
"startref" Element
e
, Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr Text
"scope" Element
e
, Text -> Element -> Maybe (Text, Text)
attrValueAsOptionalAttr Text
"class" Element
e
]
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Many Inline -> Many Inline
spanWith (Text
ident, (Text
"indexterm" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
classes), ([Maybe (Text, Text)] -> [(Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Text, Text)]
attrs)) Many Inline
forall a. Monoid a => a
mempty
Text
"equation" -> Element -> (Text -> Many Inline) -> StateT DBState m (Many Inline)
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
displayMath
Text
"informalequation" -> Element -> (Text -> Many Inline) -> StateT DBState m (Many Inline)
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
displayMath
Text
"inlineequation" -> Element -> (Text -> Many Inline) -> StateT DBState m (Many Inline)
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
math
Text
"subscript" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
subscript
Text
"superscript" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
superscript
Text
"inlinemediaobject" -> Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getMediaobject Element
e
Text
"quote" -> do
qt <- (DBState -> QuoteType) -> StateT DBState m QuoteType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> QuoteType
dbQuoteType
let qt' = if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
modify $ \DBState
st -> DBState
st{ dbQuoteType = qt' }
contents <- innerInlines id
modify $ \DBState
st -> DBState
st{ dbQuoteType = qt }
return $ if qt == SingleQuote
then singleQuoted contents
else doubleQuoted contents
Text
"simplelist" -> StateT DBState m (Many Inline)
simpleList
Text
"segmentedlist" -> StateT DBState m (Many Inline)
segmentedList
Text
"classname" -> StateT DBState m (Many Inline)
codeWithLang
Text
"code" -> StateT DBState m (Many Inline)
codeWithLang
Text
"citerefentry" -> do
let title :: Text
title = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty Element -> Text
strContent (Maybe Element -> Text) -> Maybe Element -> Text
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"refentrytitle") Element
e
let manvolnum :: Text
manvolnum = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (\Element
el -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
strContent Element
el Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Maybe Element -> Text) -> Maybe Element -> Text
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"manvolnum") Element
e
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
codeWith (Text
"",[Text
"citerefentry"],[]) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
manvolnum)
Text
"filename" -> StateT DBState m (Many Inline)
codeWithLang
Text
"envar" -> StateT DBState m (Many Inline)
codeWithLang
Text
"literal" -> StateT DBState m (Many Inline)
codeWithLang
Text
"computeroutput" -> StateT DBState m (Many Inline)
codeWithLang
Text
"prompt" -> StateT DBState m (Many Inline)
codeWithLang
Text
"parameter" -> StateT DBState m (Many Inline)
codeWithLang
Text
"option" -> StateT DBState m (Many Inline)
codeWithLang
Text
"optional" -> do x <- Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e
return $ str "[" <> x <> str "]"
Text
"replaceable" -> do x <- Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines Element
e
return $ str "<" <> x <> str ">"
Text
"markup" -> StateT DBState m (Many Inline)
codeWithLang
Text
"wordasword" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
emph
Text
"command" -> StateT DBState m (Many Inline)
codeWithLang
Text
"varname" -> StateT DBState m (Many Inline)
codeWithLang
Text
"function" -> StateT DBState m (Many Inline)
codeWithLang
Text
"type" -> StateT DBState m (Many Inline)
codeWithLang
Text
"symbol" -> StateT DBState m (Many Inline)
codeWithLang
Text
"constant" -> StateT DBState m (Many Inline)
codeWithLang
Text
"userinput" -> StateT DBState m (Many Inline)
codeWithLang
Text
"systemitem" -> StateT DBState m (Many Inline)
codeWithLang
Text
"varargs" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
code Text
"(...)"
Text
"keycap" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Many Inline
str (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e)
Text
"keycombo" -> [Many Inline] -> Many Inline
keycombo ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Element -> [Content]
elContent Element
e)
Text
"menuchoice" -> [Many Inline] -> Many Inline
menuchoice ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
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)
Text
"xref" -> do
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 -> Element -> Text
attrValue Text
"linkend" Element
e
let title = case Text -> Element -> Text
attrValue Text
"endterm" Element
e of
Text
"" -> Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"???" Element -> Text
xrefTitleByElem
(Text -> [Content] -> Maybe Element
findElementById Text
linkend [Content]
content)
Text
endterm -> Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"???" Element -> Text
strContent
(Text -> [Content] -> Maybe Element
findElementById Text
endterm [Content]
content)
return $ link ("#" <> linkend) "" (text title)
Text
"email" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
strContent Element
e) Text
""
(Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
str (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"uri" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Many Inline -> Many Inline
link (Element -> Text
strContent Element
e) Text
"" (Many Inline -> Many Inline) -> Many Inline -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
str (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
e
Text
"ulink" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines (Text -> Text -> Many Inline -> Many Inline
link (Text -> Element -> Text
attrValue Text
"url" Element
e) Text
"")
Text
"link" -> do
ils <- (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
forall a. a -> a
id
let href = case (QName -> Bool) -> Element -> Maybe Text
findAttrBy
(\case
QName Text
"href" Maybe Text
_ Maybe Text
_ -> Bool
True
QName
_ -> Bool
False) Element
e of
Just Text
h -> Text
h
Maybe Text
_ -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Element -> Text
attrValue Text
"linkend" Element
e
let ils' = if Many Inline
ils Many Inline -> Many Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Many Inline
forall a. Monoid a => a
mempty then Text -> Many Inline
str Text
href else Many Inline
ils
let attr = (Text -> Element -> Text
attrValue Text
"id" Element
e, Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"role" Element
e, [])
return $ linkWith attr href "" ils'
Text
"foreignphrase" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
emph
Text
"emphasis" -> case Text -> Element -> Text
attrValue Text
"role" Element
e of
Text
"bf" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
strong
Text
"bold" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
strong
Text
"strong" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
strong
Text
"strikethrough" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
strikeout
Text
"underline" -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
underline
Text
_ -> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
emph
Text
"footnote" -> Many Block -> Many Inline
note (Many Block -> Many Inline)
-> ([Many Block] -> Many Block) -> [Many Block] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> Many Inline)
-> StateT DBState m [Many Block] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT DBState m (Many Block))
-> [Content] -> StateT DBState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Block)
forall (m :: * -> *). PandocMonad m => Content -> DB m (Many Block)
parseBlock (Element -> [Content]
elContent Element
e)
Text
"title" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
Text
"affiliation" -> StateT DBState m (Many Inline)
skip
Text
"pi-asciidoc-br" -> Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
linebreak
Text
_ -> StateT DBState m (Many Inline)
skip StateT DBState m (Many Inline)
-> StateT DBState m (Many Inline) -> StateT DBState m (Many Inline)
forall a b.
StateT DBState m a -> StateT DBState m b -> StateT DBState m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Many Inline -> Many Inline) -> StateT DBState m (Many Inline)
forall {m :: * -> *} {b}.
PandocMonad m =>
(Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> Many Inline
forall a. a -> a
id
return $ case qName (elName e) of
Text
"emphasis" -> Many Inline
parsedInline
Text
_ -> [(Text, Text)] -> Many Inline -> Many Inline
forall b. HasAttributes (Cm () b) => [(Text, Text)] -> b -> b
addPandocAttributes (Element -> [(Text, Text)]
getRoleAttr Element
e) Many Inline
parsedInline
where skip :: StateT DBState m (Many Inline)
skip = do
let qn :: Text
qn = QName -> Text
qName (QName -> Text) -> QName -> Text
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e
let name :: Text
name = if Text
"pi-" Text -> Text -> Bool
`T.isPrefixOf` Text
qn
then Text
"<?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
qn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?>"
else Text
qn
m () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => m a -> StateT DBState m a
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
name
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty
innerInlines :: (Many Inline -> b) -> StateT DBState m b
innerInlines Many Inline -> b
f = Many Inline -> b
f (Many Inline -> b)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> b)
-> StateT DBState m [Many Inline] -> StateT DBState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT DBState m (Many Inline))
-> [Content] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Content -> DB m (Many Inline)
parseInline (Element -> [Content]
elContent Element
e)
codeWithLang :: StateT DBState m (Many Inline)
codeWithLang = do
let classes' :: [Text]
classes' = case Text -> Element -> Text
attrValue Text
"language" Element
e of
Text
"" -> []
Text
l -> [Text
l]
Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> StateT DBState m (Many Inline))
-> Many Inline -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Inline
codeWith (Text -> Element -> Text
attrValue Text
"id" Element
e,[Text]
classes',[]) (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
simpleList :: StateT DBState m (Many Inline)
simpleList = [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Many Inline] -> [Many Inline]) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
intersperse (Text -> Many Inline
str Text
"," Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
space) ([Many Inline] -> Many Inline)
-> StateT DBState m [Many Inline] -> StateT DBState m (Many Inline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT DBState m (Many Inline))
-> [Element] -> StateT DBState m [Many Inline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines
((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"member") Element
e)
segmentedList :: StateT DBState m (Many Inline)
segmentedList = do
tit <- StateT DBState m (Many Inline)
-> (Element -> StateT DBState m (Many Inline))
-> Maybe Element
-> StateT DBState m (Many Inline)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Many Inline -> StateT DBState m (Many Inline)
forall a. a -> StateT DBState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Many Inline
forall a. Monoid a => a
mempty) Element -> StateT DBState m (Many Inline)
forall (m :: * -> *).
PandocMonad m =>
Element -> DB m (Many Inline)
getInlines (Maybe Element -> StateT DBState m (Many Inline))
-> Maybe Element -> StateT DBState m (Many Inline)
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e
segtits <- mapM getInlines $ filterChildren (named "segtitle") e
segitems <- mapM (mapM getInlines . filterChildren (named "seg"))
$ filterChildren (named "seglistitem") e
let toSeg = [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Many Inline] -> [Many Inline]) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Inline -> Many Inline -> Many Inline)
-> [Many Inline] -> [Many Inline] -> [Many Inline]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Many Inline
x Many Inline
y -> Many Inline -> Many Inline
strong (Many Inline
x Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
":") Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
space Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<>
Many Inline
y Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
linebreak) [Many Inline]
segtits
let segs = [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ ([Many Inline] -> Many Inline) -> [[Many Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Many Inline] -> Many Inline
toSeg [[Many Inline]]
segitems
let tit' = if Many Inline
tit Many Inline -> Many Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Many Inline
forall a. Monoid a => a
mempty
then Many Inline
forall a. Monoid a => a
mempty
else Many Inline -> Many Inline
strong Many Inline
tit Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
linebreak
return $ linebreak <> tit' <> segs
keycombo :: [Many Inline] -> Many Inline
keycombo = Attr -> Many Inline -> Many Inline
spanWith (Text
"",[Text
"keycombo"],[]) (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Many Inline] -> [Many Inline]) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
intersperse (Text -> Many Inline
str Text
"+")
menuchoice :: [Many Inline] -> Many Inline
menuchoice = Attr -> Many Inline -> Many Inline
spanWith (Text
"",[Text
"menuchoice"],[]) (Many Inline -> Many Inline)
-> ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline)
-> ([Many Inline] -> [Many Inline]) -> [Many Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> [Many Inline]
forall a. a -> [a] -> [a]
intersperse (Text -> Many Inline
text Text
" > ")
isGuiMenu :: Content -> Bool
isGuiMenu (Elem Element
x) = Text -> Element -> Bool
named Text
"guimenu" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"guisubmenu" Element
x Bool -> Bool -> Bool
||
Text -> Element -> Bool
named Text
"guimenuitem" Element
x
isGuiMenu Content
_ = Bool
False
findElementById :: Text -> [Content] -> Maybe Element
findElementById Text
idString [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 (\Element
x -> Text -> Element -> Text
attrValue Text
"id" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
idString) Element
el | Elem Element
el <- [Content]
content]
xrefTitleByElem :: Element -> Text
xrefTitleByElem Element
el
| Bool -> Bool
not (Text -> Bool
T.null Text
xrefLabel) = Text
xrefLabel
| Bool
otherwise = case QName -> Text
qName (Element -> QName
elName Element
el) of
Text
"book" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"part" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"chapter" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"section" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"sect1" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"sect2" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"sect3" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"sect4" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"sect5" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"cmdsynopsis" -> Text -> Element -> Text
descendantContent Text
"command" Element
el
Text
"funcsynopsis" -> Text -> Element -> Text
descendantContent Text
"function" Element
el
Text
"figure" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
"table" -> Text -> Element -> Text
descendantContent Text
"title" Element
el
Text
_ -> QName -> Text
qName (Element -> QName
elName Element
el) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_title"
where
xrefLabel :: Text
xrefLabel = Text -> Element -> Text
attrValue Text
"xreflabel" Element
el
descendantContent :: Text -> Element -> Text
descendantContent Text
name = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"???" Element -> Text
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 (\QName
n -> QName -> Text
qName QName
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)
equation
:: Monad m
=> Element
-> (Text -> Inlines)
-> m Inlines
equation :: forall (m :: * -> *).
Monad m =>
Element -> (Text -> Many Inline) -> m (Many Inline)
equation Element
e Text -> Many Inline
constructor =
Many Inline -> m (Many Inline)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Inline -> m (Many Inline)) -> Many Inline -> m (Many Inline)
forall a b. (a -> b) -> a -> b
$ [Many Inline] -> Many Inline
forall a. Monoid a => [a] -> a
mconcat ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ (Text -> Many Inline) -> [Text] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Many Inline
constructor ([Text] -> [Many Inline]) -> [Text] -> [Many Inline]
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
(\Element
x -> QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"math" Bool -> Bool -> Bool
&&
QName -> Maybe Text
qURI (Element -> QName
elName Element
x) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML")
(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
. Element -> Text
showElement)
latexEquations :: [Text]
latexEquations :: [Text]
latexEquations = (Element -> Bool) -> (Element -> Text) -> [Text]
forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath (\Element
x -> QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"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 a b. (a -> b) -> [a] -> [b]
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 :: forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath Element -> Bool
childPredicate 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 CDataKind
_ Text
d Maybe Integer
_)) = Text
d
showVerbatimCData Content
c = Content -> Text
showContent Content
c
removePrefix :: QName -> QName
removePrefix :: QName -> QName
removePrefix QName
elname = QName
elname { qPrefix = Nothing }
paraToPlain :: Block -> Block
paraToPlain :: Block -> Block
paraToPlain (Para [Inline]
ils) = [Inline] -> Block
Plain [Inline]
ils
paraToPlain Block
x = Block
x
docbookEntityMap :: M.Map Text Text
docbookEntityMap :: Map Text Text
docbookEntityMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
((Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Text)
lineToPair (Text -> [Text]
T.lines (ByteString -> Text
decodeUtf8 ByteString
docbookEntities)))
where
lineToPair :: Text -> (Text, Text)
lineToPair Text
l =
case Text -> [Text]
T.words Text
l of
(Text
x:[Text]
ys) -> (Text
x, String -> Text
T.pack ((Text -> Maybe Char) -> [Text] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Char
readHex [Text]
ys))
[] -> (Text
"",Text
"")
readHex :: Text -> Maybe Char
readHex Text
t = case Reader Int
forall a. Integral a => Reader a
TR.hexadecimal Text
t of
Left String
_ -> Maybe Char
forall a. Maybe a
Nothing
Right (Int
n,Text
_) -> Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr Int
n)
docbookEntities :: ByteString
docbookEntities :: ByteString
docbookEntities = $(embedFile "data/docbook-entities.txt")