git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: pass code tests.
bebea5eJesse Rosenthal
src/Text/Pandoc/Readers/Docx.hs+47−33
compare with master
unifiedsplit
@@ -84,7 +84,7 @@ import Text.Pandoc.Readers.Docx.Parse
84import Text.Pandoc.Readers.Docx.Lists
84import Text.Pandoc.Readers.Docx.Lists
85import Text.Pandoc.Readers.Docx.Reducible
85import Text.Pandoc.Readers.Docx.Reducible
86import Data.Maybe (mapMaybe, isJust, fromJust)
86import Data.Maybe (mapMaybe, isJust, fromJust)
87−import Data.List (delete, isPrefixOf, (\\), intersect)
87+import Data.List (delete, isPrefixOf, (\\))
88import qualified Data.ByteString as BS
88import qualified Data.ByteString as BS
89import qualified Data.ByteString.Lazy as B
89import qualified Data.ByteString.Lazy as B
90import Data.ByteString.Base64 (encode)
90import Data.ByteString.Base64 (encode)
@@ -99,7 +99,7 @@ readDocx opts bytes =
99 Nothing -> error $ "couldn't parse docx file"
99 Nothing -> error $ "couldn't parse docx file"
100
100
101spansToKeep :: [String]
101spansToKeep :: [String]
102−spansToKeep = ["list-item", "Definition", "DefinitionTerm"] ++ codeSpans
102+spansToKeep = ["list-item", "Definition", "DefinitionTerm"]
103
103
104
104
105-- This is empty, but we put it in for future-proofing.
105-- This is empty, but we put it in for future-proofing.
@@ -108,20 +108,28 @@ divsToKeep = []
108
108
109runStyleToContainers :: RunStyle -> [Container Inline]
109runStyleToContainers :: RunStyle -> [Container Inline]
110runStyleToContainers rPr =
110runStyleToContainers rPr =
111+ let spanClassToContainers :: String -> [Container Inline]
112+ spanClassToContainers s | s `elem` codeSpans =
113+ [Container $ (\ils -> Code ("", [], []) (concatMap ilToCode ils))]
114+ spanClassToContainers s | s `elem` spansToKeep =
115+ [Container $ Span ("", [s], [])]
116+ spanClassToContainers _ = []
117+
118+ classContainers = case rStyle rPr of
119+ Nothing -> []
120+ Just s -> spanClassToContainers s
121+
111− let formatters = mapMaybe id
122+ formatters = map Container $ mapMaybe id
112− [ if isBold rPr then (Just Strong) else Nothing
123+ [ if isBold rPr then (Just Strong) else Nothing
113− , if isItalic rPr then (Just Emph) else Nothing
124+ , if isItalic rPr then (Just Emph) else Nothing
114− , if isSmallCaps rPr then (Just SmallCaps) else Nothing
125+ , if isSmallCaps rPr then (Just SmallCaps) else Nothing
115− , if isStrike rPr then (Just Strikeout) else Nothing
126+ , if isStrike rPr then (Just Strikeout) else Nothing
116− , if isSuperScript rPr then (Just Superscript) else Nothing
127+ , if isSuperScript rPr then (Just Superscript) else Nothing
117− , if isSubScript rPr then (Just Subscript) else Nothing
128+ , 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)]))
129+ , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))
122 ]
130 ]
123 in
131 in
124− map Container formatters
132+ classContainers ++ formatters
125
133
126
134
127divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]
135divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]
@@ -132,7 +140,9 @@ divAttrToContainers (c:cs) _ | isJust (isHeaderClass c) =
132 [(Container $ \blks ->
140 [(Container $ \blks ->
133 Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]
141 Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]
134divAttrToContainers (c:_) _ | c `elem` codeDivs =
142divAttrToContainers (c:_) _ | c `elem` codeDivs =
143+ -- This is a bit of a cludge. We make the codeblock from the raw
144+ -- parparts in bodyPartToBlocks. But we need something to match against.
135− [Container $ \blks -> CodeBlock ("", [], []) (concatMap blkToCode blks)]
145+ [Container $ \_ -> CodeBlock ("", [], []) ""]
136divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =
146divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =
137 let kvs' = filter (\(k,_) -> k /= "indent") kvs
147 let kvs' = filter (\(k,_) -> k /= "indent") kvs
138 in
148 in
@@ -183,18 +193,23 @@ runElemToString (Tab) = ['\t']
183runElemsToString :: [RunElem] -> String
193runElemsToString :: [RunElem] -> String
184runElemsToString = concatMap runElemToString
194runElemsToString = concatMap runElemToString
185
195
196+runToString :: Run -> String
197+runToString (Run _ runElems) = runElemsToString runElems
198+runToString _ = ""
199+
200+parPartToString :: ParPart -> String
201+parPartToString (PlainRun run) = runToString run
202+parPartToString (InternalHyperLink _ runs) = concatMap runToString runs
203+parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs
204+parPartToString _ = ""
205+
186
206
187inlineCodeContainer :: Container Inline -> Bool
207inlineCodeContainer :: Container Inline -> Bool
188inlineCodeContainer (Container f) = case f [] of
208inlineCodeContainer (Container f) = case f [] of
189− Span (_, classes, _) _ -> (not . null) (classes `intersect` codeSpans)
209+ Code _ "" -> True
190 _ -> False
210 _ -> False
191inlineCodeContainer _ = False
211inlineCodeContainer _ = False
192
212
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
198
213
199runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]
214runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]
200runToInlines _ _ (Run rs runElems)
215runToInlines _ _ (Run rs runElems)
@@ -274,7 +289,16 @@ cellToBlocks opts docx (Cell bps) = concatMap (bodyPartToBlocks opts docx) bps
274rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]
289rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]
275rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
290rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
276
291
292+blockCodeContainer :: Container Block -> Bool
293+blockCodeContainer (Container f) = case f [] of
294+ CodeBlock _ _ -> True
295+ _ -> False
296+blockCodeContainer _ = False
297+
277bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]
298bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]
299+bodyPartToBlocks _ _ (Paragraph pPr parparts)
300+ | any blockCodeContainer (parStyleToContainers pPr) =
301+ [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
278bodyPartToBlocks opts docx (Paragraph pPr parparts) =
302bodyPartToBlocks opts docx (Paragraph pPr parparts) =
279 case parPartsToInlines opts docx parparts of
303 case parPartsToInlines opts docx parparts of
280 [] ->
304 [] ->
@@ -358,7 +382,8 @@ docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = bodyToBlocks opts d body
358
382
359ilToCode :: Inline -> String
383ilToCode :: Inline -> String
360ilToCode (Str s) = s
384ilToCode (Str s) = s
361−ilToCode _ = ""
385+ilToCode Space = " "
386+ilToCode _ = ""
362
387
363
388
364isHeaderClass :: String -> Maybe Int
389isHeaderClass :: String -> Maybe Int
@@ -369,18 +394,7 @@ isHeaderClass s | "Heading" `isPrefixOf` s =
369 _ -> Nothing
394 _ -> Nothing
370isHeaderClass _ = Nothing
395isHeaderClass _ = Nothing
371
396
372−
373blksToInlines :: [Block] -> [Inline]
397blksToInlines :: [Block] -> [Inline]
374blksToInlines (Para ils : _) = ils
398blksToInlines (Para ils : _) = ils
375blksToInlines (Plain ils : _) = ils
399blksToInlines (Plain ils : _) = ils
376blksToInlines _ = []
400blksToInlines _ = []
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−