git.iko.soy/typeable/pandoc
on master help sign in
Merge branch 'docx' of https://github.com/jkr/pandoc into jkr-docx
bec9f3cJohn MacFarlane
README+9−9
compare with master
unifiedsplit
@@ -13,15 +13,15 @@ Description
13Pandoc is a [Haskell] library for converting from one markup format to
13Pandoc is a [Haskell] library for converting from one markup format to
14another, and a command-line tool that uses this library. It can read
14another, and a command-line tool that uses this library. It can read
15[markdown] and (subsets of) [Textile], [reStructuredText], [HTML],
15[markdown] and (subsets of) [Textile], [reStructuredText], [HTML],
16−[LaTeX], [MediaWiki markup], [Haddock markup], [OPML], [Emacs Org-mode]
16+[LaTeX], [MediaWiki markup], [Haddock markup], [OPML], [Emacs
17−and [DocBook]; and it can write plain text, [markdown],
17+Org-mode], [DocBook], and [Word docx]; and it can write plain text,
18−[reStructuredText], [XHTML], [HTML 5], [LaTeX] (including [beamer] slide
18+[markdown], [reStructuredText], [XHTML], [HTML 5], [LaTeX] (including
19−shows), [ConTeXt], [RTF], [OPML], [DocBook], [OpenDocument], [ODT],
19+[beamer] slide shows), [ConTeXt], [RTF], [OPML], [DocBook],
20−[Word docx], [GNU Texinfo], [MediaWiki markup], [EPUB] (v2 or v3),
20+[OpenDocument], [ODT], [Word docx], [GNU Texinfo], [MediaWiki markup],
21−[FictionBook2], [Textile], [groff man] pages, [Emacs Org-Mode],
21+[EPUB] (v2 or v3), [FictionBook2], [Textile], [groff man] pages,
22−[AsciiDoc], [InDesign ICML], and [Slidy], [Slideous], [DZSlides],
22+[Emacs Org-Mode], [AsciiDoc], [InDesign ICML], and [Slidy],
23−[reveal.js] or [S5] HTML slide shows. It can also produce [PDF] output
23+[Slideous], [DZSlides], [reveal.js] or [S5] HTML slide shows. It can
24−on systems where LaTeX is installed.
24+also produce [PDF] output on systems where LaTeX is installed.
25
25
26Pandoc's enhanced version of markdown includes syntax for footnotes,
26Pandoc's enhanced version of markdown includes syntax for footnotes,
27tables, flexible ordered lists, definition lists, fenced code blocks,
27tables, flexible ordered lists, definition lists, fenced code blocks,
pandoc.cabal+23−1
@@ -184,7 +184,25 @@ Extra-Source-Files:
184 tests/fb2.math.markdown,
184 tests/fb2.math.markdown,
185 tests/fb2.math.fb2,
185 tests/fb2.math.fb2,
186 tests/fb2.test-small.png,
186 tests/fb2.test-small.png,
187− tests/fb2.test.jpg
187+ tests/fb2.test.jpg,
188+ tests/docx.block_quotes.docx,
189+ tests/docx.block_quotes_parse_indent.native,
190+ tests/docx.headers.docx,
191+ tests/docx.headers.native,
192+ tests/docx.image.docx,
193+ tests/docx.image_no_embed.native,
194+ tests/docx.inline_formatting.docx,
195+ tests/docx.inline_formatting.native,
196+ tests/docx.links.docx,
197+ tests/docx.links.native,
198+ tests/docx.lists.docx,
199+ tests/docx.lists.native,
200+ tests/docx.notes.docx,
201+ tests/docx.notes.native,
202+ tests/docx.tables.docx,
203+ tests/docx.tables.native,
204+ tests/docx.unicode.docx,
205+ tests/docx.unicode.native
188Extra-Tmp-Files: man/man1/pandoc.1,
206Extra-Tmp-Files: man/man1/pandoc.1,
189 man/man5/pandoc_markdown.5
207 man/man5/pandoc_markdown.5
190
208
@@ -275,6 +293,7 @@ Library
275 Text.Pandoc.Readers.Textile,
293 Text.Pandoc.Readers.Textile,
276 Text.Pandoc.Readers.Native,
294 Text.Pandoc.Readers.Native,
277 Text.Pandoc.Readers.Haddock,
295 Text.Pandoc.Readers.Haddock,
296+ Text.Pandoc.Readers.DocX,
278 Text.Pandoc.Writers.Native,
297 Text.Pandoc.Writers.Native,
279 Text.Pandoc.Writers.Docbook,
298 Text.Pandoc.Writers.Docbook,
280 Text.Pandoc.Writers.OPML,
299 Text.Pandoc.Writers.OPML,
@@ -305,6 +324,8 @@ Library
305 Text.Pandoc.Process
324 Text.Pandoc.Process
306 Other-Modules: Text.Pandoc.Readers.Haddock.Lex,
325 Other-Modules: Text.Pandoc.Readers.Haddock.Lex,
307 Text.Pandoc.Readers.Haddock.Parse,
326 Text.Pandoc.Readers.Haddock.Parse,
327+ Text.Pandoc.Readers.DocX.Lists,
328+ Text.Pandoc.Readers.DocX.Parse,
308 Text.Pandoc.Writers.Shared,
329 Text.Pandoc.Writers.Shared,
309 Text.Pandoc.Asciify,
330 Text.Pandoc.Asciify,
310 Text.Pandoc.MIME,
331 Text.Pandoc.MIME,
@@ -390,6 +411,7 @@ Test-Suite test-pandoc
390 Tests.Readers.Markdown
411 Tests.Readers.Markdown
391 Tests.Readers.Org
412 Tests.Readers.Org
392 Tests.Readers.RST
413 Tests.Readers.RST
414+ Tests.Readers.DocX
393 Tests.Writers.Native
415 Tests.Writers.Native
394 Tests.Writers.ConTeXt
416 Tests.Writers.ConTeXt
395 Tests.Writers.HTML
417 Tests.Writers.HTML
pandoc.hs+10−3
@@ -858,6 +858,7 @@ defaultReaderName fallback (x:xs) =
858 ".textile" -> "textile"
858 ".textile" -> "textile"
859 ".native" -> "native"
859 ".native" -> "native"
860 ".json" -> "json"
860 ".json" -> "json"
861+ ".docx" -> "docx"
861 _ -> defaultReaderName fallback xs
862 _ -> defaultReaderName fallback xs
862
863
863-- Returns True if extension of first source is .lhs
864-- Returns True if extension of first source is .lhs
@@ -1158,15 +1159,21 @@ main = do
1158 Left e -> throwIO e
1159 Left e -> throwIO e
1159 Right (bs,_) -> return $ UTF8.toString bs
1160 Right (bs,_) -> return $ UTF8.toString bs
1160
1161
1162+ let readFiles [] = error "Cannot read archive from stdin"
1163+ readFiles (x:_) = B.readFile x
1164+
1161 let convertTabs = tabFilter (if preserveTabs then 0 else tabStop)
1165 let convertTabs = tabFilter (if preserveTabs then 0 else tabStop)
1162
1166
1163 let handleIncludes' = if readerName' == "latex" || readerName' == "latex+lhs"
1167 let handleIncludes' = if readerName' == "latex" || readerName' == "latex+lhs"
1164 then handleIncludes
1168 then handleIncludes
1165 else return
1169 else return
1166
1170
1171+ doc <- case reader of
1172+ StringReader r->
1167− doc <- readSources sources >>=
1173+ readSources sources >>=
1168− handleIncludes' . convertTabs . intercalate "\n" >>=
1174+ handleIncludes' . convertTabs . intercalate "\n" >>=
1169− reader readerOpts
1175+ r readerOpts
1176+ ByteStringReader r -> readFiles sources >>= r readerOpts
1170
1177
1171
1178
1172 let doc0 = M.foldWithKey setMeta doc metadata
1179 let doc0 = M.foldWithKey setMeta doc metadata
src/Text/Pandoc.hs+36−20
@@ -62,6 +62,8 @@ module Text.Pandoc
62 , readers
62 , readers
63 , writers
63 , writers
64 -- * Readers: converting /to/ Pandoc format
64 -- * Readers: converting /to/ Pandoc format
65+ , Reader (..)
66+ , readDocX
65 , readMarkdown
67 , readMarkdown
66 , readMediaWiki
68 , readMediaWiki
67 , readRST
69 , readRST
@@ -125,6 +127,7 @@ import Text.Pandoc.Readers.HTML
125import Text.Pandoc.Readers.Textile
127import Text.Pandoc.Readers.Textile
126import Text.Pandoc.Readers.Native
128import Text.Pandoc.Readers.Native
127import Text.Pandoc.Readers.Haddock
129import Text.Pandoc.Readers.Haddock
130+import Text.Pandoc.Readers.DocX
128import Text.Pandoc.Writers.Native
131import Text.Pandoc.Writers.Native
129import Text.Pandoc.Writers.Markdown
132import Text.Pandoc.Writers.Markdown
130import Text.Pandoc.Writers.RST
133import Text.Pandoc.Writers.RST
@@ -192,24 +195,34 @@ markdown o s = do
192 mapM_ warn warnings
195 mapM_ warn warnings
193 return doc
196 return doc
194
197
198+data Reader = StringReader (ReaderOptions -> String -> IO Pandoc)
199+ | ByteStringReader (ReaderOptions -> BL.ByteString -> IO Pandoc)
200+
201+mkStringReader :: (ReaderOptions -> String -> Pandoc) -> Reader
202+mkStringReader r = StringReader (\o s -> return $ r o s)
203+
204+mkBSReader :: (ReaderOptions -> BL.ByteString -> Pandoc) -> Reader
205+mkBSReader r = ByteStringReader (\o s -> return $ r o s)
206+
195-- | Association list of formats and readers.
207-- | Association list of formats and readers.
196−readers :: [(String, ReaderOptions -> String -> IO Pandoc)]
208+readers :: [(String, Reader)]
197−readers = [ ("native" , \_ s -> return $ readNative s)
209+readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)
198− ,("json" , \o s -> return $ readJSON o s)
210+ ,("json" , mkStringReader readJSON )
199− ,("markdown" , markdown)
211+ ,("markdown" , StringReader markdown)
200− ,("markdown_strict" , markdown)
212+ ,("markdown_strict" , StringReader markdown)
201− ,("markdown_phpextra" , markdown)
213+ ,("markdown_phpextra" , StringReader markdown)
202− ,("markdown_github" , markdown)
214+ ,("markdown_github" , StringReader markdown)
203− ,("markdown_mmd", markdown)
215+ ,("markdown_mmd", StringReader markdown)
204− ,("rst" , \o s -> return $ readRST o s)
216+ ,("rst" , mkStringReader readRST )
205− ,("mediawiki" , \o s -> return $ readMediaWiki o s)
217+ ,("mediawiki" , mkStringReader readMediaWiki)
206− ,("docbook" , \o s -> return $ readDocBook o s)
218+ ,("docbook" , mkStringReader readDocBook)
207− ,("opml" , \o s -> return $ readOPML o s)
219+ ,("opml" , mkStringReader readOPML)
208− ,("org" , \o s -> return $ readOrg o s)
220+ ,("org" , mkStringReader readOrg)
209− ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs
221+ ,("textile" , mkStringReader readTextile) -- TODO : textile+lhs
210− ,("html" , \o s -> return $ readHtml o s)
222+ ,("html" , mkStringReader readHtml)
211− ,("latex" , \o s -> return $ readLaTeX o s)
223+ ,("latex" , mkStringReader readLaTeX)
212− ,("haddock" , \o s -> return $ readHaddock o s)
224+ ,("haddock" , mkStringReader readHaddock)
225+ ,("docx" , mkBSReader readDocX)
213 ]
226 ]
214
227
215data Writer = PureStringWriter (WriterOptions -> Pandoc -> String)
228data Writer = PureStringWriter (WriterOptions -> Pandoc -> String)
@@ -280,14 +293,17 @@ getDefaultExtensions "textile" = Set.fromList [Ext_auto_identifiers, Ext
280getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]
293getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]
281
294
282-- | Retrieve reader based on formatSpec (format+extensions).
295-- | Retrieve reader based on formatSpec (format+extensions).
283−getReader :: String -> Either String (ReaderOptions -> String -> IO Pandoc)
296+getReader :: String -> Either String Reader
284getReader s =
297getReader s =
285 case parseFormatSpec s of
298 case parseFormatSpec s of
286 Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e]
299 Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e]
287− Right (readerName, setExts) ->
300+ Right (readerName, setExts) ->
288 case lookup readerName readers of
301 case lookup readerName readers of
289 Nothing -> Left $ "Unknown reader: " ++ readerName
302 Nothing -> Left $ "Unknown reader: " ++ readerName
290− Just r -> Right $ \o ->
303+ Just (StringReader r) -> Right $ StringReader $ \o ->
304+ r o{ readerExtensions = setExts $
305+ getDefaultExtensions readerName }
306+ Just (ByteStringReader r) -> Right $ ByteStringReader $ \o ->
291 r o{ readerExtensions = setExts $
307 r o{ readerExtensions = setExts $
292 getDefaultExtensions readerName }
308 getDefaultExtensions readerName }
293
309
src/Text/Pandoc/Readers/DocX.hsnew file+479
@@ -0,0 +1,479 @@
1+{-
2+Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Readers.DocX
21+ Copyright : Copyright (C) 2014 Jesse Rosenthal
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of DocX type (defined in Text.Pandoc.Readers.DocX.Parse)
29+to 'Pandoc' document. -}
30+
31+{-
32+Current state of implementation of DocX entities ([x] means
33+implemented, [-] means partially implemented):
34+
35+* Blocks
36+
37+ - [X] Para
38+ - [X] CodeBlock (styled with `SourceCode`)
39+ - [X] BlockQuote (styled with `Quote`, `BlockQuote`, or, optionally,
40+ indented)
41+ - [X] OrderedList
42+ - [X] BulletList
43+ - [X] DefinitionList (styled with adjacent `DefinitionTerm` and `Definition`)
44+ - [X] Header (styled with `Heading#`)
45+ - [ ] HorizontalRule
46+ - [-] Table (column widths and alignments not yet implemented)
47+
48+* Inlines
49+
50+ - [X] Str
51+ - [X] Emph (From italics. `underline` currently read as span. In
52+ future, it might optionally be emph as well)
53+ - [X] Strong
54+ - [X] Strikeout
55+ - [X] Superscript
56+ - [X] Subscript
57+ - [X] SmallCaps
58+ - [ ] Quoted
59+ - [ ] Cite
60+ - [X] Code (styled with `VerbatimChar`)
61+ - [X] Space
62+ - [X] LineBreak (these are invisible in Word: entered with Shift-Return)
63+ - [ ] Math
64+ - [X] Link (links to an arbitrary bookmark create a span with the target as
65+ id and "anchor" class)
66+ - [-] Image (Links to path in archive. Future option for
67+ data-encoded URI likely.)
68+ - [X] Note (Footnotes and Endnotes are silently combined.)
69+-}
70+
71+module Text.Pandoc.Readers.DocX
72+ ( readDocX
73+ ) where
74+
75+import Codec.Archive.Zip
76+import Text.Pandoc.Definition
77+import Text.Pandoc.Options
78+import Text.Pandoc.Builder (text, toList)
79+import Text.Pandoc.Generic (bottomUp)
80+import Text.Pandoc.MIME (getMimeType)
81+import Text.Pandoc.UTF8 (toString)
82+import Text.Pandoc.Readers.DocX.Parse
83+import Text.Pandoc.Readers.DocX.Lists
84+import Data.Maybe (mapMaybe, isJust, fromJust)
85+import Data.List (delete, isPrefixOf, (\\), intersect)
86+import qualified Data.ByteString as BS
87+import qualified Data.ByteString.Lazy as B
88+import Data.ByteString.Base64 (encode)
89+import System.FilePath (combine)
90+
91+readDocX :: ReaderOptions
92+ -> B.ByteString
93+ -> Pandoc
94+readDocX opts bytes =
95+ case archiveToDocX (toArchive bytes) of
96+ Just docx -> Pandoc nullMeta (docxToBlocks opts docx)
97+ Nothing -> error $ "couldn't parse docx file"
98+
99+runStyleToSpanAttr :: RunStyle -> (String, [String], [(String, String)])
100+runStyleToSpanAttr rPr = ("",
101+ mapMaybe id [
102+ if isBold rPr then (Just "strong") else Nothing,
103+ if isItalic rPr then (Just "emph") else Nothing,
104+ if isSmallCaps rPr then (Just "smallcaps") else Nothing,
105+ if isStrike rPr then (Just "strike") else Nothing,
106+ if isSuperScript rPr then (Just "superscript") else Nothing,
107+ if isSubScript rPr then (Just "subscript") else Nothing,
108+ rStyle rPr],
109+ case underline rPr of
110+ Just fmt -> [("underline", fmt)]
111+ _ -> []
112+ )
113+
114+parStyleToDivAttr :: ParagraphStyle -> (String, [String], [(String, String)])
115+parStyleToDivAttr pPr = ("",
116+ pStyle pPr,
117+ case indent pPr of
118+ Just n -> [("indent", (show n))]
119+ Nothing -> []
120+ )
121+
122+strToInlines :: String -> [Inline]
123+strToInlines = toList . text
124+
125+codeSpans :: [String]
126+codeSpans = ["VerbatimChar"]
127+
128+blockQuoteDivs :: [String]
129+blockQuoteDivs = ["Quote", "BlockQuote"]
130+
131+codeDivs :: [String]
132+codeDivs = ["SourceCode"]
133+
134+runElemToInlines :: RunElem -> [Inline]
135+runElemToInlines (TextRun s) = strToInlines s
136+runElemToInlines (LnBrk) = [LineBreak]
137+
138+runElemToString :: RunElem -> String
139+runElemToString (TextRun s) = s
140+runElemToString (LnBrk) = ['\n']
141+
142+runElemsToString :: [RunElem] -> String
143+runElemsToString = concatMap runElemToString
144+
145+strNormalize :: [Inline] -> [Inline]
146+strNormalize [] = []
147+strNormalize (Str "" : ils) = strNormalize ils
148+strNormalize ((Str s) : (Str s') : l) = strNormalize ((Str (s++s')) : l)
149+strNormalize (il:ils) = il : (strNormalize ils)
150+
151+runToInlines :: ReaderOptions -> DocX -> Run -> [Inline]
152+runToInlines _ _ (Run rs runElems)
153+ | isJust (rStyle rs) && (fromJust (rStyle rs)) `elem` codeSpans =
154+ case runStyleToSpanAttr rs == ("", [], []) of
155+ True -> [Str (runElemsToString runElems)]
156+ False -> [Span (runStyleToSpanAttr rs) [Str (runElemsToString runElems)]]
157+ | otherwise = case runStyleToSpanAttr rs == ("", [], []) of
158+ True -> concatMap runElemToInlines runElems
159+ False -> [Span (runStyleToSpanAttr rs) (concatMap runElemToInlines runElems)]
160+runToInlines opts docx@(DocX _ notes _ _ _ ) (Footnote fnId) =
161+ case (getFootNote fnId notes) of
162+ Just bodyParts ->
163+ [Note [Div ("", ["footnote"], []) (map (bodyPartToBlock opts docx) bodyParts)]]
164+ Nothing ->
165+ [Note [Div ("", ["footnote"], []) []]]
166+runToInlines opts docx@(DocX _ notes _ _ _) (Endnote fnId) =
167+ case (getEndNote fnId notes) of
168+ Just bodyParts ->
169+ [Note [Div ("", ["endnote"], []) (map (bodyPartToBlock opts docx) bodyParts)]]
170+ Nothing ->
171+ [Note [Div ("", ["endnote"], []) []]]
172+
173+parPartToInlines :: ReaderOptions -> DocX -> ParPart -> [Inline]
174+parPartToInlines opts docx (PlainRun r) = runToInlines opts docx r
175+parPartToInlines _ _ (BookMark _ anchor) =
176+ [Span (anchor, ["anchor"], []) []]
177+parPartToInlines _ (DocX _ _ _ rels _) (Drawing relid) =
178+ case lookupRelationship relid rels of
179+ Just target -> [Image [] (combine "word" target, "")]
180+ Nothing -> [Image [] ("", "")]
181+parPartToInlines opts docx (InternalHyperLink anchor runs) =
182+ [Link (concatMap (runToInlines opts docx) runs) ('#' : anchor, "")]
183+parPartToInlines opts docx@(DocX _ _ _ rels _) (ExternalHyperLink relid runs) =
184+ case lookupRelationship relid rels of
185+ Just target ->
186+ [Link (concatMap (runToInlines opts docx) runs) (target, "")]
187+ Nothing ->
188+ [Link (concatMap (runToInlines opts docx) runs) ("", "")]
189+
190+isAnchorSpan :: Inline -> Bool
191+isAnchorSpan (Span (ident, classes, kvs) ils) =
192+ (not . null) ident &&
193+ classes == ["anchor"] &&
194+ null kvs &&
195+ null ils
196+isAnchorSpan _ = False
197+
198+dummyAnchors :: [String]
199+dummyAnchors = ["_GoBack"]
200+
201+makeHeaderAnchors :: Block -> Block
202+makeHeaderAnchors h@(Header n (_, classes, kvs) ils) =
203+ case filter isAnchorSpan ils of
204+ [] -> h
205+ (x@(Span (ident, _, _) _) : xs) ->
206+ case ident `elem` dummyAnchors of
207+ True -> h
208+ False -> Header n (ident, classes, kvs) (ils \\ (x:xs))
209+ _ -> h
210+makeHeaderAnchors blk = blk
211+
212+
213+parPartsToInlines :: ReaderOptions -> DocX -> [ParPart] -> [Inline]
214+parPartsToInlines opts docx parparts =
215+ --
216+ -- We're going to skip data-uri's for now. It should be an option,
217+ -- not mandatory.
218+ --
219+ --bottomUp (makeImagesSelfContained docx) $
220+ bottomUp spanCorrect $
221+ bottomUp spanTrim $
222+ bottomUp spanReduce $
223+ concatMap (parPartToInlines opts docx) parparts
224+
225+cellToBlocks :: ReaderOptions -> DocX -> Cell -> [Block]
226+cellToBlocks opts docx (Cell bps) = map (bodyPartToBlock opts docx) bps
227+
228+rowToBlocksList :: ReaderOptions -> DocX -> Row -> [[Block]]
229+rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
230+
231+bodyPartToBlock :: ReaderOptions -> DocX -> BodyPart -> Block
232+bodyPartToBlock opts docx (Paragraph pPr parparts) =
233+ Div (parStyleToDivAttr pPr) [Para (parPartsToInlines opts docx parparts)]
234+bodyPartToBlock opts docx@(DocX _ _ numbering _ _) (ListItem pPr numId lvl parparts) =
235+ let
236+ kvs = case lookupLevel numId lvl numbering of
237+ Just (_, fmt, txt, Just start) -> [ ("level", lvl)
238+ , ("num-id", numId)
239+ , ("format", fmt)
240+ , ("text", txt)
241+ , ("start", (show start))
242+ ]
243+
244+ Just (_, fmt, txt, Nothing) -> [ ("level", lvl)
245+ , ("num-id", numId)
246+ , ("format", fmt)
247+ , ("text", txt)
248+ ]
249+ Nothing -> []
250+ in
251+ Div
252+ ("", ["list-item"], kvs)
253+ [bodyPartToBlock opts docx (Paragraph pPr parparts)]
254+bodyPartToBlock _ _ (Tbl _ _ _ []) =
255+ Para []
256+bodyPartToBlock opts docx (Tbl cap _ look (r:rs)) =
257+ let caption = strToInlines cap
258+ (hdr, rows) = case firstRowFormatting look of
259+ True -> (Just r, rs)
260+ False -> (Nothing, r:rs)
261+ hdrCells = case hdr of
262+ Just r' -> rowToBlocksList opts docx r'
263+ Nothing -> []
264+ cells = map (rowToBlocksList opts docx) rows
265+
266+ size = case null hdrCells of
267+ True -> length $ head cells
268+ False -> length $ hdrCells
269+ --
270+ -- The two following variables (horizontal column alignment and
271+ -- relative column widths) go to the default at the
272+ -- moment. Width information is in the TblGrid field of the Tbl,
273+ -- so should be possible. Alignment might be more difficult,
274+ -- since there doesn't seem to be a column entity in docx.
275+ alignments = take size (repeat AlignDefault)
276+ widths = take size (repeat 0) :: [Double]
277+ in
278+ Table caption alignments widths hdrCells cells
279+
280+makeImagesSelfContained :: DocX -> Inline -> Inline
281+makeImagesSelfContained (DocX _ _ _ _ media) i@(Image alt (uri, title)) =
282+ case lookup uri media of
283+ Just bs -> case getMimeType uri of
284+ Just mime -> let data_uri =
285+ "data:" ++ mime ++ ";base64," ++ toString (encode $ BS.concat $ B.toChunks bs)
286+ in
287+ Image alt (data_uri, title)
288+ Nothing -> i
289+ Nothing -> i
290+makeImagesSelfContained _ inline = inline
291+
292+bodyToBlocks :: ReaderOptions -> DocX -> Body -> [Block]
293+bodyToBlocks opts docx (Body bps) =
294+ bottomUp removeEmptyPars $
295+ bottomUp strNormalize $
296+ bottomUp spanRemove $
297+ bottomUp divRemove $
298+ map (makeHeaderAnchors) $
299+ bottomUp divCorrect $
300+ bottomUp divReduce $
301+ bottomUp divCorrectPreReduce $
302+ bottomUp blocksToDefinitions $
303+ blocksToBullets $
304+ map (bodyPartToBlock opts docx) bps
305+
306+docxToBlocks :: ReaderOptions -> DocX -> [Block]
307+docxToBlocks opts d@(DocX (Document _ body) _ _ _ _) = bodyToBlocks opts d body
308+
309+spanReduce :: [Inline] -> [Inline]
310+spanReduce [] = []
311+spanReduce ((Span (id1, classes1, kvs1) ils1) : ils)
312+ | (id1, classes1, kvs1) == ("", [], []) = ils1 ++ (spanReduce ils)
313+spanReduce (s1@(Span (id1, classes1, kvs1) ils1) :
314+ s2@(Span (id2, classes2, kvs2) ils2) :
315+ ils) =
316+ let classes' = classes1 `intersect` classes2
317+ kvs' = kvs1 `intersect` kvs2
318+ classes1' = classes1 \\ classes'
319+ kvs1' = kvs1 \\ kvs'
320+ classes2' = classes2 \\ classes'
321+ kvs2' = kvs2 \\ kvs'
322+ in
323+ case null classes' && null kvs' of
324+ True -> s1 : (spanReduce (s2 : ils))
325+ False -> let attr' = ("", classes', kvs')
326+ attr1' = (id1, classes1', kvs1')
327+ attr2' = (id2, classes2', kvs2')
328+ in
329+ spanReduce (Span attr' [(Span attr1' ils1), (Span attr2' ils2)] :
330+ ils)
331+spanReduce (il:ils) = il : (spanReduce ils)
332+
333+ilToCode :: Inline -> String
334+ilToCode (Str s) = s
335+ilToCode _ = ""
336+
337+spanRemove' :: Inline -> [Inline]
338+spanRemove' s@(Span (ident, classes, _) [])
339+ -- "_GoBack" is automatically inserted. We don't want to keep it.
340+ | classes == ["anchor"] && not (ident `elem` dummyAnchors) = [s]
341+spanRemove' (Span (_, _, kvs) ils) =
342+ case lookup "underline" kvs of
343+ Just val -> [Span ("", [], [("underline", val)]) ils]
344+ Nothing -> ils
345+spanRemove' il = [il]
346+
347+spanRemove :: [Inline] -> [Inline]
348+spanRemove = concatMap spanRemove'
349+
350+spanTrim' :: Inline -> [Inline]
351+spanTrim' il@(Span _ []) = [il]
352+spanTrim' il@(Span attr (il':[]))
353+ | il' == Space = [Span attr [], Space]
354+ | otherwise = [il]
355+spanTrim' (Span attr ils)
356+ | head ils == Space && last ils == Space =
357+ [Space, Span attr (init $ tail ils), Space]
358+ | head ils == Space = [Space, Span attr (tail ils)]
359+ | last ils == Space = [Span attr (init ils), Space]
360+spanTrim' il = [il]
361+
362+spanTrim :: [Inline] -> [Inline]
363+spanTrim = concatMap spanTrim'
364+
365+spanCorrect' :: Inline -> [Inline]
366+spanCorrect' (Span ("", [], []) ils) = ils
367+spanCorrect' (Span (ident, classes, kvs) ils)
368+ | "emph" `elem` classes =
369+ [Emph $ spanCorrect' $ Span (ident, (delete "emph" classes), kvs) ils]
370+ | "strong" `elem` classes =
371+ [Strong $ spanCorrect' $ Span (ident, (delete "strong" classes), kvs) ils]
372+ | "smallcaps" `elem` classes =
373+ [SmallCaps $ spanCorrect' $ Span (ident, (delete "smallcaps" classes), kvs) ils]
374+ | "strike" `elem` classes =
375+ [Strikeout $ spanCorrect' $ Span (ident, (delete "strike" classes), kvs) ils]
376+ | "superscript" `elem` classes =
377+ [Superscript $ spanCorrect' $ Span (ident, (delete "superscript" classes), kvs) ils]
378+ | "subscript" `elem` classes =
379+ [Subscript $ spanCorrect' $ Span (ident, (delete "subscript" classes), kvs) ils]
380+ | (not . null) (codeSpans `intersect` classes) =
381+ [Code (ident, (classes \\ codeSpans), kvs) (init $ unlines $ map ilToCode ils)]
382+ | otherwise =
383+ [Span (ident, classes, kvs) ils]
384+spanCorrect' il = [il]
385+
386+spanCorrect :: [Inline] -> [Inline]
387+spanCorrect = concatMap spanCorrect'
388+
389+removeEmptyPars :: [Block] -> [Block]
390+removeEmptyPars blks = filter (\b -> b /= (Para [])) blks
391+
392+divReduce :: [Block] -> [Block]
393+divReduce [] = []
394+divReduce ((Div (id1, classes1, kvs1) blks1) : blks)
395+ | (id1, classes1, kvs1) == ("", [], []) = blks1 ++ (divReduce blks)
396+divReduce (d1@(Div (id1, classes1, kvs1) blks1) :
397+ d2@(Div (id2, classes2, kvs2) blks2) :
398+ blks) =
399+ let classes' = classes1 `intersect` classes2
400+ kvs' = kvs1 `intersect` kvs2
401+ classes1' = classes1 \\ classes'
402+ kvs1' = kvs1 \\ kvs'
403+ classes2' = classes2 \\ classes'
404+ kvs2' = kvs2 \\ kvs'
405+ in
406+ case null classes' && null kvs' of
407+ True -> d1 : (divReduce (d2 : blks))
408+ False -> let attr' = ("", classes', kvs')
409+ attr1' = (id1, classes1', kvs1')
410+ attr2' = (id2, classes2', kvs2')
411+ in
412+ divReduce (Div attr' [(Div attr1' blks1), (Div attr2' blks2)] :
413+ blks)
414+divReduce (blk:blks) = blk : (divReduce blks)
415+
416+isHeaderClass :: String -> Maybe Int
417+isHeaderClass s | "Heading" `isPrefixOf` s =
418+ case reads (drop (length "Heading") s) :: [(Int, String)] of
419+ [] -> Nothing
420+ ((n, "") : []) -> Just n
421+ _ -> Nothing
422+isHeaderClass _ = Nothing
423+
424+findHeaderClass :: [String] -> Maybe Int
425+findHeaderClass ss = case mapMaybe id $ map isHeaderClass ss of
426+ [] -> Nothing
427+ n : _ -> Just n
428+
429+blksToInlines :: [Block] -> [Inline]
430+blksToInlines (Para ils : _) = ils
431+blksToInlines (Plain ils : _) = ils
432+blksToInlines _ = []
433+
434+divCorrectPreReduce' :: Block -> [Block]
435+divCorrectPreReduce' (Div (ident, classes, kvs) blks)
436+ | isJust $ findHeaderClass classes =
437+ let n = fromJust $ findHeaderClass classes
438+ in
439+ [Header n (ident, delete ("Heading" ++ (show n)) classes, kvs) (blksToInlines blks)]
440+ | otherwise = [Div (ident, classes, kvs) blks]
441+divCorrectPreReduce' blk = [blk]
442+
443+divCorrectPreReduce :: [Block] -> [Block]
444+divCorrectPreReduce = concatMap divCorrectPreReduce'
445+
446+blkToCode :: Block -> String
447+blkToCode (Para []) = ""
448+blkToCode (Para ((Code _ s):ils)) = s ++ (blkToCode (Para ils))
449+blkToCode (Para ((Span (_, classes, _) ils'): ils))
450+ | (not . null) (codeSpans `intersect` classes) =
451+ (init $ unlines $ map ilToCode ils') ++ (blkToCode (Para ils))
452+blkToCode _ = ""
453+
454+divRemove' :: Block -> [Block]
455+divRemove' (Div (_, _, kvs) blks) =
456+ case lookup "indent" kvs of
457+ Just val -> [Div ("", [], [("indent", val)]) blks]
458+ Nothing -> blks
459+divRemove' blk = [blk]
460+
461+divRemove :: [Block] -> [Block]
462+divRemove = concatMap divRemove'
463+
464+divCorrect' :: Block -> [Block]
465+divCorrect' b@(Div (ident, classes, kvs) blks)
466+ | (not . null) (blockQuoteDivs `intersect` classes) =
467+ [BlockQuote [Div (ident, classes \\ blockQuoteDivs, kvs) blks]]
468+ | (not . null) (codeDivs `intersect` classes) =
469+ [CodeBlock (ident, (classes \\ codeDivs), kvs) (init $ unlines $ map blkToCode blks)]
470+ | otherwise =
471+ case lookup "indent" kvs of
472+ Just "0" -> [Div (ident, classes, filter (\kv -> fst kv /= "indent") kvs) blks]
473+ Just _ ->
474+ [BlockQuote [Div (ident, classes, filter (\kv -> fst kv /= "indent") kvs) blks]]
475+ Nothing -> [b]
476+divCorrect' blk = [blk]
477+
478+divCorrect :: [Block] -> [Block]
479+divCorrect = concatMap divCorrect'
src/Text/Pandoc/Readers/DocX/Lists.hsnew file+208
@@ -0,0 +1,208 @@
1+{-
2+Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Readers.DocX.Lists
21+ Copyright : Copyright (C) 2014 Jesse Rosenthal
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Functions for converting flat DocX paragraphs into nested lists.
29+-}
30+
31+module Text.Pandoc.Readers.DocX.Lists ( blocksToBullets
32+ , blocksToDefinitions) where
33+
34+import Text.Pandoc.JSON
35+import Text.Pandoc.Shared (trim)
36+import Control.Monad
37+import Data.List
38+import Data.Maybe
39+
40+isListItem :: Block -> Bool
41+isListItem (Div (_, classes, _) _) | "list-item" `elem` classes = True
42+isListItem _ = False
43+
44+getLevel :: Block -> Maybe Integer
45+getLevel (Div (_, _, kvs) _) = liftM read $ lookup "level" kvs
46+getLevel _ = Nothing
47+
48+getLevelN :: Block -> Integer
49+getLevelN b = case getLevel b of
50+ Just n -> n
51+ Nothing -> -1
52+
53+getNumId :: Block -> Maybe Integer
54+getNumId (Div (_, _, kvs) _) = liftM read $ lookup "num-id" kvs
55+getNumId _ = Nothing
56+
57+getNumIdN :: Block -> Integer
58+getNumIdN b = case getNumId b of
59+ Just n -> n
60+ Nothing -> -1
61+
62+getText :: Block -> Maybe String
63+getText (Div (_, _, kvs) _) = lookup "text" kvs
64+getText _ = Nothing
65+
66+data ListType = Itemized | Enumerated ListAttributes
67+
68+listStyleMap :: [(String, ListNumberStyle)]
69+listStyleMap = [("upperLetter", UpperAlpha),
70+ ("lowerLetter", LowerAlpha),
71+ ("upperRoman", UpperRoman),
72+ ("lowerRoman", LowerRoman),
73+ ("decimal", Decimal)]
74+
75+listDelimMap :: [(String, ListNumberDelim)]
76+listDelimMap = [("%1)", OneParen),
77+ ("(%1)", TwoParens),
78+ ("%1.", Period)]
79+
80+getListType :: Block -> Maybe ListType
81+getListType b@(Div (_, _, kvs) _) | isListItem b =
82+ let
83+ start = lookup "start" kvs
84+ frmt = lookup "format" kvs
85+ txt = lookup "text" kvs
86+ in
87+ case frmt of
88+ Just "bullet" -> Just Itemized
89+ Just f ->
90+ case txt of
91+ Just t -> Just $ Enumerated (
92+ read (fromMaybe "1" start) :: Int,
93+ fromMaybe DefaultStyle (lookup f listStyleMap),
94+ fromMaybe DefaultDelim (lookup t listDelimMap))
95+ Nothing -> Nothing
96+ _ -> Nothing
97+getListType _ = Nothing
98+
99+listParagraphDivs :: [String]
100+listParagraphDivs = ["ListParagraph"]
101+
102+-- This is a first stab at going through and attaching meaning to list
103+-- paragraphs, without an item marker, following a list item. We
104+-- assume that these are paragraphs in the same item.
105+
106+handleListParagraphs :: [Block] -> [Block]
107+handleListParagraphs [] = []
108+handleListParagraphs (
109+ (Div attr1@(_, classes1, _) blks1) :
110+ (Div (ident2, classes2, kvs2) blks2) :
111+ blks
112+ ) | "list-item" `elem` classes1 &&
113+ not ("list-item" `elem` classes2) &&
114+ (not . null) (listParagraphDivs `intersect` classes2) =
115+ -- We don't want to keep this indent.
116+ let newDiv2 =
117+ (Div (ident2, classes2, filter (\kv -> fst kv /= "indent") kvs2) blks2)
118+ in
119+ handleListParagraphs ((Div attr1 (blks1 ++ [newDiv2])) : blks)
120+handleListParagraphs (blk:blks) = blk : (handleListParagraphs blks)
121+
122+separateBlocks' :: Block -> [[Block]] -> [[Block]]
123+separateBlocks' blk ([] : []) = [[blk]]
124+separateBlocks' b@(BulletList _) acc = (init acc) ++ [(last acc) ++ [b]]
125+separateBlocks' b@(OrderedList _ _) acc = (init acc) ++ [(last acc) ++ [b]]
126+-- The following is for the invisible bullet lists. This is how
127+-- pandoc-generated ooxml does multiparagraph item lists.
128+separateBlocks' b acc | liftM trim (getText b) == Just "" =
129+ (init acc) ++ [(last acc) ++ [b]]
130+separateBlocks' b acc = acc ++ [[b]]
131+
132+separateBlocks :: [Block] -> [[Block]]
133+separateBlocks blks = foldr separateBlocks' [[]] (reverse blks)
134+
135+flatToBullets' :: Integer -> [Block] -> [Block]
136+flatToBullets' _ [] = []
137+flatToBullets' num xs@(b : elems)
138+ | getLevelN b == num = b : (flatToBullets' num elems)
139+ | otherwise =
140+ let bNumId = getNumIdN b
141+ bLevel = getLevelN b
142+ (children, remaining) =
143+ span
144+ (\b' ->
145+ ((getLevelN b') > bLevel ||
146+ ((getLevelN b') == bLevel && (getNumIdN b') == bNumId)))
147+ xs
148+ in
149+ case getListType b of
150+ Just (Enumerated attr) ->
151+ (OrderedList attr (separateBlocks $ flatToBullets' bLevel children)) :
152+ (flatToBullets' num remaining)
153+ _ ->
154+ (BulletList (separateBlocks $ flatToBullets' bLevel children)) :
155+ (flatToBullets' num remaining)
156+
157+flatToBullets :: [Block] -> [Block]
158+flatToBullets elems = flatToBullets' (-1) elems
159+
160+blocksToBullets :: [Block] -> [Block]
161+blocksToBullets blks =
162+ -- bottomUp removeListItemDivs $
163+ flatToBullets $ (handleListParagraphs blks)
164+
165+
166+plainParaInlines :: Block -> [Inline]
167+plainParaInlines (Plain ils) = ils
168+plainParaInlines (Para ils) = ils
169+plainParaInlines _ = []
170+
171+blocksToDefinitions' :: [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
172+blocksToDefinitions' [] acc [] = reverse acc
173+blocksToDefinitions' defAcc acc [] =
174+ reverse $ (DefinitionList (reverse defAcc)) : acc
175+blocksToDefinitions' defAcc acc
176+ ((Div (_, classes1, _) blks1) : (Div (ident2, classes2, kvs2) blks2) : blks)
177+ | "DefinitionTerm" `elem` classes1 && "Definition" `elem` classes2 =
178+ let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
179+ pair = case remainingAttr2 == ("", [], []) of
180+ True -> (concatMap plainParaInlines blks1, [blks2])
181+ False -> (concatMap plainParaInlines blks1, [[Div remainingAttr2 blks2]])
182+ in
183+ blocksToDefinitions' (pair : defAcc) acc blks
184+blocksToDefinitions' defAcc acc
185+ ((Div (ident2, classes2, kvs2) blks2) : blks)
186+ | (not . null) defAcc && "Definition" `elem` classes2 =
187+ let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
188+ defItems2 = case remainingAttr2 == ("", [], []) of
189+ True -> blks2
190+ False -> [Div remainingAttr2 blks2]
191+ ((defTerm, defItems):defs) = defAcc
192+ defAcc' = case null defItems of
193+ True -> (defTerm, [defItems2]) : defs
194+ False -> (defTerm, init defItems ++ [last defItems ++ defItems2]) : defs
195+ in
196+ blocksToDefinitions' defAcc' acc blks
197+blocksToDefinitions' [] acc (b:blks) =
198+ blocksToDefinitions' [] (b:acc) blks
199+blocksToDefinitions' defAcc acc (b:blks) =
200+ blocksToDefinitions' [] (b : (DefinitionList (reverse defAcc)) : acc) blks
201+
202+
203+blocksToDefinitions :: [Block] -> [Block]
204+blocksToDefinitions = blocksToDefinitions' [] []
205+
206+
207+
208+
src/Text/Pandoc/Readers/DocX/Parse.hsnew file+604
@@ -0,0 +1,604 @@
1+{-
2+Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Readers.DocX.Parse
21+ Copyright : Copyright (C) 2014 Jesse Rosenthal
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of DocX archive into DocX haskell type
29+-}
30+
31+
32+module Text.Pandoc.Readers.DocX.Parse ( DocX(..)
33+ , Document(..)
34+ , Body(..)
35+ , BodyPart(..)
36+ , TblLook(..)
37+ , ParPart(..)
38+ , Run(..)
39+ , RunElem(..)
40+ , Notes
41+ , Numbering
42+ , Relationship
43+ , Media
44+ , RunStyle(..)
45+ , ParagraphStyle(..)
46+ , Row(..)
47+ , Cell(..)
48+ , getFootNote
49+ , getEndNote
50+ , lookupLevel
51+ , lookupRelationship
52+ , archiveToDocX
53+ ) where
54+import Codec.Archive.Zip
55+import Text.XML.Light
56+import Data.Maybe
57+import Data.List
58+import System.FilePath
59+import Data.Bits ((.|.))
60+import qualified Data.ByteString.Lazy as B
61+import qualified Text.Pandoc.UTF8 as UTF8
62+
63+attrToNSPair :: Attr -> Maybe (String, String)
64+attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
65+attrToNSPair _ = Nothing
66+
67+
68+type NameSpaces = [(String, String)]
69+
70+data DocX = DocX Document Notes Numbering [Relationship] Media
71+ deriving Show
72+
73+archiveToDocX :: Archive -> Maybe DocX
74+archiveToDocX archive = do
75+ let notes = archiveToNotes archive
76+ rels = archiveToRelationships archive
77+ media = archiveToMedia archive
78+ doc <- archiveToDocument archive
79+ numbering <- archiveToNumbering archive
80+ return $ DocX doc notes numbering rels media
81+
82+data Document = Document NameSpaces Body
83+ deriving Show
84+
85+archiveToDocument :: Archive -> Maybe Document
86+archiveToDocument zf = do
87+ entry <- findEntryByPath "word/document.xml" zf
88+ docElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
89+ let namespaces = mapMaybe attrToNSPair (elAttribs docElem)
90+ bodyElem <- findChild (QName "body" (lookup "w" namespaces) Nothing) docElem
91+ body <- elemToBody namespaces bodyElem
92+ return $ Document namespaces body
93+
94+type Media = [(FilePath, B.ByteString)]
95+
96+filePathIsMedia :: FilePath -> Bool
97+filePathIsMedia fp =
98+ let (dir, _) = splitFileName fp
99+ in
100+ (dir == "word/media/")
101+
102+getMediaPair :: Archive -> FilePath -> Maybe (FilePath, B.ByteString)
103+getMediaPair zf fp =
104+ case findEntryByPath fp zf of
105+ Just e -> Just (fp, fromEntry e)
106+ Nothing -> Nothing
107+
108+archiveToMedia :: Archive -> Media
109+archiveToMedia zf =
110+ mapMaybe (getMediaPair zf) (filter filePathIsMedia (filesInArchive zf))
111+
112+data Numbering = Numbering NameSpaces [Numb] [AbstractNumb]
113+ deriving Show
114+
115+data Numb = Numb String String -- right now, only a key to an abstract num
116+ deriving Show
117+
118+data AbstractNumb = AbstractNumb String [Level]
119+ deriving Show
120+
121+-- (ilvl, format, string, start)
122+type Level = (String, String, String, Maybe Integer)
123+
124+lookupLevel :: String -> String -> Numbering -> Maybe Level
125+lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
126+ absNumId <- lookup numId $ map (\(Numb nid absnumid) -> (nid, absnumid)) numbs
127+ lvls <- lookup absNumId $ map (\(AbstractNumb aid ls) -> (aid, ls)) absNumbs
128+ lvl <- lookup ilvl $ map (\l@(i, _, _, _) -> (i, l)) lvls
129+ return lvl
130+
131+numElemToNum :: NameSpaces -> Element -> Maybe Numb
132+numElemToNum ns element |
133+ qName (elName element) == "num" &&
134+ qURI (elName element) == (lookup "w" ns) = do
135+ numId <- findAttr (QName "numId" (lookup "w" ns) (Just "w")) element
136+ absNumId <- findChild (QName "abstractNumId" (lookup "w" ns) (Just "w")) element
137+ >>= findAttr (QName "val" (lookup "w" ns) (Just "w"))
138+ return $ Numb numId absNumId
139+numElemToNum _ _ = Nothing
140+
141+absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
142+absNumElemToAbsNum ns element |
143+ qName (elName element) == "abstractNum" &&
144+ qURI (elName element) == (lookup "w" ns) = do
145+ absNumId <- findAttr
146+ (QName "abstractNumId" (lookup "w" ns) (Just "w"))
147+ element
148+ let levelElems = findChildren
149+ (QName "lvl" (lookup "w" ns) (Just "w"))
150+ element
151+ levels = mapMaybe id $ map (levelElemToLevel ns) levelElems
152+ return $ AbstractNumb absNumId levels
153+absNumElemToAbsNum _ _ = Nothing
154+
155+levelElemToLevel :: NameSpaces -> Element -> Maybe Level
156+levelElemToLevel ns element |
157+ qName (elName element) == "lvl" &&
158+ qURI (elName element) == (lookup "w" ns) = do
159+ ilvl <- findAttr (QName "ilvl" (lookup "w" ns) (Just "w")) element
160+ fmt <- findChild (QName "numFmt" (lookup "w" ns) (Just "w")) element
161+ >>= findAttr (QName "val" (lookup "w" ns) (Just "w"))
162+ txt <- findChild (QName "lvlText" (lookup "w" ns) (Just "w")) element
163+ >>= findAttr (QName "val" (lookup "w" ns) (Just "w"))
164+ let start = findChild (QName "start" (lookup "w" ns) (Just "w")) element
165+ >>= findAttr (QName "val" (lookup "w" ns) (Just "w"))
166+ >>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))
167+ return (ilvl, fmt, txt, start)
168+levelElemToLevel _ _ = Nothing
169+
170+archiveToNumbering :: Archive -> Maybe Numbering
171+archiveToNumbering zf =
172+ case findEntryByPath "word/numbering.xml" zf of
173+ Nothing -> Just $ Numbering [] [] []
174+ Just entry -> do
175+ numberingElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
176+ let namespaces = mapMaybe attrToNSPair (elAttribs numberingElem)
177+ numElems = findChildren
178+ (QName "num" (lookup "w" namespaces) (Just "w"))
179+ numberingElem
180+ absNumElems = findChildren
181+ (QName "abstractNum" (lookup "w" namespaces) (Just "w"))
182+ numberingElem
183+ nums = mapMaybe id $ map (numElemToNum namespaces) numElems
184+ absNums = mapMaybe id $ map (absNumElemToAbsNum namespaces) absNumElems
185+ return $ Numbering namespaces nums absNums
186+
187+data Notes = Notes NameSpaces (Maybe [(String, [BodyPart])]) (Maybe [(String, [BodyPart])])
188+ deriving Show
189+
190+noteElemToNote :: NameSpaces -> Element -> Maybe (String, [BodyPart])
191+noteElemToNote ns element
192+ | qName (elName element) `elem` ["endnote", "footnote"] &&
193+ qURI (elName element) == (lookup "w" ns) =
194+ do
195+ noteId <- findAttr (QName "id" (lookup "w" ns) (Just "w")) element
196+ let bps = map fromJust
197+ $ filter isJust
198+ $ map (elemToBodyPart ns)
199+ $ filterChildrenName (isParOrTbl ns) element
200+ return $ (noteId, bps)
201+noteElemToNote _ _ = Nothing
202+
203+getFootNote :: String -> Notes -> Maybe [BodyPart]
204+getFootNote s (Notes _ fns _) = fns >>= (lookup s)
205+
206+getEndNote :: String -> Notes -> Maybe [BodyPart]
207+getEndNote s (Notes _ _ ens) = ens >>= (lookup s)
208+
209+elemToNotes :: NameSpaces -> String -> Element -> Maybe [(String, [BodyPart])]
210+elemToNotes ns notetype element
211+ | qName (elName element) == (notetype ++ "s") &&
212+ qURI (elName element) == (lookup "w" ns) =
213+ Just $ map fromJust
214+ $ filter isJust
215+ $ map (noteElemToNote ns)
216+ $ findChildren (QName notetype (lookup "w" ns) (Just "w")) element
217+elemToNotes _ _ _ = Nothing
218+
219+archiveToNotes :: Archive -> Notes
220+archiveToNotes zf =
221+ let fnElem = findEntryByPath "word/footnotes.xml" zf
222+ >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)
223+ enElem = findEntryByPath "word/endnotes.xml" zf
224+ >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)
225+ fn_namespaces = case fnElem of
226+ Just e -> mapMaybe attrToNSPair (elAttribs e)
227+ Nothing -> []
228+ en_namespaces = case enElem of
229+ Just e -> mapMaybe attrToNSPair (elAttribs e)
230+ Nothing -> []
231+ ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces
232+ fn = fnElem >>= (elemToNotes ns "footnote")
233+ en = enElem >>= (elemToNotes ns "endnote")
234+ in
235+ Notes ns fn en
236+
237+
238+data Relationship = Relationship (RelId, Target)
239+ deriving Show
240+
241+lookupRelationship :: RelId -> [Relationship] -> Maybe Target
242+lookupRelationship relid rels =
243+ lookup relid (map (\(Relationship pair) -> pair) rels)
244+
245+filePathIsRel :: FilePath -> Bool
246+filePathIsRel fp =
247+ let (dir, name) = splitFileName fp
248+ in
249+ (dir == "word/_rels/") && ((takeExtension name) == ".rels")
250+
251+relElemToRelationship :: Element -> Maybe Relationship
252+relElemToRelationship element | qName (elName element) == "Relationship" =
253+ do
254+ relId <- findAttr (QName "Id" Nothing Nothing) element
255+ target <- findAttr (QName "Target" Nothing Nothing) element
256+ return $ Relationship (relId, target)
257+relElemToRelationship _ = Nothing
258+
259+
260+archiveToRelationships :: Archive -> [Relationship]
261+archiveToRelationships archive =
262+ let relPaths = filter filePathIsRel (filesInArchive archive)
263+ entries = map fromJust $ filter isJust $ map (\f -> findEntryByPath f archive) relPaths
264+ relElems = map fromJust $ filter isJust $ map (parseXMLDoc . UTF8.toStringLazy . fromEntry) entries
265+ rels = map fromJust $ filter isJust $ map relElemToRelationship $ concatMap elChildren relElems
266+ in
267+ rels
268+
269+data Body = Body [BodyPart]
270+ deriving Show
271+
272+isParOrTbl :: NameSpaces -> QName -> Bool
273+isParOrTbl ns q = qName q `elem` ["p", "tbl"] &&
274+ qURI q == (lookup "w" ns)
275+
276+elemToBody :: NameSpaces -> Element -> Maybe Body
277+elemToBody ns element | qName (elName element) == "body" && qURI (elName element) == (lookup "w" ns) =
278+ Just $ Body
279+ $ map fromJust
280+ $ filter isJust
281+ $ map (elemToBodyPart ns) $ filterChildrenName (isParOrTbl ns) element
282+elemToBody _ _ = Nothing
283+
284+isRunOrLinkOrBookmark :: NameSpaces -> QName -> Bool
285+isRunOrLinkOrBookmark ns q = qName q `elem` ["r", "hyperlink", "bookmarkStart"] &&
286+ qURI q == (lookup "w" ns)
287+
288+elemToNumInfo :: NameSpaces -> Element -> Maybe (String, String)
289+elemToNumInfo ns element
290+ | qName (elName element) == "p" &&
291+ qURI (elName element) == (lookup "w" ns) =
292+ do
293+ pPr <- findChild (QName "pPr" (lookup "w" ns) (Just "w")) element
294+ numPr <- findChild (QName "numPr" (lookup "w" ns) (Just "w")) pPr
295+ lvl <- findChild (QName "ilvl" (lookup "w" ns) (Just "w")) numPr >>=
296+ findAttr (QName "val" (lookup "w" ns) (Just "w"))
297+ numId <- findChild (QName "numId" (lookup "w" ns) (Just "w")) numPr >>=
298+ findAttr (QName "val" (lookup "w" ns) (Just "w"))
299+ return (numId, lvl)
300+elemToNumInfo _ _ = Nothing
301+
302+-- isBookMarkTag :: NameSpaces -> QName -> Bool
303+-- isBookMarkTag ns q = qName q `elem` ["bookmarkStart", "bookmarkEnd"] &&
304+-- qURI q == (lookup "w" ns)
305+
306+-- parChildrenToBookmark :: NameSpaces -> [Element] -> BookMark
307+-- parChildrenToBookmark ns (bms : bme : _)
308+-- | qName (elName bms) == "bookmarkStart" &&
309+-- qURI (elName bms) == (lookup "w" ns) &&
310+-- qName (elName bme) == "bookmarkEnd" &&
311+-- qURI (elName bme) == (lookup "w" ns) = do
312+-- bmId <- findAttr (QName "id" (lookup "w" ns) (Just "w")) bms
313+-- bmName <- findAttr (QName "name" (lookup "w" ns) (Just "w")) bms
314+-- return $ (bmId, bmName)
315+-- parChildrenToBookmark _ _ = Nothing
316+
317+elemToBodyPart :: NameSpaces -> Element -> Maybe BodyPart
318+elemToBodyPart ns element
319+ | qName (elName element) == "p" &&
320+ qURI (elName element) == (lookup "w" ns) =
321+ let parstyle = elemToParagraphStyle ns element
322+ parparts = mapMaybe id
323+ $ map (elemToParPart ns)
324+ $ filterChildrenName (isRunOrLinkOrBookmark ns) element
325+ in
326+ case elemToNumInfo ns element of
327+ Just (numId, lvl) -> Just $ ListItem parstyle numId lvl parparts
328+ Nothing -> Just $ Paragraph parstyle parparts
329+ | qName (elName element) == "tbl" &&
330+ qURI (elName element) == (lookup "w" ns) =
331+ let
332+ caption = findChild (QName "tblPr" (lookup "w" ns) (Just "w")) element
333+ >>= findChild (QName "tblCaption" (lookup "w" ns) (Just "w"))
334+ >>= findAttr (QName "val" (lookup "w" ns) (Just "w"))
335+ grid = case
336+ findChild (QName "tblGrid" (lookup "w" ns) (Just "w")) element
337+ of
338+ Just g -> elemToTblGrid ns g
339+ Nothing -> []
340+ tblLook = findChild (QName "tblPr" (lookup "w" ns) (Just "w")) element
341+ >>= findChild (QName "tblLook" (lookup "w" ns) (Just "w"))
342+ >>= elemToTblLook ns
343+ in
344+ Just $ Tbl
345+ (fromMaybe "" caption)
346+ grid
347+ (fromMaybe defaultTblLook tblLook)
348+ (mapMaybe (elemToRow ns) (elChildren element))
349+ | otherwise = Nothing
350+
351+elemToTblLook :: NameSpaces -> Element -> Maybe TblLook
352+elemToTblLook ns element
353+ | qName (elName element) == "tblLook" &&
354+ qURI (elName element) == (lookup "w" ns) =
355+ let firstRow = findAttr (QName "firstRow" (lookup "w" ns) (Just "w")) element
356+ val = findAttr (QName "val" (lookup "w" ns) (Just "w")) element
357+ firstRowFmt =
358+ case firstRow of
359+ Just "1" -> True
360+ Just _ -> False
361+ Nothing -> case val of
362+ Just bitMask -> testBitMask bitMask 0x020
363+ Nothing -> False
364+ in
365+ Just $ TblLook{firstRowFormatting = firstRowFmt}
366+elemToTblLook _ _ = Nothing
367+
368+testBitMask :: String -> Int -> Bool
369+testBitMask bitMaskS n =
370+ case (reads ("0x" ++ bitMaskS) :: [(Int, String)]) of
371+ [] -> False
372+ ((n', _) : _) -> ((n' .|. n) /= 0)
373+
374+data ParagraphStyle = ParagraphStyle { pStyle :: [String]
375+ , indent :: Maybe Integer
376+ }
377+ deriving Show
378+
379+defaultParagraphStyle :: ParagraphStyle
380+defaultParagraphStyle = ParagraphStyle { pStyle = []
381+ , indent = Nothing
382+ }
383+
384+elemToParagraphStyle :: NameSpaces -> Element -> ParagraphStyle
385+elemToParagraphStyle ns element =
386+ case findChild (QName "pPr" (lookup "w" ns) (Just "w")) element of
387+ Just pPr ->
388+ ParagraphStyle
389+ {pStyle =
390+ mapMaybe id $
391+ map
392+ (findAttr (QName "val" (lookup "w" ns) (Just "w")))
393+ (findChildren (QName "pStyle" (lookup "w" ns) (Just "w")) pPr)
394+ , indent =
395+ findChild (QName "ind" (lookup "w" ns) (Just "w")) pPr >>=
396+ findAttr (QName "left" (lookup "w" ns) (Just "w")) >>=
397+ stringToInteger
398+ }
399+ Nothing -> defaultParagraphStyle
400+
401+
402+data BodyPart = Paragraph ParagraphStyle [ParPart]
403+ | ListItem ParagraphStyle String String [ParPart]
404+ | Tbl String TblGrid TblLook [Row]
405+
406+ deriving Show
407+
408+type TblGrid = [Integer]
409+
410+data TblLook = TblLook {firstRowFormatting::Bool}
411+ deriving Show
412+
413+defaultTblLook :: TblLook
414+defaultTblLook = TblLook{firstRowFormatting = False}
415+
416+stringToInteger :: String -> Maybe Integer
417+stringToInteger s = listToMaybe $ map fst (reads s :: [(Integer, String)])
418+
419+elemToTblGrid :: NameSpaces -> Element -> TblGrid
420+elemToTblGrid ns element
421+ | qName (elName element) == "tblGrid" &&
422+ qURI (elName element) == (lookup "w" ns) =
423+ let
424+ cols = findChildren (QName "gridCol" (lookup "w" ns) (Just "w")) element
425+ in
426+ mapMaybe (\e ->
427+ findAttr (QName "val" (lookup "w" ns) (Just ("w"))) e
428+ >>= stringToInteger
429+ )
430+ cols
431+elemToTblGrid _ _ = []
432+
433+data Row = Row [Cell]
434+ deriving Show
435+
436+
437+elemToRow :: NameSpaces -> Element -> Maybe Row
438+elemToRow ns element
439+ | qName (elName element) == "tr" &&
440+ qURI (elName element) == (lookup "w" ns) =
441+ let
442+ cells = findChildren (QName "tc" (lookup "w" ns) (Just "w")) element
443+ in
444+ Just $ Row (mapMaybe (elemToCell ns) cells)
445+elemToRow _ _ = Nothing
446+
447+data Cell = Cell [BodyPart]
448+ deriving Show
449+
450+elemToCell :: NameSpaces -> Element -> Maybe Cell
451+elemToCell ns element
452+ | qName (elName element) == "tc" &&
453+ qURI (elName element) == (lookup "w" ns) =
454+ Just $ Cell (mapMaybe (elemToBodyPart ns) (elChildren element))
455+elemToCell _ _ = Nothing
456+
457+data ParPart = PlainRun Run
458+ | BookMark BookMarkId Anchor
459+ | InternalHyperLink Anchor [Run]
460+ | ExternalHyperLink RelId [Run]
461+ | Drawing String
462+ deriving Show
463+
464+data Run = Run RunStyle [RunElem]
465+ | Footnote String
466+ | Endnote String
467+ deriving Show
468+
469+data RunElem = TextRun String | LnBrk
470+ deriving Show
471+
472+data RunStyle = RunStyle { isBold :: Bool
473+ , isItalic :: Bool
474+ , isSmallCaps :: Bool
475+ , isStrike :: Bool
476+ , isSuperScript :: Bool
477+ , isSubScript :: Bool
478+ , underline :: Maybe String
479+ , rStyle :: Maybe String }
480+ deriving Show
481+
482+defaultRunStyle :: RunStyle
483+defaultRunStyle = RunStyle { isBold = False
484+ , isItalic = False
485+ , isSmallCaps = False
486+ , isStrike = False
487+ , isSuperScript = False
488+ , isSubScript = False
489+ , underline = Nothing
490+ , rStyle = Nothing
491+ }
492+
493+elemToRunStyle :: NameSpaces -> Element -> RunStyle
494+elemToRunStyle ns element =
495+ case findChild (QName "rPr" (lookup "w" ns) (Just "w")) element of
496+ Just rPr ->
497+ RunStyle
498+ {
499+ isBold = isJust $ findChild (QName "b" (lookup "w" ns) (Just "w")) rPr
500+ , isItalic = isJust $ findChild (QName "i" (lookup "w" ns) (Just "w")) rPr
501+ , isSmallCaps = isJust $ findChild (QName "smallCaps" (lookup "w" ns) (Just "w")) rPr
502+ , isStrike = isJust $ findChild (QName "strike" (lookup "w" ns) (Just "w")) rPr
503+ , isSuperScript =
504+ (Just "superscript" ==
505+ (findChild (QName "vertAlign" (lookup "w" ns) (Just "w")) rPr >>=
506+ findAttr (QName "val" (lookup "w" ns) (Just "w"))))
507+ , isSubScript =
508+ (Just "subscript" ==
509+ (findChild (QName "vertAlign" (lookup "w" ns) (Just "w")) rPr >>=
510+ findAttr (QName "val" (lookup "w" ns) (Just "w"))))
511+ , underline =
512+ findChild (QName "u" (lookup "w" ns) (Just "w")) rPr >>=
513+ findAttr (QName "val" (lookup "w" ns) (Just "w"))
514+ , rStyle =
515+ findChild (QName "rStyle" (lookup "w" ns) (Just "w")) rPr >>=
516+ findAttr (QName "val" (lookup "w" ns) (Just "w"))
517+ }
518+ Nothing -> defaultRunStyle
519+
520+elemToRun :: NameSpaces -> Element -> Maybe Run
521+elemToRun ns element
522+ | qName (elName element) == "r" &&
523+ qURI (elName element) == (lookup "w" ns) =
524+ case
525+ findChild (QName "footnoteReference" (lookup "w" ns) (Just "w")) element >>=
526+ findAttr (QName "id" (lookup "w" ns) (Just "w"))
527+ of
528+ Just s -> Just $ Footnote s
529+ Nothing ->
530+ case
531+ findChild (QName "endnoteReference" (lookup "w" ns) (Just "w")) element >>=
532+ findAttr (QName "id" (lookup "w" ns) (Just "w"))
533+ of
534+ Just s -> Just $ Endnote s
535+ Nothing -> Just $
536+ Run (elemToRunStyle ns element)
537+ (elemToRunElems ns element)
538+elemToRun _ _ = Nothing
539+
540+elemToRunElem :: NameSpaces -> Element -> Maybe RunElem
541+elemToRunElem ns element
542+ | qName (elName element) == "t" &&
543+ qURI (elName element) == (lookup "w" ns) =
544+ Just $ TextRun (strContent element)
545+ | qName (elName element) == "br" &&
546+ qURI (elName element) == (lookup "w" ns) =
547+ Just $ LnBrk
548+ | otherwise = Nothing
549+
550+
551+elemToRunElems :: NameSpaces -> Element -> [RunElem]
552+elemToRunElems ns element
553+ | qName (elName element) == "r" &&
554+ qURI (elName element) == (lookup "w" ns) =
555+ mapMaybe (elemToRunElem ns) (elChildren element)
556+ | otherwise = []
557+
558+elemToDrawing :: NameSpaces -> Element -> Maybe ParPart
559+elemToDrawing ns element
560+ | qName (elName element) == "drawing" &&
561+ qURI (elName element) == (lookup "w" ns) =
562+ let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
563+ in
564+ findElement (QName "blip" (Just a_ns) (Just "a")) element
565+ >>= findAttr (QName "embed" (lookup "r" ns) (Just "r"))
566+ >>= (\s -> Just $ Drawing s)
567+elemToDrawing _ _ = Nothing
568+
569+
570+elemToParPart :: NameSpaces -> Element -> Maybe ParPart
571+elemToParPart ns element
572+ | qName (elName element) == "r" &&
573+ qURI (elName element) == (lookup "w" ns) =
574+ case findChild (QName "drawing" (lookup "w" ns) (Just "w")) element of
575+ Just drawingElem -> elemToDrawing ns drawingElem
576+ Nothing -> do
577+ r <- elemToRun ns element
578+ return $ PlainRun r
579+elemToParPart ns element
580+ | qName (elName element) == "bookmarkStart" &&
581+ qURI (elName element) == (lookup "w" ns) = do
582+ bmId <- findAttr (QName "id" (lookup "w" ns) (Just "w")) element
583+ bmName <- findAttr (QName "name" (lookup "w" ns) (Just "w")) element
584+ return $ BookMark bmId bmName
585+elemToParPart ns element
586+ | qName (elName element) == "hyperlink" &&
587+ qURI (elName element) == (lookup "w" ns) =
588+ let runs = map fromJust $ filter isJust $ map (elemToRun ns)
589+ $ findChildren (QName "r" (lookup "w" ns) (Just "w")) element
590+ in
591+ case findAttr (QName "anchor" (lookup "w" ns) (Just "w")) element of
592+ Just anchor ->
593+ Just $ InternalHyperLink anchor runs
594+ Nothing ->
595+ case findAttr (QName "id" (lookup "r" ns) (Just "r")) element of
596+ Just relId -> Just $ ExternalHyperLink relId runs
597+ Nothing -> Nothing
598+elemToParPart _ _ = Nothing
599+
600+type Target = String
601+type Anchor = String
602+type BookMarkId = String
603+type RelId = String
604+
tests/Tests/Readers/DocX.hsnew file+68
@@ -0,0 +1,68 @@
1+module Tests.Readers.DocX (tests) where
2+
3+import Text.Pandoc.Options
4+import Text.Pandoc.Readers.Native
5+import Text.Pandoc.Definition
6+import Tests.Helpers
7+import Test.Framework
8+import qualified Data.ByteString.Lazy as B
9+import Text.Pandoc.Readers.DocX
10+
11+compareOutput :: FilePath -> FilePath -> IO (Pandoc, Pandoc)
12+compareOutput docxFile nativeFile = do
13+ df <- B.readFile docxFile
14+ nf <- Prelude.readFile nativeFile
15+ return $ (readDocX def df, readNative nf)
16+
17+testCompare' :: String -> FilePath -> FilePath -> IO Test
18+testCompare' name docxFile nativeFile = do
19+ (dp, np) <- compareOutput docxFile nativeFile
20+ return $ test id name (dp, np)
21+
22+testCompare :: String -> FilePath -> FilePath -> Test
23+testCompare name docxFile nativeFile =
24+ buildTest $ testCompare' name docxFile nativeFile
25+
26+
27+tests :: [Test]
28+tests = [ testGroup "inlines"
29+ [ testCompare
30+ "font formatting"
31+ "docx.inline_formatting.docx"
32+ "docx.inline_formatting.native"
33+ , testCompare
34+ "hyperlinks"
35+ "docx.links.docx"
36+ "docx.links.native"
37+ , testCompare
38+ "inline image with reference output"
39+ "docx.image.docx"
40+ "docx.image_no_embed.native"
41+ , testCompare
42+ "handling unicode input"
43+ "docx.unicode.docx"
44+ "docx.unicode.native"]
45+ , testGroup "blocks"
46+ [ testCompare
47+ "headers"
48+ "docx.headers.docx"
49+ "docx.headers.native"
50+ , testCompare
51+ "lists"
52+ "docx.lists.docx"
53+ "docx.lists.native"
54+ , testCompare
55+ "footnotes and endnotes"
56+ "docx.notes.docx"
57+ "docx.notes.native"
58+ , testCompare
59+ "blockquotes (parsing indent as blockquote)"
60+ "docx.block_quotes.docx"
61+ "docx.block_quotes_parse_indent.native"
62+ , testCompare
63+ "tables"
64+ "docx.tables.docx"
65+ "docx.tables.native"
66+ ]
67+ ]
68+
tests/docx.block_quotes.docxnew file

Binary file not shown.

tests/docx.block_quotes_parse_indent.nativenew file+8
@@ -0,0 +1,8 @@
1+[Header 2 ("",[],[]) [Str "Some",Space,Str "block",Space,Str "quotes,",Space,Str "in",Space,Str "different",Space,Str "ways"]
2+,Para [Str "This",Space,Str "is",Space,Str "the",Space,Str "proper",Space,Str "way,",Space,Str "with",Space,Str "a",Space,Str "style"]
3+,BlockQuote
4+ [Para [Str "I",Space,Str "don\8217t",Space,Str "know",Space,Str "why",Space,Str "this",Space,Str "would",Space,Str "be",Space,Str "in",Space,Str "italics,",Space,Str "but",Space,Str "so",Space,Str "it",Space,Str "appears",Space,Str "to",Space,Str "be",Space,Str "on",Space,Str "my",Space,Str "screen."]]
5+,Para [Str "And",Space,Str "this",Space,Str "is",Space,Str "the",Space,Str "way",Space,Str "that",Space,Str "most",Space,Str "people",Space,Str "do",Space,Str "it:"]
6+,BlockQuote
7+ [Para [Str "I",Space,Str "just",Space,Str "indented",Space,Str "this,",Space,Str "so",Space,Str "it",Space,Str "looks",Space,Str "like",Space,Str "a",Space,Str "block",Space,Str "quote.",Space,Str "I",Space,Str "think",Space,Str "this",Space,Str "is",Space,Str "how",Space,Str "most",Space,Str "people",Space,Str "do",Space,Str "block",Space,Str "quotes",Space,Str "in",Space,Str "their",Space,Str "documents."]]
8+,Para [Str "And",Space,Str "back",Space,Str "to",Space,Str "the",Space,Str "normal",Space,Str "style."]]
tests/docx.headers.docxnew file

Binary file not shown.

tests/docx.headers.nativenew file+5
@@ -0,0 +1,5 @@
1+[Header 1 ("",[],[]) [Str "A",Space,Str "Test",Space,Str "of",Space,Str "Headers"]
2+,Header 2 ("",[],[]) [Str "Second",Space,Str "Level"]
3+,Para [Str "Some",Space,Str "plain",Space,Str "text."]
4+,Header 3 ("",[],[]) [Str "Third",Space,Str "level"]
5+,Para [Str "Some",Space,Str "more",Space,Str "plain",Space,Str "text."]]
tests/docx.image.docxnew file

Binary file not shown.

tests/docx.image_no_embed.nativenew file+2
@@ -0,0 +1,2 @@
1+[Header 2 ("",[],[]) [Str "An",Space,Str "image"]
2+,Para [Image [] ("word/media/image1.jpeg","")]]
tests/docx.inline_formatting.docxnew file

Binary file not shown.

tests/docx.inline_formatting.nativenew file+5
@@ -0,0 +1,5 @@
1+[Para [Str "Regular",Space,Str "text",Space,Emph [Str "italics"],Space,Strong [Str "bold",Space,Emph [Str "bold",Space,Str "italics"]],Str "."]
2+,Para [Str "This",Space,Str "is",Space,SmallCaps [Str "Small",Space,Str "Caps"],Str ",",Space,Str "and",Space,Str "this",Space,Str "is",Space,Strikeout [Str "strikethrough"],Str "."]
3+,Para [Str "Some",Space,Str "people",Space,Str "use",Space,Span ("",[],[("underline","single")]) [Str "single",Space,Str "underlines",Space,Str "for",Space,Emph [Str "emphasis"]],Str "."]
4+,Para [Str "Above",Space,Str "the",Space,Str "line",Space,Str "is",Space,Superscript [Str "superscript"],Space,Str "and",Space,Str "below",Space,Str "the",Space,Str "line",Space,Str "is",Space,Subscript [Str "subscript"],Str "."]
5+,Para [Str "A",Space,Str "line",LineBreak,Str "break."]]
tests/docx.links.docxnew file

Binary file not shown.

tests/docx.links.nativenew file+6
@@ -0,0 +1,6 @@
1+[Header 2 ("",[],[]) [Str "An",Space,Str "internal",Space,Str "link",Space,Str "and",Space,Str "an",Space,Str "external",Space,Str "link"]
2+,Para [Str "An",Space,Link [Str "external",Space,Str "link"] ("http://google.com",""),Space,Str "to",Space,Str "a",Space,Str "popular",Space,Str "website."]
3+,Para [Str "An",Space,Link [Str "internal",Space,Str "link"] ("#_A_section_for",""),Space,Str "to",Space,Str "a",Space,Str "section",Space,Str "header."]
4+,Para [Str "An",Space,Link [Str "internal",Space,Str "link"] ("#my_bookmark",""),Space,Str "to",Space,Str "a",Space,Str "bookmark."]
5+,Header 2 ("_A_section_for",[],[]) [Str "A",Space,Str "section",Space,Str "for",Space,Str "testing",Space,Str "link",Space,Str "targets"]
6+,Para [Str "A",Space,Str "bookmark",Space,Str "right",Space,Span ("my_bookmark",["anchor"],[]) [],Str "here"]]
tests/docx.lists.docxnew file

Binary file not shown.

tests/docx.lists.nativenew file+18
@@ -0,0 +1,18 @@
1+[Header 2 ("",[],[]) [Str "Some",Space,Str "nested",Space,Str "lists"]
2+,OrderedList (1,Decimal,Period)
3+ [[Para [Str "one"]]
4+ ,[Para [Str "two"]
5+ ,OrderedList (1,LowerAlpha,DefaultDelim)
6+ [[Para [Str "a"]]
7+ ,[Para [Str "b"]]]]]
8+,BulletList
9+ [[Para [Str "one"]]
10+ ,[Para [Str "two"]
11+ ,BulletList
12+ [[Para [Str "three"]
13+ ,BulletList
14+ [[Para [Str "four"]
15+ ,Para [Str "Sub",Space,Str "paragraph"]]]]]]
16+ ,[Para [Str "Same",Space,Str "list"]]]
17+,BulletList
18+ [[Para [Str "Different",Space,Str "list",Space,Str "adjacent",Space,Str "to",Space,Str "the",Space,Str "one",Space,Str "above."]]]]
tests/docx.notes.docxnew file

Binary file not shown.

tests/docx.notes.nativenew file+2
@@ -0,0 +1,2 @@
1+[Header 2 ("",[],[]) [Str "A",Space,Str "footnote"]
2+,Para [Str "Test",Space,Str "footnote.",Note [Para [Space,Str "My",Space,Str "note."]],Space,Str "Test",Space,Str "endnote.",Note [Para [Space,Str "This",Space,Str "is",Space,Str "an",Space,Str "endnote",Space,Str "at",Space,Str "the",Space,Str "end",Space,Str "of",Space,Str "the",Space,Str "document."]]]]
tests/docx.tables.docxnew file

Binary file not shown.

tests/docx.tables.nativenew file+24
@@ -0,0 +1,24 @@
1+[Header 2 ("",[],[]) [Str "A",Space,Str "table,",Space,Str "with",Space,Str "and",Space,Str "without",Space,Str "a",Space,Str "header",Space,Str "row"]
2+,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0]
3+ [[Para [Str "Name"]]
4+ ,[Para [Str "Game"]]
5+ ,[Para [Str "Fame"]]
6+ ,[Para [Str "Blame"]]]
7+ [[[Para [Str "Lebron",Space,Str "James"]]
8+ ,[Para [Str "Basketball"]]
9+ ,[Para [Str "Very",Space,Str "High"]]
10+ ,[Para [Str "Leaving",Space,Str "Cleveland"]]]
11+ ,[[Para [Str "Ryan",Space,Str "Braun"]]
12+ ,[Para [Str "Baseball"]]
13+ ,[Para [Str "Moderate"]]
14+ ,[Para [Str "Steroids"]]]
15+ ,[[Para [Str "Russell",Space,Str "Wilson"]]
16+ ,[Para [Str "Football"]]
17+ ,[Para [Str "High"]]
18+ ,[Para [Str "Tacky",Space,Str "uniform"]]]]
19+,Table [] [AlignDefault,AlignDefault] [0.0,0.0]
20+ []
21+ [[[Para [Str "Sinple"]]
22+ ,[Para [Str "Table"]]]
23+ ,[[Para [Str "Without"]]
24+ ,[Para [Str "Header"]]]]]
tests/docx.unicode.docxnew file

Binary file not shown.

tests/docx.unicode.nativenew file+1
@@ -0,0 +1 @@
1+[Para [Str "Hello,",Space,Str "\19990\30028.",Space,Str "This",Space,Str "costs",Space,Str "\8364\&10."]]
tests/test-pandoc.hs+3
@@ -9,6 +9,7 @@ import qualified Tests.Readers.LaTeX
9import qualified Tests.Readers.Markdown
9import qualified Tests.Readers.Markdown
10import qualified Tests.Readers.Org
10import qualified Tests.Readers.Org
11import qualified Tests.Readers.RST
11import qualified Tests.Readers.RST
12+import qualified Tests.Readers.DocX
12import qualified Tests.Writers.ConTeXt
13import qualified Tests.Writers.ConTeXt
13import qualified Tests.Writers.LaTeX
14import qualified Tests.Writers.LaTeX
14import qualified Tests.Writers.HTML
15import qualified Tests.Writers.HTML
@@ -38,6 +39,8 @@ tests = [ testGroup "Old" Tests.Old.tests
38 , testGroup "Markdown" Tests.Readers.Markdown.tests
39 , testGroup "Markdown" Tests.Readers.Markdown.tests
39 , testGroup "Org" Tests.Readers.Org.tests
40 , testGroup "Org" Tests.Readers.Org.tests
40 , testGroup "RST" Tests.Readers.RST.tests
41 , testGroup "RST" Tests.Readers.RST.tests
42+ , testGroup "DocX" Tests.Readers.DocX.tests
43+
41 ]
44 ]
42 ]
45 ]
43
46