@@ -1,8 +1,10 @@
11module Text.Pandoc.Readers.DocBook ( readDocBook ) where
2+import Data.Char (toUpper)
23import Text.Pandoc.Parsing (ParserState(..))
34import Text.Pandoc.Definition
45import Text.Pandoc.Builder
56import Text.XML.Light
7+import Text.HTML.TagSoup.Entity (lookupEntity)
68import Data.Monoid
79import Data.Char (isSpace)
810import Control.Monad.State
@@ -81,8 +83,8 @@ List of all DocBook tags, with [x] indicating implemented,
8183[ ] cmdsynopsis - A syntax summary for a software command
8284[ ] co - The location of a callout embedded in text
8385[x] code - An inline code fragment
84−[ ] col - Specifications for a column in an HTML table
85−[ ] colgroup - A group of columns in an HTML table
86+[x] col - Specifications for a column in an HTML table
87+[x] colgroup - A group of columns in an HTML table
8688[ ] collab - Identifies a collaborator
8789[ ] collabname - The name of a collaborator
8890[ ] colophon - Text at the back of a book describing facts about its production
@@ -116,7 +118,7 @@ List of all DocBook tags, with [x] indicating implemented,
116118[ ] editor - The name of the editor of a document
117119[x] email - An email address
118120[x] emphasis - Emphasized text
119−[ ] entry - A cell in a table
121+[x] entry - A cell in a table
120122[ ] entrytbl - A subtable appearing in place of an Entry in a table
121123[ ] envar - A software environment variable
122124[ ] epigraph - A short inscription at the beginning of a document or component
@@ -258,7 +260,7 @@ List of all DocBook tags, with [x] indicating implemented,
258260[ ] ooclass - A class in an object-oriented programming language
259261[ ] ooexception - An exception in an object-oriented programming language
260262[ ] oointerface - An interface in an object-oriented programming language
261−[ ] option - An option for a software command
263+[x] option - An option for a software command
262264[ ] optional - Optional information
263265[x] orderedlist - A list in which each entry is marked with a sequentially
264266 incremented label
@@ -296,7 +298,7 @@ List of all DocBook tags, with [x] indicating implemented,
296298[ ] productionset - A set of EBNF productions
297299[ ] productname - The formal name of a product
298300[ ] productnumber - A number assigned to a product
299−[ ] programlisting - A literal listing of all or part of a program
301+[x] programlisting - A literal listing of all or part of a program
300302[ ] programlistingco - A program listing with associated areas used in callouts
301303[ ] prompt - A character or string indicating the start of an input field in
302304 a computer display
@@ -348,7 +350,7 @@ List of all DocBook tags, with [x] indicating implemented,
348350[ ] revnumber - A document revision number
349351[ ] revremark - A description of a revision to a document
350352[ ] rhs - The right-hand side of an EBNF production
351−[ ] row - A row in a table
353+[x] row - A row in a table
352354[ ] sbr - An explicit line break in a command synopsis
353355[x] screen - Text that a user sees or might see on a computer screen
354356[o] screenco - A screen with associated areas used in callouts
@@ -427,8 +429,8 @@ List of all DocBook tags, with [x] indicating implemented,
427429[ ] taskprerequisites - The prerequisites for a task
428430[ ] taskrelated - Information related to a task
429431[ ] tasksummary - A summary of a task
430−[ ] tbody - A wrapper for the rows of a table or informal table
431−[ ] td - A table entry in an HTML table
432+[x] tbody - A wrapper for the rows of a table or informal table
433+[x] td - A table entry in an HTML table
432434[x] term - The word or phrase being defined or described in a variable list
433435[ ] termdef - An inline term definition
434436[ ] tertiary - A tertiary word or phrase in an index term
@@ -437,9 +439,9 @@ List of all DocBook tags, with [x] indicating implemented,
437439[ ] textobject - A wrapper for a text description of an object and its
438440 associated meta-information
439441[ ] tfoot - A table footer consisting of one or more rows
440−[ ] tgroup - A wrapper for the main content of a table, or part of a table
441−[ ] th - A table header entry in an HTML table
442−[ ] thead - A table header consisting of one or more rows
442+[x] tgroup - A wrapper for the main content of a table, or part of a table
443+[x] th - A table header entry in an HTML table
444+[x] thead - A table header consisting of one or more rows
443445[x] tip - A suggestion to the user, set off from the text
444446[x] title - The text of the title of a section of a document or of a formal
445447 block-level element
@@ -462,7 +464,7 @@ List of all DocBook tags, with [x] indicating implemented,
462464 chapter-like component
463465[ ] tocpart - An entry in a table of contents for a part of a book
464466[ ] token - A unit of information
465−[ ] tr - A row in an HTML table
467+[x] tr - A row in an HTML table
466468[ ] trademark - A trademark
467469[ ] type - The classification of a value
468470[x] ulink - A link that addresses its target by means of a URL
@@ -552,6 +554,7 @@ parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
552554parseBlock (Text (CData _ s _)) = if all isSpace s
553555 then return mempty
554556 else return $ plain $ text s
557+parseBlock (CRef _) = return mempty -- TODO need something better here
555558parseBlock (Elem e) =
556559 case qName (elName e) of
557560 "para" -> para <$> getInlines e
@@ -605,13 +608,13 @@ parseBlock (Elem e) =
605608 "article" -> modify (\st -> st{ dbBook = False }) >>
606609 getTitle >> getBlocks e
607610 "book" -> modify (\st -> st{ dbBook = True }) >> getTitle >> getBlocks e
611+ "table" -> parseTable
612+ "informaltable" -> parseTable
608613 "screen" -> return $ codeBlock $ strContent e -- TODO attrs
609614 "programlisting" -> return $ codeBlock $ strContent e -- TODO attrs
610615 "?xml" -> return mempty
611616 _ -> getBlocks e
612617 where getBlocks e' = mconcat <$> (mapM parseBlock $ elContent e')
613− getInlines e' = (trimInlines . mconcat) <$>
614− (mapM parseInline $ elContent e')
615618 skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
616619 | otherwise = xs
617620 skipWhite xs = xs
@@ -626,20 +629,56 @@ parseBlock (Elem e) =
626629 items' <- mapM ((mconcat <$>) . mapM parseBlock)
627630 $ map elContent items
628631 return (mconcat $ intersperse (str "; ") defs', items')
629− getTitle = case findChild (unqual "title") e of
632+ getTitle = case filterChild (named "title") e of
630633 Just t -> do
631634 tit <- getInlines t
632635 modify $ \st -> st{dbDocTitle = tit}
633636 Nothing -> return ()
634637 getAuthors = do
635638 auths <- mapM getInlines
636− $ findChildren (unqual "author") e
639+ $ filterChildren (named "author") e
637640 modify $ \st -> st{dbDocAuthors = auths}
638− getDate = case findChild (unqual "date") e of
641+ getDate = case filterChild (named "date") e of
639642 Just t -> do
640643 dat <- getInlines t
641644 modify $ \st -> st{dbDocDate = dat}
642645 Nothing -> return ()
646+ parseTable = do
647+ let isCaption x = named "title" x || named "caption" x
648+ caption <- case filterChild isCaption e of
649+ Just t -> getInlines t
650+ Nothing -> return mempty
651+ let e' = maybe e id $ filterChild (named "tgroup") e
652+ let isColspec x = named "colspec" x || named "col" x
653+ let colspecs = case filterChild (named "colgroup") e' of
654+ Just c -> filterChildren isColspec c
655+ _ -> filterChildren isColspec e'
656+ let isRow x = named "row" x || named "tr" x
657+ headrows <- case filterChild (named "thead") e' of
658+ Just h -> case filterChild isRow h of
659+ Just x -> parseRow x
660+ Nothing -> return []
661+ Nothing -> return []
662+ bodyrows <- case filterChild (named "tbody") e' of
663+ Just b -> mapM parseRow
664+ $ filterChildren isRow b
665+ Nothing -> mapM parseRow
666+ $ filterChildren isRow e'
667+ let toAlignment c = case findAttr (unqual "align") c of
668+ Just "left" -> AlignLeft
669+ Just "right" -> AlignRight
670+ Just "center" -> AlignCenter
671+ _ -> AlignDefault
672+ let aligns = case colspecs of
673+ [] -> replicate
674+ (maximum $ map length bodyrows)
675+ AlignDefault
676+ cs -> map toAlignment cs
677+ return $ table caption
678+ (zip aligns (repeat 0))
679+ headrows bodyrows
680+ isEntry x = named "entry" x || named "td" x || named "th" x
681+ parseRow = mapM getBlocks . filterChildren isEntry
643682 sect n = do isbook <- gets dbBook
644683 let n' = if isbook then n + 1 else n
645684 case skipWhite (elContent e) of
@@ -655,10 +694,14 @@ parseBlock (Elem e) =
655694 b <- mconcat <$> (mapM parseBlock body)
656695 modify $ \st -> st{ dbSectionLevel = n - 1 }
657696 return $ h <> b
658−parseBlock (CRef _) = return mempty
697+
698+getInlines :: Element -> DB Inlines
699+getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')
659700
660701parseInline :: Content -> DB Inlines
661702parseInline (Text (CData _ s _)) = return $ text s
703+parseInline (CRef ref) =
704+ return $ maybe (text $ map toUpper ref) (text . (:[])) $ lookupEntity ref
662705parseInline (Elem e) =
663706 case qName (elName e) of
664707 "subscript" -> subscript <$> innerInlines
@@ -676,6 +719,7 @@ parseInline (Elem e) =
676719 "code" -> return $ code $ strContent e -- TODO attrs
677720 "filename" -> return $ code $ strContent e -- TODO attrs
678721 "literal" -> return $ code $ strContent e -- TODO attrs
722+ "option" -> return $ code $ strContent e -- TODO attrs
679723 "markup" -> return $ code $ strContent e -- TODO attrs
680724 "wordasword" -> emph <$> innerInlines
681725 "varname" -> return $ codeWith ("",["varname"],[]) $ strContent e
@@ -700,4 +744,3 @@ parseInline (Elem e) =
700744 _ -> innerInlines
701745 where innerInlines = (trimInlines . mconcat) <$>
702746 (mapM parseInline $ elContent e)
703−parseInline (CRef _) = return mempty