{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.DocBook
   Copyright   : Copyright (C) 2006-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Conversion of DocBook XML to 'Pandoc' document.
-}
module Text.Pandoc.Readers.DocBook ( readDocBook ) where
import Control.Monad.State.Strict
import Data.Char (isSpace, toUpper)
import Data.Default
import Data.Either (rights)
import Data.Foldable (asum)
import Data.Generics
import Data.List (intersperse,elemIndex)
import Data.Maybe (fromMaybe,mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Options
import Text.Pandoc.Logging (LogMessage(..))
import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces)
import Text.TeXMath (readMathML, writeTeX)
import Text.XML.Light

{-

List of all DocBook tags, with [x] indicating implemented,
[o] meaning intentionally left unimplemented (pass through):

[o] abbrev - An abbreviation, especially one followed by a period
[x] abstract - A summary
[o] accel - A graphical user interface (GUI) keyboard shortcut
[x] ackno - Acknowledgements in an Article
[o] acronym - An often pronounceable word made from the initial
[o] action - A response to a user event
[o] address - A real-world address, generally a postal address
[ ] affiliation - The institutional affiliation of an individual
[ ] alt - Text representation for a graphical element
[x] anchor - A spot in the document
[x] answer - An answer to a question posed in a QandASet
[x] appendix - An appendix in a Book or Article
[x] appendixinfo - Meta-information for an Appendix
[o] application - The name of a software program
[x] area - A region defined for a Callout in a graphic or code example
[x] areaset - A set of related areas in a graphic or code example
[x] areaspec - A collection of regions in a graphic or code example
[ ] arg - An argument in a CmdSynopsis
[x] article - An article
[x] articleinfo - Meta-information for an Article
[ ] artpagenums - The page numbers of an article as published
[x] attribution - The source of a block quote or epigraph
[ ] audiodata - Pointer to external audio data
[ ] audioobject - A wrapper for audio data and its associated meta-information
[x] author - The name of an individual author
[ ] authorblurb - A short description or note about an author
[x] authorgroup - Wrapper for author information when a document has
    multiple authors or collaborators
[x] authorinitials - The initials or other short identifier for an author
[o] beginpage - The location of a page break in a print version of the document
[ ] bibliocoverage - The spatial or temporal coverage of a document
[x] bibliodiv - A section of a Bibliography
[x] biblioentry - An entry in a Bibliography
[x] bibliography - A bibliography
[ ] bibliographyinfo - Meta-information for a Bibliography
[ ] biblioid - An identifier for a document
[o] bibliolist - A wrapper for a set of bibliography entries
[x] bibliomisc - Untyped bibliographic information
[x] bibliomixed - An entry in a Bibliography
[ ] bibliomset - A cooked container for related bibliographic information
[ ] biblioref - A cross reference to a bibliographic entry
[ ] bibliorelation - The relationship of a document to another
[ ] biblioset - A raw container for related bibliographic information
[ ] bibliosource - The source of a document
[ ] blockinfo - Meta-information for a block element
[x] blockquote - A quotation set off from the main text
[x] book - A book
[x] bookinfo - Meta-information for a Book
[x] bridgehead - A free-floating heading
[x] callout - A “called out” description of a marked Area
[x] calloutlist - A list of Callouts
[x] caption - A caption
[x] caution - A note of caution
[x] chapter - A chapter, as of a book
[x] chapterinfo - Meta-information for a Chapter
[ ] citation - An inline bibliographic reference to another published work
[ ] citebiblioid - A citation of a bibliographic identifier
[ ] citerefentry - A citation to a reference page
[ ] citetitle - The title of a cited work
[ ] city - The name of a city in an address
[x] classname - The name of a class, in the object-oriented programming sense
[ ] classsynopsis - The syntax summary for a class definition
[ ] classsynopsisinfo - Information supplementing the contents of
    a ClassSynopsis
[ ] cmdsynopsis - A syntax summary for a software command
[ ] co - The location of a callout embedded in text
[x] code - An inline code fragment
[x] col - Specifications for a column in an HTML table
[x] colgroup - A group of columns in an HTML table
[ ] collab - Identifies a collaborator
[ ] collabname - The name of a collaborator
[ ] colophon - Text at the back of a book describing facts about its production
[x] colspec - Specifications for a column in a table
[x] command - The name of an executable program or other software command
[x] computeroutput - Data, generally text, displayed or presented by a computer
[ ] confdates - The dates of a conference for which a document was written
[ ] confgroup - A wrapper for document meta-information about a conference
[ ] confnum - An identifier, frequently numerical, associated with a conference for which a document was written
[ ] confsponsor - The sponsor of a conference for which a document was written
[ ] conftitle - The title of a conference for which a document was written
[x] constant - A programming or system constant
[ ] constraint - A constraint in an EBNF production
[ ] constraintdef - The definition of a constraint in an EBNF production
[ ] constructorsynopsis - A syntax summary for a constructor
[ ] contractnum - The contract number of a document
[ ] contractsponsor - The sponsor of a contract
[ ] contrib - A summary of the contributions made to a document by a
    credited source
[ ] copyright - Copyright information about a document
[ ] coref - A cross reference to a co
[ ] corpauthor - A corporate author, as opposed to an individual
[ ] corpcredit - A corporation or organization credited in a document
[ ] corpname - The name of a corporation
[ ] country - The name of a country
[ ] database - The name of a database, or part of a database
[x] date - The date of publication or revision of a document
[ ] dedication - A wrapper for the dedication section of a book
[ ] destructorsynopsis - A syntax summary for a destructor
[ ] edition - The name or number of an edition of a document
[ ] editor - The name of the editor of a document
[x] email - An email address
[x] emphasis - Emphasized text
[x] entry - A cell in a table
[ ] entrytbl - A subtable appearing in place of an Entry in a table
[x] envar - A software environment variable
[x] epigraph - A short inscription at the beginning of a document or component
    note:  also handle embedded attribution tag
[x] equation - A displayed mathematical equation
[ ] errorcode - An error code
[ ] errorname - An error name
[ ] errortext - An error message.
[ ] errortype - The classification of an error message
[ ] example - A formal example, with a title
[ ] exceptionname - The name of an exception
[ ] fax - A fax number
[ ] fieldsynopsis - The name of a field in a class definition
[x] figure - A formal figure, generally an illustration, with a title
[x] filename - The name of a file
[ ] firstname - The first name of a person
[ ] firstterm - The first occurrence of a term
[x] footnote - A footnote
[ ] footnoteref - A cross reference to a footnote (a footnote mark)
[x] foreignphrase - A word or phrase in a language other than the primary
    language of the document
[x] formalpara - A paragraph with a title
[ ] funcdef - A function (subroutine) name and its return type
[ ] funcparams - Parameters for a function referenced through a function
    pointer in a synopsis
[ ] funcprototype - The prototype of a function
[ ] funcsynopsis - The syntax summary for a function definition
[ ] funcsynopsisinfo - Information supplementing the FuncDefs of a FuncSynopsis
[x] function - The name of a function or subroutine, as in a
    programming language
[x] glossary - A glossary
[x] glossaryinfo - Meta-information for a Glossary
[x] glossdef - A definition in a GlossEntry
[x] glossdiv - A division in a Glossary
[x] glossentry - An entry in a Glossary or GlossList
[x] glosslist - A wrapper for a set of GlossEntrys
[x] glosssee - A cross-reference from one GlossEntry to another
[x] glossseealso - A cross-reference from one GlossEntry to another
[x] glossterm - A glossary term
[ ] graphic - A displayed graphical object (not an inline)
    Note: in DocBook v5 `graphic` is discarded
[ ] graphicco - A graphic that contains callout areas
    Note: in DocBook v5 `graphicco` is discarded
[ ] group - A group of elements in a CmdSynopsis
[ ] guibutton - The text on a button in a GUI
[ ] guiicon - Graphic and/or text appearing as a icon in a GUI
[ ] guilabel - The text of a label in a GUI
[x] guimenu - The name of a menu in a GUI
[x] guimenuitem - The name of a terminal menu item in a GUI
[x] guisubmenu - The name of a submenu in a GUI
[ ] hardware - A physical part of a computer system
[ ] highlights - A summary of the main points of the discussed component
[ ] holder - The name of the individual or organization that holds a copyright
[o] honorific - The title of a person
[ ] html:form - An HTML form
[x] imagedata - Pointer to external image data (only `fileref` attribute
    implemented but not `entityref` which would require parsing of the DTD)
[x] imageobject - A wrapper for image data and its associated meta-information
[ ] imageobjectco - A wrapper for an image object with callouts
[x] important - An admonition set off from the text
[x] index - An index
[x] indexdiv - A division in an index
[x] indexentry - An entry in an index
[x] indexinfo - Meta-information for an Index
[x] indexterm - A wrapper for terms to be indexed
[x] info - A wrapper for information about a component or other block. (DocBook v5)
[x] informalequation - A displayed mathematical equation without a title
[x] informalexample - A displayed example without a title
[ ] informalfigure - A untitled figure
[ ] informaltable - A table without a title
[ ] initializer - The initializer for a FieldSynopsis
[x] inlineequation - A mathematical equation or expression occurring inline
[ ] inlinegraphic - An object containing or pointing to graphical data
    that will be rendered inline
[x] inlinemediaobject - An inline media object (video, audio, image, and so on)
[ ] interface - An element of a GUI
[ ] interfacename - The name of an interface
[ ] invpartnumber - An inventory part number
[ ] isbn - The International Standard Book Number of a document
[ ] issn - The International Standard Serial Number of a periodical
[ ] issuenum - The number of an issue of a journal
[x] itemizedlist - A list in which each entry is marked with a bullet or
    other dingbat
[ ] itermset - A set of index terms in the meta-information of a document
[ ] jobtitle - The title of an individual in an organization
[x] keycap - The text printed on a key on a keyboard
[ ] keycode - The internal, frequently numeric, identifier for a key
    on a keyboard
[x] keycombo - A combination of input actions
[ ] keysym - The symbolic name of a key on a keyboard
[ ] keyword - One of a set of keywords describing the content of a document
[ ] keywordset - A set of keywords describing the content of a document
[ ] label - A label on a Question or Answer
[ ] legalnotice - A statement of legal obligations or requirements
[ ] lhs - The left-hand side of an EBNF production
[ ] lineage - The portion of a person's name indicating a relationship to
    ancestors
[ ] lineannotation - A comment on a line in a verbatim listing
[x] link - A hypertext link
[x] listitem - A wrapper for the elements of a list item
[x] literal - Inline text that is some literal value
[x] literallayout - A block of text in which line breaks and white space are
    to be reproduced faithfully
[ ] lot - A list of the titles of formal objects (as tables or figures) in
    a document
[ ] lotentry - An entry in a list of titles
[ ] manvolnum - A reference volume number
[x] markup - A string of formatting markup in text that is to be
    represented literally
[x] mathphrase - A mathematical phrase, an expression that can be represented
    with ordinary text and a small amount of markup
[ ] medialabel - A name that identifies the physical medium on which some
    information resides
[x] mediaobject - A displayed media object (video, audio, image, etc.)
[ ] mediaobjectco - A media object that contains callouts
[x] member - An element of a simple list
[x] menuchoice - A selection or series of selections from a menu
[ ] methodname - The name of a method
[ ] methodparam - Parameters to a method
[ ] methodsynopsis - A syntax summary for a method
[x] mml:math - A MathML equation
[ ] modespec - Application-specific information necessary for the
    completion of an OLink
[ ] modifier - Modifiers in a synopsis
[ ] mousebutton - The conventional name of a mouse button
[ ] msg - A message in a message set
[ ] msgaud - The audience to which a message in a message set is relevant
[ ] msgentry - A wrapper for an entry in a message set
[ ] msgexplan - Explanatory material relating to a message in a message set
[ ] msginfo - Information about a message in a message set
[ ] msglevel - The level of importance or severity of a message in a message set
[ ] msgmain - The primary component of a message in a message set
[ ] msgorig - The origin of a message in a message set
[ ] msgrel - A related component of a message in a message set
[ ] msgset - A detailed set of messages, usually error messages
[ ] msgsub - A subcomponent of a message in a message set
[ ] msgtext - The actual text of a message component in a message set
[ ] nonterminal - A non-terminal in an EBNF production
[x] note - A message set off from the text
[ ] objectinfo - Meta-information for an object
[ ] olink - A link that addresses its target indirectly, through an entity
[ ] ooclass - A class in an object-oriented programming language
[ ] ooexception - An exception in an object-oriented programming language
[ ] oointerface - An interface in an object-oriented programming language
[x] option - An option for a software command
[x] optional - Optional information
[x] orderedlist - A list in which each entry is marked with a sequentially
    incremented label
[ ] orgdiv - A division of an organization
[ ] orgname - The name of an organization other than a corporation
[ ] otheraddr - Uncategorized information in address
[ ] othercredit - A person or entity, other than an author or editor,
    credited in a document
[ ] othername - A component of a persons name that is not a first name,
    surname, or lineage
[ ] package - A package
[ ] pagenums - The numbers of the pages in a book, for use in a bibliographic
    entry
[x] para - A paragraph
[ ] paramdef - Information about a function parameter in a programming language
[x] parameter - A value or a symbolic reference to a value
[ ] part - A division in a book
[ ] partinfo - Meta-information for a Part
[ ] partintro - An introduction to the contents of a part
[ ] personblurb - A short description or note about a person
[ ] personname - The personal name of an individual
[ ] phone - A telephone number
[x] phrase - A span of text
[ ] pob - A post office box in an address
[ ] postcode - A postal code in an address
[x] preface - Introductory matter preceding the first chapter of a book
[ ] prefaceinfo - Meta-information for a Preface
[ ] primary - The primary word or phrase under which an index term should be
    sorted
[ ] primaryie - A primary term in an index entry, not in the text
[ ] printhistory - The printing history of a document
[x] procedure - A list of operations to be performed in a well-defined sequence
[ ] production - A production in a set of EBNF productions
[ ] productionrecap - A cross-reference to an EBNF production
[ ] productionset - A set of EBNF productions
[ ] productname - The formal name of a product
[ ] productnumber - A number assigned to a product
[x] programlisting - A literal listing of all or part of a program
[ ] programlistingco - A program listing with associated areas used in callouts
[x] prompt - A character or string indicating the start of an input field in
    a computer display
[ ] property - A unit of data associated with some part of a computer system
[ ] pubdate - The date of publication of a document
[ ] publisher - The publisher of a document
[ ] publishername - The name of the publisher of a document
[ ] pubsnumber - A number assigned to a publication other than an ISBN or ISSN
    or inventory part number
[x] qandadiv - A titled division in a QandASet
[o] qandaentry - A question/answer set within a QandASet
[o] qandaset - A question-and-answer set
[x] question - A question in a QandASet
[x] quote - An inline quotation
[ ] refclass - The scope or other indication of applicability of a
    reference entry
[ ] refdescriptor - A description of the topic of a reference page
[ ] refentry - A reference page (originally a UNIX man-style reference page)
[ ] refentryinfo - Meta-information for a Refentry
[ ] refentrytitle - The title of a reference page
[ ] reference - A collection of reference entries
[ ] referenceinfo - Meta-information for a Reference
[ ] refmeta - Meta-information for a reference entry
[ ] refmiscinfo - Meta-information for a reference entry other than the title
    and volume number
[ ] refname - The name of (one of) the subject(s) of a reference page
[ ] refnamediv - The name, purpose, and classification of a reference page
[ ] refpurpose - A short (one sentence) synopsis of the topic of a reference
    page
[x] refsect1 - A major subsection of a reference entry
[x] refsect1info - Meta-information for a RefSect1
[x] refsect2 - A subsection of a RefSect1
[x] refsect2info - Meta-information for a RefSect2
[x] refsect3 - A subsection of a RefSect2
[x] refsect3info - Meta-information for a RefSect3
[x] refsection - A recursive section in a refentry
[x] refsectioninfo - Meta-information for a refsection
[ ] refsynopsisdiv - A syntactic synopsis of the subject of the reference page
[ ] refsynopsisdivinfo - Meta-information for a RefSynopsisDiv
[ ] releaseinfo - Information about a particular release of a document
[ ] remark - A remark (or comment) intended for presentation in a draft
    manuscript
[x] replaceable - Content that may or must be replaced by the user
[ ] returnvalue - The value returned by a function
[ ] revdescription - A extended description of a revision to a document
[ ] revhistory - A history of the revisions to a document
[ ] revision - An entry describing a single revision in the history of the
    revisions to a document
[ ] revnumber - A document revision number
[ ] revremark - A description of a revision to a document
[ ] rhs - The right-hand side of an EBNF production
[x] row - A row in a table
[ ] sbr - An explicit line break in a command synopsis
[x] screen - Text that a user sees or might see on a computer screen
[o] screenco - A screen with associated areas used in callouts
[o] screeninfo - Information about how a screen shot was produced
[ ] screenshot - A representation of what the user sees or might see on a
    computer screen
[ ] secondary - A secondary word or phrase in an index term
[ ] secondaryie - A secondary term in an index entry, rather than in the text
[x] sect1 - A top-level section of document
[x] sect1info - Meta-information for a Sect1
[x] sect2 - A subsection within a Sect1
[x] sect2info - Meta-information for a Sect2
[x] sect3 - A subsection within a Sect2
[x] sect3info - Meta-information for a Sect3
[x] sect4 - A subsection within a Sect3
[x] sect4info - Meta-information for a Sect4
[x] sect5 - A subsection within a Sect4
[x] sect5info - Meta-information for a Sect5
[x] section - A recursive section
[x] sectioninfo - Meta-information for a recursive section
[x] see - Part of an index term directing the reader instead to another entry
    in the index
[x] seealso - Part of an index term directing the reader also to another entry
    in the index
[ ] seealsoie - A See also entry in an index, rather than in the text
[ ] seeie - A See entry in an index, rather than in the text
[x] seg - An element of a list item in a segmented list
[x] seglistitem - A list item in a segmented list
[x] segmentedlist - A segmented list, a list of sets of elements
[x] segtitle - The title of an element of a list item in a segmented list
[ ] seriesvolnums - Numbers of the volumes in a series of books
[ ] set - A collection of books
[ ] setindex - An index to a set of books
[ ] setindexinfo - Meta-information for a SetIndex
[ ] setinfo - Meta-information for a Set
[ ] sgmltag - A component of SGML markup
[ ] shortaffil - A brief description of an affiliation
[ ] shortcut - A key combination for an action that is also accessible through
    a menu
[ ] sidebar - A portion of a document that is isolated from the main
    narrative flow
[ ] sidebarinfo - Meta-information for a Sidebar
[x] simpara - A paragraph that contains only text and inline markup, no block
    elements
[x] simplelist - An undecorated list of single words or short phrases
[ ] simplemsgentry - A wrapper for a simpler entry in a message set
[x] simplesect - A section of a document with no subdivisions
[ ] spanspec - Formatting information for a spanned column in a table
[ ] state - A state or province in an address
[x] step - A unit of action in a procedure
[ ] stepalternatives - Alternative steps in a procedure
[ ] street - A street address in an address
[ ] structfield - A field in a structure (in the programming language sense)
[ ] structname - The name of a structure (in the programming language sense)
[ ] subject - One of a group of terms describing the subject matter of a
    document
[ ] subjectset - A set of terms describing the subject matter of a document
[ ] subjectterm - A term in a group of terms describing the subject matter of
    a document
[x] subscript - A subscript (as in H2O, the molecular formula for water)
[x] substeps - A wrapper for steps that occur within steps in a procedure
[x] subtitle - The subtitle of a document
[x] superscript - A superscript (as in x2, the mathematical notation for x
    multiplied by itself)
[ ] surname - A family name; in western cultures the last name
[ ] svg:svg - An SVG graphic
[x] symbol - A name that is replaced by a value before processing
[ ] synopfragment - A portion of a CmdSynopsis broken out from the main body
    of the synopsis
[ ] synopfragmentref - A reference to a fragment of a command synopsis
[ ] synopsis - A general-purpose element for representing the syntax of
    commands or functions
[x] systemitem - A system-related item or term
[ ] table - A formal table in a document
[ ] task - A task to be completed
[ ] taskprerequisites - The prerequisites for a task
[ ] taskrelated - Information related to a task
[ ] tasksummary - A summary of a task
[x] tbody - A wrapper for the rows of a table or informal table
[x] td - A table entry in an HTML table
[x] term - The word or phrase being defined or described in a variable list
[ ] termdef - An inline term definition
[ ] tertiary - A tertiary word or phrase in an index term
[ ] tertiaryie - A tertiary term in an index entry, rather than in the text
[ ] textdata - Pointer to external text data
[ ] textobject - A wrapper for a text description of an object and its
    associated meta-information
[ ] tfoot - A table footer consisting of one or more rows
[x] tgroup - A wrapper for the main content of a table, or part of a table
[x] th - A table header entry in an HTML table
[x] thead - A table header consisting of one or more rows
[x] tip - A suggestion to the user, set off from the text
[x] title - The text of the title of a section of a document or of a formal
    block-level element
[x] titleabbrev - The abbreviation of a Title
[x] toc - A table of contents
[x] tocback - An entry in a table of contents for a back matter component
[x] tocchap - An entry in a table of contents for a component in the body of
    a document
[x] tocentry - A component title in a table of contents
[x] tocfront - An entry in a table of contents for a front matter component
[x] toclevel1 - A top-level entry within a table of contents entry for a
    chapter-like component
[x] toclevel2 - A second-level entry within a table of contents entry for a
    chapter-like component
[x] toclevel3 - A third-level entry within a table of contents entry for a
    chapter-like component
[x] toclevel4 - A fourth-level entry within a table of contents entry for a
    chapter-like component
[x] toclevel5 - A fifth-level entry within a table of contents entry for a
    chapter-like component
[x] tocpart - An entry in a table of contents for a part of a book
[ ] token - A unit of information
[x] tr - A row in an HTML table
[ ] trademark - A trademark
[x] type - The classification of a value
[x] ulink - A link that addresses its target by means of a URL
    (Uniform Resource Locator)
[x] uri - A Uniform Resource Identifier
[x] userinput - Data entered by the user
[x] varargs - An empty element in a function synopsis indicating a variable
    number of arguments
[x] variablelist - A list in which each entry is composed of a set of one or
    more terms and an associated description
[x] varlistentry - A wrapper for a set of terms and the associated description
    in a variable list
[x] varname - The name of a variable
[ ] videodata - Pointer to external video data
[ ] videoobject - A wrapper for video data and its associated meta-information
[ ] void - An empty element in a function synopsis indicating that the
    function in question takes no arguments
[ ] volumenum - The volume number of a document in a set (as of books in a set
    or articles in a journal)
[x] warning - An admonition set off from the text
[x] wordasword - A word meant specifically as a word and not representing
    anything else
[x] xref - A cross reference to another part of the document
[ ] year - The year of publication of a document
[x] ?asciidoc-br? - line break from asciidoc docbook output
-}

type DB m = StateT DBState m

data DBState = DBState{ DBState -> Int
dbSectionLevel :: Int
                      , DBState -> QuoteType
dbQuoteType    :: QuoteType
                      , DBState -> Meta
dbMeta         :: Meta
                      , DBState -> Bool
dbBook         :: Bool
                      , DBState -> Inlines
dbFigureTitle  :: Inlines
                      , DBState -> Text
dbFigureId     :: Text
                      , DBState -> [Content]
dbContent      :: [Content]
                      } deriving Int -> DBState -> ShowS
[DBState] -> ShowS
DBState -> String
(Int -> DBState -> ShowS)
-> (DBState -> String) -> ([DBState] -> ShowS) -> Show DBState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBState] -> ShowS
$cshowList :: [DBState] -> ShowS
show :: DBState -> String
$cshow :: DBState -> String
showsPrec :: Int -> DBState -> ShowS
$cshowsPrec :: Int -> DBState -> ShowS
Show

instance Default DBState where
  def :: DBState
def = DBState :: Int
-> QuoteType
-> Meta
-> Bool
-> Inlines
-> Text
-> [Content]
-> DBState
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
               , dbFigureTitle :: Inlines
dbFigureTitle = Inlines
forall a. Monoid a => a
mempty
               , dbFigureId :: Text
dbFigureId = Text
forall a. Monoid a => a
mempty
               , dbContent :: [Content]
dbContent = [] }


readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readDocBook :: ReaderOptions -> Text -> m Pandoc
readDocBook ReaderOptions
_ Text
inp = do
  let tree :: [Content]
tree = [Content] -> [Content]
normalizeTree ([Content] -> [Content])
-> (Text -> [Content]) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML (Text -> [Content]) -> (Text -> Text) -> Text -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
handleInstructions (Text -> [Content]) -> Text -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
inp
  ([Blocks]
bs, DBState
st') <- (StateT DBState m [Blocks] -> DBState -> m ([Blocks], DBState))
-> DBState -> StateT DBState m [Blocks] -> m ([Blocks], DBState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT DBState m [Blocks] -> DBState -> m ([Blocks], DBState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DBState
forall a. Default a => a
def{ dbContent :: [Content]
dbContent = [Content]
tree }) (StateT DBState m [Blocks] -> m ([Blocks], DBState))
-> StateT DBState m [Blocks] -> m ([Blocks], DBState)
forall a b. (a -> b) -> a -> b
$ (Content -> StateT DBState m Blocks)
-> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock [Content]
tree
  Pandoc -> m Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (DBState -> Meta
dbMeta DBState
st') (Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> [Block]) -> [Blocks] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks]
bs)

-- We treat <?asciidoc-br?> specially (issue #1236), converting it
-- to <br/>, since xml-light doesn't parse the instruction correctly.
-- Other xml instructions are simply removed from the input stream.
handleInstructions :: Text -> Text
handleInstructions :: Text -> Text
handleInstructions = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
handleInstructions' ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

handleInstructions' :: String -> String
handleInstructions' :: ShowS
handleInstructions' (Char
'<':Char
'?':Char
'a':Char
's':Char
'c':Char
'i':Char
'i':Char
'd':Char
'o':Char
'c':Char
'-':Char
'b':Char
'r':Char
'?':Char
'>':String
xs) = Char
'<'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'b'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'r'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'/'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'>'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
handleInstructions' String
xs
handleInstructions' String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'<') String
xs of
                             (String
ys, [])     -> String
ys
                             ([], Char
'<':String
zs) -> Char
'<' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
handleInstructions' String
zs
                             (String
ys, String
zs)     -> String
ys String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
handleInstructions' String
zs

getFigure :: PandocMonad m => Element -> DB m Blocks
getFigure :: Element -> DB m Blocks
getFigure Element
e = do
  Inlines
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
              Just Element
t  -> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
              Maybe Element
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
  let ident :: Text
ident = String -> Element -> Text
attrValue String
"id" Element
e
  (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbFigureTitle :: Inlines
dbFigureTitle = Inlines
tit, dbFigureId :: Text
dbFigureId = Text
ident }
  Blocks
res <- Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
  (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbFigureTitle :: Inlines
dbFigureTitle = Inlines
forall a. Monoid a => a
mempty, dbFigureId :: Text
dbFigureId = Text
forall a. Monoid a => a
mempty }
  Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
res

-- normalize input, consolidating adjacent Text and CRef elements
normalizeTree :: [Content] -> [Content]
normalizeTree :: [Content] -> [Content]
normalizeTree = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([Content] -> [Content]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [Content] -> [Content]
go)
  where go :: [Content] -> [Content]
        go :: [Content] -> [Content]
go (Text (CData CDataKind
CDataRaw String
_ Maybe Line
_):[Content]
xs) = [Content]
xs
        go (Text (CData CDataKind
CDataText String
s1 Maybe Line
z):Text (CData CDataKind
CDataText String
s2 Maybe Line
_):[Content]
xs) =
           CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
        go (Text (CData CDataKind
CDataText String
s1 Maybe Line
z):CRef String
r:[Content]
xs) =
           CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
        go (CRef String
r:Text (CData CDataKind
CDataText String
s1 Maybe Line
z):[Content]
xs) =
             CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s1) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
        go (CRef String
r1:CRef String
r2:[Content]
xs) =
             CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r2) Maybe Line
forall a. Maybe a
Nothing)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
        go [Content]
xs = [Content]
xs

convertEntity :: String -> String
convertEntity :: ShowS
convertEntity String
e = String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
e) (String -> Maybe String
lookupEntity String
e)

-- convenience function to get an attribute value, defaulting to ""
attrValue :: String -> Element -> Text
attrValue :: String -> Element -> Text
attrValue String
attr Element
elt =
  Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" String -> Text
T.pack ((QName -> Bool) -> [Attr] -> Maybe String
lookupAttrBy (\QName
x -> QName -> String
qName QName
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
attr) (Element -> [Attr]
elAttribs Element
elt))

-- convenience function
named :: Text -> Element -> Bool
named :: Text -> Element -> Bool
named Text
s Element
e = QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> String
T.unpack Text
s

--

addMetadataFromElement :: PandocMonad m => Element -> DB m Blocks
addMetadataFromElement :: Element -> DB m Blocks
addMetadataFromElement Element
e = do
    case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
         Maybe Element
Nothing -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just Element
z  -> do
           Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
z DB m Inlines
-> (Inlines -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
"title"
           Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"subtitle" Element
z
    case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"authorgroup") Element
e of
         Maybe Element
Nothing -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just Element
z  -> Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"author" Element
z
    Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"subtitle" Element
e
    Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"author" Element
e
    Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"date" Element
e
    Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"release" Element
e
    Text -> Element -> StateT DBState m ()
forall (m :: * -> *).
PandocMonad m =>
Text -> Element -> StateT DBState m ()
addMetaField Text
"releaseinfo" Element
e
    Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
  where addMetaField :: Text -> Element -> StateT DBState m ()
addMetaField Text
fieldname Element
elt =
            case (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
fieldname) Element
elt of
                   []  -> () -> StateT DBState m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   [Element
z] -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
z DB m Inlines
-> (Inlines -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname
                   [Element]
zs  -> (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
zs StateT DBState m [Inlines]
-> ([Inlines] -> StateT DBState m ()) -> StateT DBState m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Inlines] -> StateT DBState m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> DB m ()
addMeta Text
fieldname

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

instance HasMeta DBState where
  setMeta :: Text -> b -> DBState -> DBState
setMeta Text
field b
v DBState
s =  DBState
s {dbMeta :: Meta
dbMeta = Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
v (DBState -> Meta
dbMeta DBState
s)}
  deleteMeta :: Text -> DBState -> DBState
deleteMeta Text
field DBState
s = DBState
s {dbMeta :: Meta
dbMeta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (DBState -> Meta
dbMeta DBState
s)}

isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem Element
e) = QName -> String
qName (Element -> QName
elName Element
e) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
blockTags
isBlockElement Content
_ = Bool
False

blockTags :: [String]
blockTags :: [String]
blockTags =
  [ String
"abstract"
  , String
"ackno"
  , String
"answer"
  , String
"appendix"
  , String
"appendixinfo"
  , String
"area"
  , String
"areaset"
  , String
"areaspec"
  , String
"article"
  , String
"articleinfo"
  , String
"attribution"
  , String
"authorinitials"
  , String
"bibliodiv"
  , String
"biblioentry"
  , String
"bibliography"
  , String
"bibliomisc"
  , String
"bibliomixed"
  , String
"blockquote"
  , String
"book"
  , String
"bookinfo"
  , String
"bridgehead"
  , String
"calloutlist"
  , String
"caption"
  , String
"chapter"
  , String
"chapterinfo"
  , String
"epigraph"
  , String
"example"
  , String
"figure"
  , String
"formalpara"
  , String
"glossary"
  , String
"glossaryinfo"
  , String
"glossdiv"
  , String
"glossee"
  , String
"glosseealso"
  , String
"glosslist"
  , String
"glosssee"
  , String
"glossseealso"
  , String
"index"
  , String
"info"
  , String
"informalexample"
  , String
"informaltable"
  , String
"itemizedlist"
  , String
"linegroup"
  , String
"literallayout"
  , String
"mediaobject"
  , String
"orderedlist"
  , String
"para"
  , String
"preface"
  , String
"procedure"
  , String
"programlisting"
  , String
"qandadiv"
  , String
"question"
  , String
"refsect1"
  , String
"refsect1info"
  , String
"refsect2"
  , String
"refsect2info"
  , String
"refsect3"
  , String
"refsect3info"
  , String
"refsection"
  , String
"refsectioninfo"
  , String
"screen"
  , String
"sect1"
  , String
"sect1info"
  , String
"sect2"
  , String
"sect2info"
  , String
"sect3"
  , String
"sect3info"
  , String
"sect4"
  , String
"sect4info"
  , String
"sect5"
  , String
"sect5info"
  , String
"section"
  , String
"sectioninfo"
  , String
"simpara"
  , String
"simplesect"
  , String
"substeps"
  , String
"subtitle"
  , String
"table"
  , String
"title"
  , String
"titleabbrev"
  , String
"toc"
  , String
"variablelist"
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
admonitionTags

admonitionTags :: [String]
admonitionTags :: [String]
admonitionTags = [String
"important",String
"caution",String
"note",String
"tip",String
"warning"]

-- Trim leading and trailing newline characters
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')

-- meld text into beginning of first paragraph of Blocks.
-- assumes Blocks start with a Para; if not, does nothing.
addToStart :: Inlines -> Blocks -> Blocks
addToStart :: Inlines -> Blocks -> Blocks
addToStart Inlines
toadd Blocks
bs =
  case Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
bs of
    (Para [Inline]
xs : [Block]
rest) -> Inlines -> Blocks
para (Inlines
toadd Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Inlines
forall a. [a] -> Many a
fromList [Inline]
xs) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Block] -> Blocks
forall a. [a] -> Many a
fromList [Block]
rest
    [Block]
_                -> Blocks
bs

-- function that is used by both mediaobject (in parseBlock)
-- and inlinemediaobject (in parseInline)
-- A DocBook mediaobject is a wrapper around a set of alternative presentations
getMediaobject :: PandocMonad m => Element -> DB m Inlines
getMediaobject :: Element -> DB m Inlines
getMediaobject Element
e = do
  Inlines
figTitle <- (DBState -> Inlines) -> DB m Inlines
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Inlines
dbFigureTitle
  Text
ident <- (DBState -> Text) -> StateT DBState m Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Text
dbFigureId
  (Text
imageUrl, Attr
attr) <-
    case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"imageobject") Element
e of
      Maybe Element
Nothing  -> (Text, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
      Just Element
z   -> case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"imagedata") Element
z of
                    Maybe Element
Nothing -> (Text, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
forall a. Monoid a => a
mempty, Attr
nullAttr)
                    Just Element
i  -> let atVal :: String -> Text
atVal String
a = String -> Element -> Text
attrValue String
a Element
i
                                   w :: [(Text, Text)]
w = case String -> Text
atVal String
"width" of
                                         Text
"" -> []
                                         Text
d  -> [(Text
"width", Text
d)]
                                   h :: [(Text, Text)]
h = case String -> Text
atVal String
"depth" of
                                         Text
"" -> []
                                         Text
d  -> [(Text
"height", Text
d)]
                                   id' :: Text
id' = case String -> Text
atVal String
"id" of
                                           Text
x | Text -> Bool
T.null Text
x  -> Text
ident
                                             | Bool
otherwise -> Text
x
                                   cs :: [Text]
cs = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
atVal String
"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, Attr) -> StateT DBState m (Text, Attr)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
atVal String
"fileref", Attr
atr)
  let getCaption :: Element -> StateT DBState m Inlines
getCaption Element
el = 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
el of
                        Maybe Element
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
                        Just Element
z  -> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> StateT DBState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                         (Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
z)
  let (DB m Inlines
capt, Text
title) = if Inlines -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Inlines
figTitle
                         then (Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getCaption Element
e, Text
"")
                         else (Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
figTitle, Text
"fig:")
  (Inlines -> Inlines) -> DB m Inlines -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
attr Text
imageUrl Text
title) DB m Inlines
capt

getBlocks :: PandocMonad m => Element -> DB m Blocks
getBlocks :: Element -> DB m Blocks
getBlocks Element
e =  [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Content -> DB m Blocks) -> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock (Element -> [Content]
elContent Element
e)


parseBlock :: PandocMonad m => Content -> DB m Blocks
parseBlock :: Content -> DB m Blocks
parseBlock (Text (CData CDataKind
CDataRaw String
_ Maybe Line
_)) = Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty -- DOCTYPE
parseBlock (Text (CData CDataKind
_ String
s Maybe Line
_)) = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s
                                     then Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
                                     else Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseBlock (CRef String
x) = Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
parseBlock (Elem Element
e) =
  case QName -> String
qName (Element -> QName
elName Element
e) of
        String
"toc"   -> DB m Blocks
skip -- skip TOC, since in pandoc it's autogenerated
        String
"index" -> DB m Blocks
skip -- skip index, since page numbers meaningless
        String
"para"  -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"formalpara" -> do
           Blocks
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
                        Just Element
t  -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
strong (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
".") (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                     Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
                        Maybe Element
Nothing -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
           (Blocks
tit Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<>) (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"simpara"  -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"ackno"  -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"epigraph" -> DB m Blocks
parseBlockquote
        String
"blockquote" -> DB m Blocks
parseBlockquote
        String
"attribution" -> DB m Blocks
skip
        String
"titleabbrev" -> DB m Blocks
skip
        String
"authorinitials" -> DB m Blocks
skip
        String
"bibliography" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
0
        String
"bibliodiv" ->
          case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
            Just Element
_  -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
1
            Maybe Element
Nothing -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
        String
"biblioentry" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"bibliomisc" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"bibliomixed" -> (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
        String
"equation"         -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Inlines) -> StateT DBState m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
        String
"informalequation" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> (Text -> Inlines) -> StateT DBState m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
        String
"glosssee" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Inlines
ils -> Text -> Inlines
text Text
"See " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
".")
                         (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
        String
"glossseealso" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Inlines
ils -> Text -> Inlines
text Text
"See also " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
".")
                         (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
        String
"glossary" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
0
        String
"glossdiv" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossentry") Element
e)
        String
"glosslist" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseGlossEntry ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"glossentry") Element
e)
        String
"chapter" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
True}) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
0
        String
"appendix" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
0
        String
"preface" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
0
        String
"bridgehead" -> Inlines -> Blocks
para (Inlines -> Blocks) -> (Inlines -> Inlines) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
strong (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
        String
"sect1" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
1
        String
"sect2" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
2
        String
"sect3" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
3
        String
"sect4" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
4
        String
"sect5" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
5
        String
"section" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        String
"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 -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          Attr -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> StateT DBState m Blocks
sectWith (String -> Element -> Text
attrValue String
"id" Element
e,[Text
"unnumbered"],[]) (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        String
"refsect1" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
1
        String
"refsect2" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
2
        String
"refsect3" -> Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect Int
3
        String
"refsection" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        String
l | String
l String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
admonitionTags -> Text -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Text -> StateT DBState m Blocks
parseAdmonition (Text -> DB m Blocks) -> Text -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
l
        String
"area" -> DB m Blocks
skip
        String
"areaset" -> DB m Blocks
skip
        String
"areaspec" -> DB m Blocks
skip
        String
"qandadiv" -> (DBState -> Int) -> StateT DBState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Int
dbSectionLevel StateT DBState m Int -> (Int -> DB m Blocks) -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT DBState m Blocks
sect (Int -> DB m Blocks) -> (Int -> Int) -> Int -> DB m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        String
"question" -> Inlines -> Blocks -> Blocks
addToStart (Inlines -> Inlines
strong (Text -> Inlines
str Text
"Q:") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
" ") (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"answer" -> Inlines -> Blocks -> Blocks
addToStart (Inlines -> Inlines
strong (Text -> Inlines
str Text
"A:") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
" ") (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"abstract" -> Blocks -> Blocks
blockQuote (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"calloutlist" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
callouts
        String
"itemizedlist" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
listitems
        String
"orderedlist" -> do
          let listStyle :: ListNumberStyle
listStyle = case String -> Element -> Text
attrValue String
"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
$
                      (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"listitem") Element
e
                       Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> (Element -> Text) -> Element -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Text
attrValue String
"override"
          ListAttributes -> [Blocks] -> Blocks
orderedListWith (Int
start,ListNumberStyle
listStyle,ListNumberDelim
DefaultDelim)
            ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
listitems
        String
"variablelist" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT DBState m [(Inlines, [Blocks])] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [(Inlines, [Blocks])]
deflistitems
        String
"procedure" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks) -> StateT DBState m [Blocks] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Blocks]
steps
        String
"figure" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getFigure Element
e
        String
"mediaobject" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT DBState m Inlines -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getMediaobject Element
e
        String
"caption" -> DB m Blocks
skip
        String
"info" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
        String
"articleinfo" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
        String
"sectioninfo" -> DB m Blocks
skip -- keywords & other metadata
        String
"refsectioninfo" -> DB m Blocks
skip -- keywords & other metadata
        String
"refsect1info" -> DB m Blocks
skip -- keywords & other metadata
        String
"refsect2info" -> DB m Blocks
skip -- keywords & other metadata
        String
"refsect3info" -> DB m Blocks
skip -- keywords & other metadata
        String
"sect1info" -> DB m Blocks
skip  -- keywords & other metadata
        String
"sect2info" -> DB m Blocks
skip  -- keywords & other metadata
        String
"sect3info" -> DB m Blocks
skip  -- keywords & other metadata
        String
"sect4info" -> DB m Blocks
skip  -- keywords & other metadata
        String
"sect5info" -> DB m Blocks
skip  -- keywords & other metadata
        String
"chapterinfo" -> DB m Blocks
skip -- keywords & other metadata
        String
"glossaryinfo" -> DB m Blocks
skip  -- keywords & other metadata
        String
"appendixinfo" -> DB m Blocks
skip  -- keywords & other metadata
        String
"bookinfo" -> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e
        String
"article" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
False }) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"book" -> (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DBState
st -> DBState
st{ dbBook :: Bool
dbBook = Bool
True }) StateT DBState m () -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                    Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
addMetadataFromElement Element
e DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"table" -> DB m Blocks
parseTable
        String
"informaltable" -> DB m Blocks
parseTable
        String
"informalexample" -> Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"informalexample"], []) (Blocks -> Blocks) -> DB m Blocks -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
        String
"linegroup" -> [Inlines] -> Blocks
lineBlock ([Inlines] -> Blocks) -> StateT DBState m [Inlines] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m [Inlines]
lineItems
        String
"literallayout" -> DB m Blocks
codeBlockWithLang
        String
"screen" -> DB m Blocks
codeBlockWithLang
        String
"programlisting" -> DB m Blocks
codeBlockWithLang
        String
"?xml"  -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
        String
"title" -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty     -- handled in parent element
        String
"subtitle" -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty  -- handled in parent element
        String
_       -> DB m Blocks
skip DB m Blocks -> DB m Blocks -> DB m Blocks
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
   where skip :: DB m Blocks
skip = do
           m () -> StateT DBState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT DBState m ()) -> m () -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
e)
           Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

         codeBlockWithLang :: DB m Blocks
codeBlockWithLang = do
           let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue String
"language" Element
e of
                                Text
"" -> []
                                Text
x  -> [Text
x]
           Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (String -> Element -> Text
attrValue String
"id" Element
e, [Text]
classes', [])
                  (Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContentRecursive Element
e
         parseBlockquote :: DB m Blocks
parseBlockquote = do
            Blocks
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"attribution") Element
e of
                             Maybe Element
Nothing  -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
                             Just Element
z   -> Inlines -> Blocks
para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str Text
"— " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat
                                         ([Inlines] -> Blocks) -> StateT DBState m [Inlines] -> DB m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                              (Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
z)
            Blocks
contents <- Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
            Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks
contents Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
attrib)
         listitems :: StateT DBState m [Blocks]
listitems = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks ([Element] -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"listitem") Element
e
         callouts :: StateT DBState m [Blocks]
callouts = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks ([Element] -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"callout") Element
e
         deflistitems :: StateT DBState m [(Inlines, [Blocks])]
deflistitems = (Element -> StateT DBState m (Inlines, [Blocks]))
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT DBState m (Inlines, [Blocks])
parseVarListEntry ([Element] -> StateT DBState m [(Inlines, [Blocks])])
-> [Element] -> StateT DBState m [(Inlines, [Blocks])]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren
                     (Text -> Element -> Bool
named Text
"varlistentry") Element
e
         steps :: StateT DBState m [Blocks]
steps = (Element -> DB m Blocks) -> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks ([Element] -> StateT DBState m [Blocks])
-> [Element] -> StateT DBState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"step") Element
e
         parseVarListEntry :: Element -> StateT DBState m (Inlines, [Blocks])
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'
                     [Inlines]
terms' <- (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
terms
                     [Blocks]
items' <- (Element -> StateT DBState m Blocks)
-> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks [Element]
items
                     (Inlines, [Blocks]) -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"; ") [Inlines]
terms', [Blocks]
items')
         parseGlossEntry :: Element -> StateT DBState m (Inlines, [Blocks])
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'
                     [Inlines]
terms' <- (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines [Element]
terms
                     [Blocks]
items' <- (Element -> StateT DBState m Blocks)
-> [Element] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks [Element]
items
                     (Inlines, [Blocks]) -> StateT DBState m (Inlines, [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"; ") [Inlines]
terms', [Blocks]
items')
         parseTable :: DB m Blocks
parseTable = do
                      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
                      Inlines
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
                                    Just Element
t  -> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
                                    Maybe Element
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
                      let e' :: Element
e' = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tgroup") Element
e
                      let isColspec :: Element -> Bool
isColspec Element
x = Text -> Element -> Bool
named Text
"colspec" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"col" Element
x
                      let colspecs :: [Element]
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 :: [String]
colnames = case [Element]
colspecs of
                                       [] -> []
                                       [Element]
cs -> (Element -> Maybe String) -> [Element] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"colname" )) [Element]
cs
                      let isRow :: Element -> Bool
isRow Element
x = Text -> Element -> Bool
named Text
"row" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"tr" Element
x
                      [Cell]
headrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"thead") Element
e' of
                                       Just Element
h  -> case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isRow Element
h of
                                                       Just Element
x  -> [String] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[String] -> Element -> DB m [Cell]
parseRow [String]
colnames Element
x
                                                       Maybe Element
Nothing -> [Cell] -> StateT DBState m [Cell]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                       Maybe Element
Nothing -> [Cell] -> StateT DBState m [Cell]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                      [[Cell]]
bodyrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tbody") Element
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)
mapM ([String] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[String] -> Element -> DB m [Cell]
parseRow [String]
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)
mapM ([String] -> Element -> StateT DBState m [Cell]
forall (m :: * -> *).
PandocMonad m =>
[String] -> Element -> DB m [Cell]
parseRow [String]
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 -> Maybe b
toWidth Element
c = do
                            String
w <- QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"colwidth") Element
c
                            b
n <- Text -> Maybe b
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe b) -> Text -> Maybe b
forall a b. (a -> b) -> a -> b
$ Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (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
'.') (String -> Text
T.pack String
w)
                            if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then b -> Maybe b
forall a. a -> Maybe a
Just b
n else Maybe b
forall a. Maybe a
Nothing
                      let numrows :: Int
numrows = case [[Cell]]
bodyrows of
                                         [] -> Int
0
                                         [[Cell]]
xs -> [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Int) -> [[Cell]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Cell]]
xs
                      let aligns :: [Alignment]
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 widths :: [ColWidth]
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)
sequence [Maybe Double]
ws of
                                                Just [Double]
ws' -> let tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws'
                                                            in  Double -> ColWidth
ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) (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 :: [Cell] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr
                          toHeaderRow :: [Cell] -> [Row]
toHeaderRow [Cell]
l = [[Cell] -> Row
toRow [Cell]
l | Bool -> Bool
not ([Cell] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Cell]
l)]
                      Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table (Blocks -> Caption
simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain Inlines
capt)
                                     ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths)
                                     (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Cell] -> [Row]
toHeaderRow [Cell]
headrows)
                                     [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Cell] -> Row) -> [[Cell]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Cell] -> Row
toRow [[Cell]]
bodyrows]
                                     (Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
         sect :: Int -> StateT DBState m Blocks
sect Int
n = Attr -> Int -> StateT DBState m Blocks
forall (m :: * -> *).
PandocMonad m =>
Attr -> Int -> StateT DBState m Blocks
sectWith (String -> Element -> Text
attrValue String
"id" Element
e,[],[]) Int
n
         sectWith :: Attr -> Int -> StateT DBState m Blocks
sectWith Attr
attr Int
n = do
           Bool
isbook <- (DBState -> Bool) -> StateT DBState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> Bool
dbBook
           let n' :: Int
n' = if Bool
isbook Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
           Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e Maybe Element -> Maybe Element -> Maybe Element
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                              ((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"info") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                  (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title")) of
                            Just Element
t  -> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
                            Maybe Element
Nothing -> Inlines -> StateT DBState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
           (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbSectionLevel :: Int
dbSectionLevel = Int
n }
           Blocks
b <- Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
           (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbSectionLevel :: Int
dbSectionLevel = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 }
           Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT DBState m Blocks)
-> Blocks -> StateT DBState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
headerWith Attr
attr Int
n' Inlines
headerText Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b
         lineItems :: StateT DBState m [Inlines]
lineItems = (Element -> StateT DBState m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"line") Element
e
         -- | Admonitions are parsed into a div. Following other Docbook tools that output HTML,
         -- we parse the optional title as a div with the @title@ class, and give the
         -- block itself a class corresponding to the admonition name.
         parseAdmonition :: Text -> StateT DBState m Blocks
parseAdmonition Text
label = do
           -- <title> elements can be directly nested inside an admonition block, use
           -- it if it's there. It is unclear whether we should include the label in
           -- the title: docbook references are ambiguous on that, and some implementations of admonitions
           -- (e.g. asciidoctor) just use an icon in all cases. To be conservative, we don't
           -- include the label and leave it to styling.
           Blocks
title <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
                        Just Element
t  -> Attr -> Blocks -> Blocks
divWith (Text
"", [Text
"title"], []) (Blocks -> Blocks) -> (Inlines -> Blocks) -> Inlines -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
plain (Inlines -> Blocks)
-> StateT DBState m Inlines -> StateT DBState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
t
                        Maybe Element
Nothing -> Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
           -- this will ignore the title element if it is present
           Blocks
b <- Element -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> DB m Blocks
getBlocks Element
e
           -- we also attach the label as a class, so it can be styled properly
           Blocks -> StateT DBState m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT DBState m Blocks)
-> Blocks -> StateT DBState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue String
"id" Element
e,[Text
label],[]) (Blocks
title Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b)

toAlignment :: Element -> Alignment
toAlignment :: Element -> Alignment
toAlignment Element
c = case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"align") Element
c of
                  Just String
"left"   -> Alignment
AlignLeft
                  Just String
"right"  -> Alignment
AlignRight
                  Just String
"center" -> Alignment
AlignCenter
                  Maybe String
_             -> Alignment
AlignDefault


parseMixed :: PandocMonad m => (Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed :: (Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
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
  Inlines
ils' <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> StateT DBState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline [Content]
ils
  let p :: Blocks
p = if Inlines
ils' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Blocks
forall a. Monoid a => a
mempty else Inlines -> Blocks
container Inlines
ils'
  case [Content]
rest of
    [] -> Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
p
    (Content
r:[Content]
rs) -> do
      Blocks
b <- Content -> DB m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock Content
r
      Blocks
x <- (Inlines -> Blocks) -> [Content] -> DB m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
container [Content]
rs
      Blocks -> DB m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> DB m Blocks) -> Blocks -> DB m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
p Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
x

parseRow :: PandocMonad m => [String] -> Element -> DB m [Cell]
parseRow :: [String] -> Element -> DB m [Cell]
parseRow [String]
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] -> DB m [Cell]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([String] -> Element -> StateT DBState m Cell
forall (m :: * -> *).
PandocMonad m =>
[String] -> Element -> DB m Cell
parseEntry [String]
cn) ([Element] -> DB m [Cell])
-> (Element -> [Element]) -> Element -> DB m [Cell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry

parseEntry :: PandocMonad m => [String] -> Element -> DB m Cell
parseEntry :: [String] -> Element -> DB m Cell
parseEntry [String]
cn Element
el = do
  let colDistance :: String -> String -> ColSpan
colDistance String
sa String
ea = do
        let iStrt :: Maybe Int
iStrt = String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
sa [String]
cn
        let iEnd :: Maybe Int
iEnd = String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
ea [String]
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 String
mStrt = QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"namest") Element
en
        let mEnd :: Maybe String
mEnd = QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
"nameend") Element
en
        case (Maybe String
mStrt, Maybe String
mEnd) of
          (Just String
start, Just String
end) -> String -> String -> ColSpan
colDistance String
start String
end
          (Maybe String, Maybe String)
_ -> ColSpan
1
  let colSpan :: ColSpan
colSpan = Element -> ColSpan
toColSpan Element
el
  let align :: Alignment
align = Element -> Alignment
toAlignment Element
el
  ((Blocks -> Cell) -> StateT DBState m Blocks -> DB m Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell Alignment
align RowSpan
1 ColSpan
colSpan) (StateT DBState m Blocks -> DB m Cell)
-> (Element -> StateT DBState m Blocks) -> Element -> DB m Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Inlines -> Blocks) -> [Content] -> StateT DBState m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> DB m Blocks
parseMixed Inlines -> Blocks
plain) ([Content] -> StateT DBState m Blocks)
-> (Element -> [Content]) -> Element -> StateT DBState m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) Element
el

getInlines :: PandocMonad m => Element -> DB m Inlines
getInlines :: Element -> DB m Inlines
getInlines Element
e' = Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e')

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

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

parseInline :: PandocMonad m => Content -> DB m Inlines
parseInline :: Content -> DB m Inlines
parseInline (Text (CData CDataKind
_ String
s Maybe Line
_)) = Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseInline (CRef String
ref) =
  Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
ref) String -> Text
T.pack (Maybe String -> Text) -> Maybe String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
lookupEntity String
ref
parseInline (Elem Element
e) =
  case QName -> String
qName (Element -> QName
elName Element
e) of
        String
"anchor" -> do
           Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Inlines
spanWith (String -> Element -> Text
attrValue String
"id" Element
e, [], []) Inlines
forall a. Monoid a => a
mempty
        String
"phrase" -> do
          let ident :: Text
ident = String -> Element -> Text
attrValue String
"id" Element
e
          let classes :: [Text]
classes = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Element -> Text
attrValue String
"class" 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 (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines (Attr -> Inlines -> Inlines
spanWith (Text
ident,[Text]
classes,[]))
            else (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
        String
"equation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
        String
"informalequation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
displayMath
        String
"inlineequation" -> Element -> (Text -> Inlines) -> DB m Inlines
forall (m :: * -> *).
Monad m =>
Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
math
        String
"subscript" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
subscript
        String
"superscript" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
superscript
        String
"inlinemediaobject" -> Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getMediaobject Element
e
        String
"quote" -> do
            QuoteType
qt <- (DBState -> QuoteType) -> StateT DBState m QuoteType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DBState -> QuoteType
dbQuoteType
            let qt' :: QuoteType
qt' = if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
            (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbQuoteType :: QuoteType
dbQuoteType = QuoteType
qt' }
            Inlines
contents <- (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
            (DBState -> DBState) -> StateT DBState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((DBState -> DBState) -> StateT DBState m ())
-> (DBState -> DBState) -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ \DBState
st -> DBState
st{ dbQuoteType :: QuoteType
dbQuoteType = QuoteType
qt }
            Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote
                        then Inlines -> Inlines
singleQuoted Inlines
contents
                        else Inlines -> Inlines
doubleQuoted Inlines
contents
        String
"simplelist" -> DB m Inlines
simpleList
        String
"segmentedlist" -> DB m Inlines
segmentedList
        String
"classname" -> DB m Inlines
codeWithLang
        String
"code" -> DB m Inlines
codeWithLang
        String
"filename" -> DB m Inlines
codeWithLang
        String
"envar" -> DB m Inlines
codeWithLang
        String
"literal" -> DB m Inlines
codeWithLang
        String
"computeroutput" -> DB m Inlines
codeWithLang
        String
"prompt" -> DB m Inlines
codeWithLang
        String
"parameter" -> DB m Inlines
codeWithLang
        String
"option" -> DB m Inlines
codeWithLang
        String
"optional" -> do Inlines
x <- Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
                         Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
"[" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"]"
        String
"replaceable" -> do Inlines
x <- Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines Element
e
                            Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str Text
"<" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
">"
        String
"markup" -> DB m Inlines
codeWithLang
        String
"wordasword" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
emph
        String
"command" -> DB m Inlines
codeWithLang
        String
"varname" -> DB m Inlines
codeWithLang
        String
"function" -> DB m Inlines
codeWithLang
        String
"type"    -> DB m Inlines
codeWithLang
        String
"symbol"  -> DB m Inlines
codeWithLang
        String
"constant" -> DB m Inlines
codeWithLang
        String
"userinput" -> DB m Inlines
codeWithLang
        String
"systemitem" -> DB m Inlines
codeWithLang
        String
"varargs" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code Text
"(...)"
        String
"keycap" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e)
        String
"keycombo" -> [Inlines] -> Inlines
keycombo ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e)
        String
"menuchoice" -> [Inlines] -> Inlines
menuchoice ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Content -> DB m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (
                                        (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter Content -> Bool
isGuiMenu ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e)
        String
"xref" -> do
            [Content]
content <- DBState -> [Content]
dbContent (DBState -> [Content])
-> StateT DBState m DBState -> StateT DBState m [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT DBState m DBState
forall s (m :: * -> *). MonadState s m => m s
get
            let linkend :: Text
linkend = String -> Element -> Text
attrValue String
"linkend" Element
e
            let title :: Text
title = case String -> Element -> Text
attrValue String
"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
"???" (String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent)
                                         (Text -> [Content] -> Maybe Element
findElementById Text
endterm [Content]
content)
            Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
linkend) Text
"" (Text -> Inlines
text Text
title)
        String
"email" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Element -> String
strContent Element
e)) Text
""
                          (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
        String
"uri" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e) Text
"" (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e
        String
"ulink" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines (Text -> Text -> Inlines -> Inlines
link (String -> Element -> Text
attrValue String
"url" Element
e) Text
"")
        String
"link" -> do
             Inlines
ils <- (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
             let href :: Text
href = case QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e of
                               Just String
h -> String -> Text
T.pack String
h
                               Maybe String
_      -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Element -> Text
attrValue String
"linkend" Element
e
             let ils' :: Inlines
ils' = if Inlines
ils Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Text -> Inlines
str Text
href else Inlines
ils
             let attr :: (Text, [Text], [a])
attr = (String -> Element -> Text
attrValue String
"id" Element
e, Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Element -> Text
attrValue String
"role" Element
e, [])
             Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall a. (Text, [Text], [a])
attr Text
href Text
"" Inlines
ils'
        String
"foreignphrase" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
emph
        String
"emphasis" -> case String -> Element -> Text
attrValue String
"role" Element
e of
                             Text
"bold"          -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
strong
                             Text
"strong"        -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
strong
                             Text
"strikethrough" -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
strikeout
                             Text
_               -> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
emph
        String
"footnote" -> Blocks -> Inlines
note (Blocks -> Inlines) -> ([Blocks] -> Blocks) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Inlines) -> StateT DBState m [Blocks] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Content -> StateT DBState m Blocks)
-> [Content] -> StateT DBState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> DB m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
        String
"title" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
        String
"affiliation" -> DB m Inlines
skip
        -- Note: this isn't a real docbook tag; it's what we convert
        -- <?asciidor-br?> to in handleInstructions, above.  A kludge to
        -- work around xml-light's inability to parse an instruction.
        String
"br" -> Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
        String
_          -> DB m Inlines
skip DB m Inlines -> DB m Inlines -> DB m Inlines
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Inlines -> Inlines) -> DB m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
   where skip :: DB m Inlines
skip = do
           m () -> StateT DBState m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT DBState m ()) -> m () -> StateT DBState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
e)
           Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

         innerInlines :: (Inlines -> Inlines) -> StateT DBState m Inlines
innerInlines Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> StateT DBState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (Content -> StateT DBState m Inlines)
-> [Content] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT DBState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> DB m Inlines
parseInline (Element -> [Content]
elContent Element
e)
         codeWithLang :: DB m Inlines
codeWithLang = do
           let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue String
"language" Element
e of
                               Text
"" -> []
                               Text
l  -> [Text
l]
           Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith (String -> Element -> Text
attrValue String
"id" Element
e,[Text]
classes',[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Element -> String
strContentRecursive Element
e
         simpleList :: DB m Inlines
simpleList = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space) ([Inlines] -> Inlines)
-> StateT DBState m [Inlines] -> DB m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines
                         ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"member") Element
e)
         segmentedList :: DB m Inlines
segmentedList = do
           Inlines
tit <- DB m Inlines
-> (Element -> DB m Inlines) -> Maybe Element -> DB m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines (Maybe Element -> DB m Inlines) -> Maybe Element -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e
           [Inlines]
segtits <- (Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"segtitle") Element
e
           [[Inlines]]
segitems <- (Element -> StateT DBState m [Inlines])
-> [Element] -> StateT DBState m [[Inlines]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Element -> DB m Inlines)
-> [Element] -> StateT DBState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> DB m Inlines
forall (m :: * -> *). PandocMonad m => Element -> DB m Inlines
getInlines ([Element] -> StateT DBState m [Inlines])
-> (Element -> [Element]) -> Element -> StateT DBState m [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"seg"))
                          ([Element] -> StateT DBState m [[Inlines]])
-> [Element] -> StateT DBState m [[Inlines]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"seglistitem") Element
e
           let toSeg :: [Inlines] -> Inlines
toSeg = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inlines -> Inlines -> Inlines)
-> [Inlines] -> [Inlines] -> [Inlines]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Inlines
x Inlines
y -> Inlines -> Inlines
strong (Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
":") Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
                                  Inlines
y Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
linebreak) [Inlines]
segtits
           let segs :: Inlines
segs = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Inlines] -> Inlines) -> [[Inlines]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Inlines] -> Inlines
toSeg [[Inlines]]
segitems
           let tit' :: Inlines
tit' = if Inlines
tit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
                         then Inlines
forall a. Monoid a => a
mempty
                         else Inlines -> Inlines
strong Inlines
tit Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
linebreak
           Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
linebreak Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
tit' Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
segs
         keycombo :: [Inlines] -> Inlines
keycombo = Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"keycombo"],[]) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"+")
         menuchoice :: [Inlines] -> Inlines
menuchoice = Attr -> Inlines -> Inlines
spanWith (Text
"",[Text
"menuchoice"],[]) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
text 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 -> String -> Element -> Text
attrValue String
"id" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
idString) Element
el | Elem Element
el <- [Content]
content]

         -- Use the 'xreflabel' attribute for getting the title of a xref link;
         -- if there's no such attribute, employ some heuristics based on what
         -- docbook-xsl does.
         xrefTitleByElem :: Element -> Text
xrefTitleByElem Element
el
             | Bool -> Bool
not (Text -> Bool
T.null Text
xrefLabel) = Text
xrefLabel
             | Bool
otherwise              = case QName -> String
qName (Element -> QName
elName Element
el) of
                  String
"chapter"      -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"section"      -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"sect1"        -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"sect2"        -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"sect3"        -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"sect4"        -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"sect5"        -> String -> Element -> Text
descendantContent String
"title" Element
el
                  String
"cmdsynopsis"  -> String -> Element -> Text
descendantContent String
"command" Element
el
                  String
"funcsynopsis" -> String -> Element -> Text
descendantContent String
"function" Element
el
                  String
_              -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName -> String
qName (Element -> QName
elName Element
el) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_title"
          where
            xrefLabel :: Text
xrefLabel = String -> Element -> Text
attrValue String
"xreflabel" Element
el
            descendantContent :: String -> Element -> Text
descendantContent String
name = Text -> (Element -> Text) -> Maybe Element -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"???" (String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent)
                                   (Maybe Element -> Text)
-> (Element -> Maybe Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Bool) -> Element -> Maybe Element
filterElementName (\QName
n -> QName -> String
qName QName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name)

-- | Extract a math equation from an element
--
-- asciidoc can generate Latex math in CDATA sections.
--
-- Note that if some MathML can't be parsed it is silently ignored!
equation
  :: Monad m
  => Element
  -- ^ The element from which to extract a mathematical equation
  -> (Text -> Inlines)
  -- ^ A constructor for some Inlines, taking the TeX code as input
  -> m Inlines
equation :: Element -> (Text -> Inlines) -> m Inlines
equation Element
e Text -> Inlines
constructor =
  Inlines -> m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> m Inlines) -> Inlines -> m Inlines
forall a b. (a -> b) -> a -> b
$ [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
constructor ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ [Text]
mathMLEquations [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
latexEquations
  where
    mathMLEquations :: [Text]
    mathMLEquations :: [Text]
mathMLEquations = ([Exp] -> Text) -> [[Exp]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
writeTeX ([[Exp]] -> [Text]) -> [[Exp]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Either Text [Exp]] -> [[Exp]]
forall a b. [Either a b] -> [b]
rights ([Either Text [Exp]] -> [[Exp]]) -> [Either Text [Exp]] -> [[Exp]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool)
-> (Element -> Either Text [Exp]) -> [Either Text [Exp]]
forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath
      (\Element
x -> QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"math" Bool -> Bool -> Bool
&& QName -> Maybe String
qPrefix (Element -> QName
elName Element
x) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"mml")
      (Text -> Either Text [Exp]
readMathML (Text -> Either Text [Exp])
-> (Element -> Text) -> Element -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
showElement)

    latexEquations :: [Text]
    latexEquations :: [Text]
latexEquations = (Element -> Bool) -> (Element -> Text) -> [Text]
forall b. (Element -> Bool) -> (Element -> b) -> [b]
readMath (\Element
x -> QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mathphrase")
                              ([Text] -> Text
T.concat ([Text] -> Text) -> (Element -> [Text]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Text) -> [Content] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Content -> Text
showVerbatimCData ([Content] -> [Text])
-> (Element -> [Content]) -> Element -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent)

    readMath :: (Element -> Bool) -> (Element -> b) -> [b]
    readMath :: (Element -> Bool) -> (Element -> b) -> [b]
readMath 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

-- | Get the actual text stored in a CData block. 'showContent'
-- returns the text still surrounded by the [[CDATA]] tags.
showVerbatimCData :: Content -> Text
showVerbatimCData :: Content -> Text
showVerbatimCData (Text (CData CDataKind
_ String
d Maybe Line
_)) = String -> Text
T.pack String
d
showVerbatimCData Content
c = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Content -> String
showContent Content
c


-- | Set the prefix of a name to 'Nothing'
removePrefix :: QName -> QName
removePrefix :: QName -> QName
removePrefix QName
elname = QName
elname { qPrefix :: Maybe String
qPrefix = Maybe String
forall a. Maybe a
Nothing }