git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #1368 from jkr/docxCode

Docx verbatim code formatting

commit98ca2e512c48e532f778fd1401245c1dbcf55c9d authorJohn MacFarlane <jgm@berkeley.edu> dateTue 24 Jun 2014, 11:28 (12 years ago) parentfc4e6b3a8866bc
8 files changed+81−39
src/Text/Pandoc/Readers/Docx.hs+57−39 tests/Tests/Readers/Docx.hs+13 tests/docx.codeblock.docx tests/docx.codeblock.native+3 tests/docx.definition_list.docx tests/docx.definition_list.native+7 tests/docx.inline_code.docx tests/docx.inline_code.native+1
src/Text/Pandoc/Readers/Docx.hs+57−39
@@ -76,7 +76,6 @@ import Codec.Archive.Zip
7676import Text.Pandoc.Definition
7777import Text.Pandoc.Options
7878import Text.Pandoc.Builder (text, toList)
79−import Text.Pandoc.Generic (bottomUp)
8079import Text.Pandoc.MIME (getMimeType)
8180import Text.Pandoc.UTF8 (toString)
8281import Text.Pandoc.Walk
@@ -84,7 +83,7 @@ import Text.Pandoc.Readers.Docx.Parse
8483import Text.Pandoc.Readers.Docx.Lists
8584import Text.Pandoc.Readers.Docx.Reducible
8685import Data.Maybe (mapMaybe, isJust, fromJust)
87−import Data.List (delete, isPrefixOf, (\\), intersect)
86+import Data.List (delete, isPrefixOf, (\\))
8887import qualified Data.ByteString as BS
8988import qualified Data.ByteString.Lazy as B
9089import Data.ByteString.Base64 (encode)
@@ -99,29 +98,37 @@ readDocx opts bytes =
9998 Nothing -> error $ "couldn't parse docx file"
10099
101100spansToKeep :: [String]
102−spansToKeep = ["list-item", "Definition", "DefinitionTerm"] ++ codeSpans
101+spansToKeep = []
103102
104103
105104-- This is empty, but we put it in for future-proofing.
106105divsToKeep :: [String]
107−divsToKeep = []
106+divsToKeep = ["list-item", "Definition", "DefinitionTerm"]
108107
109108runStyleToContainers :: RunStyle -> [Container Inline]
110109runStyleToContainers rPr =
111− let formatters = mapMaybe id
112− [ if isBold rPr then (Just Strong) else Nothing
113− , if isItalic rPr then (Just Emph) else Nothing
114− , if isSmallCaps rPr then (Just SmallCaps) else Nothing
115− , if isStrike rPr then (Just Strikeout) else Nothing
116− , if isSuperScript rPr then (Just Superscript) else Nothing
117− , if isSubScript rPr then (Just Subscript) else Nothing
118− , rStyle rPr >>=
119− (\s -> if s `elem` spansToKeep then Just s else Nothing) >>=
120− (\s -> Just $ Span ("", [s], []))
121− , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))
110+ let spanClassToContainers :: String -> [Container Inline]
111+ spanClassToContainers s | s `elem` codeSpans =
112+ [Container $ (\ils -> Code ("", [], []) (concatMap ilToCode ils))]
113+ spanClassToContainers s | s `elem` spansToKeep =
114+ [Container $ Span ("", [s], [])]
115+ spanClassToContainers _ = []
116+
117+ classContainers = case rStyle rPr of
118+ Nothing -> []
119+ Just s -> spanClassToContainers s
120+
121+ formatters = map Container $ mapMaybe id
122+ [ if isBold rPr then (Just Strong) else Nothing
123+ , if isItalic rPr then (Just Emph) else Nothing
124+ , if isSmallCaps rPr then (Just SmallCaps) else Nothing
125+ , if isStrike rPr then (Just Strikeout) else Nothing
126+ , if isSuperScript rPr then (Just Superscript) else Nothing
127+ , if isSubScript rPr then (Just Subscript) else Nothing
128+ , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))
122129 ]
123130 in
124− map Container formatters
131+ classContainers ++ formatters
125132
126133
127134divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]
@@ -131,16 +138,18 @@ divAttrToContainers (c:cs) _ | isJust (isHeaderClass c) =
131138 in
132139 [(Container $ \blks ->
133140 Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]
134−divAttrToContainers (c:_) _ | c `elem` codeDivs =
135− [Container $ \blks -> CodeBlock ("", [], []) (concatMap blkToCode blks)]
141+divAttrToContainers (c:cs) kvs | c `elem` divsToKeep =
142+ (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs)
143+divAttrToContainers (c:cs) kvs | c `elem` codeDivs =
144+ -- This is a bit of a cludge. We make the codeblock from the raw
145+ -- parparts in bodyPartToBlocks. But we need something to match against.
146+ (Container $ \_ -> CodeBlock ("", [], []) "") : (divAttrToContainers cs kvs)
136147divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =
137148 let kvs' = filter (\(k,_) -> k /= "indent") kvs
138149 in
139150 (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs')
140151divAttrToContainers (c:cs) kvs | c `elem` blockQuoteDivs =
141152 (Container BlockQuote) : (divAttrToContainers (cs \\ blockQuoteDivs) kvs)
142−divAttrToContainers (c:cs) kvs | c `elem` divsToKeep =
143− (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs)
144153divAttrToContainers (_:cs) kvs = divAttrToContainers cs kvs
145154divAttrToContainers [] (kv:kvs) | fst kv == "indent" =
146155 (Container BlockQuote) : divAttrToContainers [] kvs
@@ -183,18 +192,23 @@ runElemToString (Tab) = ['\t']
183192runElemsToString :: [RunElem] -> String
184193runElemsToString = concatMap runElemToString
185194
195+runToString :: Run -> String
196+runToString (Run _ runElems) = runElemsToString runElems
197+runToString _ = ""
198+
199+parPartToString :: ParPart -> String
200+parPartToString (PlainRun run) = runToString run
201+parPartToString (InternalHyperLink _ runs) = concatMap runToString runs
202+parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs
203+parPartToString _ = ""
204+
186205
187206inlineCodeContainer :: Container Inline -> Bool
188207inlineCodeContainer (Container f) = case f [] of
189− Span (_, classes, _) _ -> (not . null) (classes `intersect` codeSpans)
208+ Code _ "" -> True
190209 _ -> False
191210inlineCodeContainer _ = False
192211
193−-- blockCodeContainer :: Container Block -> Bool
194−-- blockCodeContainer (Container f) = case f [] of
195−-- Div (ident, classes, kvs) _ -> (not . null) (classes `intersect` codeDivs)
196−-- _ -> False
197−-- blockCodeContainer _ = False
198212
199213runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]
200214runToInlines _ _ (Run rs runElems)
@@ -274,7 +288,21 @@ cellToBlocks opts docx (Cell bps) = concatMap (bodyPartToBlocks opts docx) bps
274288rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]
275289rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
276290
291+blockCodeContainer :: Container Block -> Bool
292+blockCodeContainer (Container f) = case f [] of
293+ CodeBlock _ _ -> True
294+ _ -> False
295+blockCodeContainer _ = False
296+
277297bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]
298+bodyPartToBlocks _ _ (Paragraph pPr parparts)
299+ | any blockCodeContainer (parStyleToContainers pPr) =
300+ let
301+ otherConts = filter (not . blockCodeContainer) (parStyleToContainers pPr)
302+ in
303+ rebuild
304+ otherConts
305+ [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
278306bodyPartToBlocks opts docx (Paragraph pPr parparts) =
279307 case parPartsToInlines opts docx parparts of
280308 [] ->
@@ -348,7 +376,7 @@ makeImagesSelfContained _ inline = inline
348376bodyToBlocks :: ReaderOptions -> Docx -> Body -> [Block]
349377bodyToBlocks opts docx (Body bps) =
350378 map (makeHeaderAnchors) $
351− bottomUp blocksToDefinitions $
379+ blocksToDefinitions $
352380 blocksToBullets $
353381 concatMap (bodyPartToBlocks opts docx) bps
354382
@@ -358,7 +386,8 @@ docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = bodyToBlocks opts d body
358386
359387ilToCode :: Inline -> String
360388ilToCode (Str s) = s
361−ilToCode _ = ""
389+ilToCode Space = " "
390+ilToCode _ = ""
362391
363392
364393isHeaderClass :: String -> Maybe Int
@@ -369,18 +398,7 @@ isHeaderClass s | "Heading" `isPrefixOf` s =
369398 _ -> Nothing
370399isHeaderClass _ = Nothing
371400
372−
373401blksToInlines :: [Block] -> [Inline]
374402blksToInlines (Para ils : _) = ils
375403blksToInlines (Plain ils : _) = ils
376404blksToInlines _ = []
377−
378−
379−blkToCode :: Block -> String
380−blkToCode (Para []) = ""
381−blkToCode (Para ((Code _ s):ils)) = s ++ (blkToCode (Para ils))
382−blkToCode (Para ((Span (_, classes, _) ils'): ils))
383− | (not . null) (codeSpans `intersect` classes) =
384− (init $ unlines $ map ilToCode ils') ++ (blkToCode (Para ils))
385−blkToCode _ = ""
386−
tests/Tests/Readers/Docx.hs+13
@@ -86,6 +86,10 @@ tests = [ testGroup "inlines"
8686 "move trailing spaces outside of formatting"
8787 "docx.trailing_spaces_in_formatting.docx"
8888 "docx.trailing_spaces_in_formatting.native"
89+ , testCompare
90+ "inline code (with VerbatimChar style)"
91+ "docx.inline_code.docx"
92+ "docx.inline_code.native"
8993 ]
9094 , testGroup "blocks"
9195 [ testCompare
@@ -96,6 +100,10 @@ tests = [ testGroup "inlines"
96100 "lists"
97101 "docx.lists.docx"
98102 "docx.lists.native"
103+ , testCompare
104+ "definition lists"
105+ "docx.definition_list.docx"
106+ "docx.definition_list.native"
99107 , testCompare
100108 "footnotes and endnotes"
101109 "docx.notes.docx"
@@ -108,6 +116,11 @@ tests = [ testGroup "inlines"
108116 "tables"
109117 "docx.tables.docx"
110118 "docx.tables.native"
119+ , testCompare
120+ "code block"
121+ "docx.codeblock.docx"
122+ "docx.codeblock.native"
123+
111124 ]
112125 ]
113126
tests/docx.codeblock.docxnew file

Binary file not shown.

tests/docx.codeblock.nativenew file+3
@@ -0,0 +1,3 @@
1+[Para [Str "This",Space,Str "is",Space,Str "some",Space,Str "code:"]
2+,CodeBlock ("",[],[]) "readDocx :: ReaderOptions\n -> B.ByteString\n -> Pandoc"
3+,Para [Str "from",Space,Str "the",Space,Str "beginning",Space,Str "of",Space,Str "the",Space,Str "docx",Space,Str "reader."]]
tests/docx.definition_list.docxnew file

Binary file not shown.

tests/docx.definition_list.nativenew file+7
@@ -0,0 +1,7 @@
1+[DefinitionList
2+ [([Str "Term",Space,Str "1"],
3+ [[Para [Str "Definition",Space,Str "1"]]])
4+ ,([Str "Term",Space,Str "2",Space,Str "with",Space,Emph [Str "inline",Space,Str "markup"]],
5+ [[Para [Str "Definition",Space,Str "2"]
6+ ,CodeBlock ("",[],[]) "{ some code, part of Definition 2 }"
7+ ,Para [Str "Third",Space,Str "paragraph",Space,Str "of",Space,Str "definition",Space,Str "2."]]])]]
tests/docx.inline_code.docxnew file

Binary file not shown.

tests/docx.inline_code.nativenew file+1
@@ -0,0 +1 @@
1+[Para [Str "This",Space,Str "is",Space,Str "an",Space,Str "example",Space,Str "of",Space,Code ("",[],[]) "inline code",Space,Str "with",Space,Str "three",Space,Str "spaces."]]