98ca2e5 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1368 from jkr/docxCode

98ca2e5John MacFarlane12 years ago

src/Text/Pandoc/Readers/Docx.hs+57−39

compare with master

unifiedsplit

@@ -76,7 +76,6 @@ import Codec.Archive.Zip

76import Text.Pandoc.Definition

77import Text.Pandoc.Options

78import Text.Pandoc.Builder (text, toList)

79−import Text.Pandoc.Generic (bottomUp)

80import Text.Pandoc.MIME (getMimeType)

79import Text.Pandoc.MIME (getMimeType)

81import Text.Pandoc.UTF8 (toString)

80import Text.Pandoc.UTF8 (toString)

82import Text.Pandoc.Walk

81import Text.Pandoc.Walk

@@ -84,7 +83,7 @@ import Text.Pandoc.Readers.Docx.Parse

84import Text.Pandoc.Readers.Docx.Lists

83import Text.Pandoc.Readers.Docx.Lists

85import Text.Pandoc.Readers.Docx.Reducible

84import Text.Pandoc.Readers.Docx.Reducible

86import Data.Maybe (mapMaybe, isJust, fromJust)

85import Data.Maybe (mapMaybe, isJust, fromJust)

87−import Data.List (delete, isPrefixOf, (\\), intersect)

86+import Data.List (delete, isPrefixOf, (\\))

88import qualified Data.ByteString as BS

87import qualified Data.ByteString as BS

89import qualified Data.ByteString.Lazy as B

88import qualified Data.ByteString.Lazy as B

90import Data.ByteString.Base64 (encode)

89import Data.ByteString.Base64 (encode)

@@ -99,29 +98,37 @@ readDocx opts bytes =

99 Nothing -> error $ "couldn't parse docx file"

98 Nothing -> error $ "couldn't parse docx file"

100

101spansToKeep :: [String]

100spansToKeep :: [String]

102−spansToKeep = ["list-item", "Definition", "DefinitionTerm"] ++ codeSpans

101+spansToKeep = []

103

102

104

103

105-- This is empty, but we put it in for future-proofing.

104-- This is empty, but we put it in for future-proofing.

106divsToKeep :: [String]

105divsToKeep :: [String]

107−divsToKeep = []

106+divsToKeep = ["list-item", "Definition", "DefinitionTerm"]

108

107

109runStyleToContainers :: RunStyle -> [Container Inline]

108runStyleToContainers :: RunStyle -> [Container Inline]

110runStyleToContainers rPr =

109runStyleToContainers rPr =

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+

111− let formatters = mapMaybe id

121+ formatters = map Container $ mapMaybe id

112− [ if isBold rPr then (Just Strong) else Nothing

122+ [ if isBold rPr then (Just Strong) else Nothing

113− , if isItalic rPr then (Just Emph) else Nothing

123+ , if isItalic rPr then (Just Emph) else Nothing

114− , if isSmallCaps rPr then (Just SmallCaps) else Nothing

124+ , if isSmallCaps rPr then (Just SmallCaps) else Nothing

115− , if isStrike rPr then (Just Strikeout) else Nothing

125+ , if isStrike rPr then (Just Strikeout) else Nothing

116− , if isSuperScript rPr then (Just Superscript) else Nothing

126+ , if isSuperScript rPr then (Just Superscript) else Nothing

117− , if isSubScript rPr then (Just Subscript) else Nothing

127+ , 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)]))

128+ , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))

122 ]

129 ]

123 in

130 in

124− map Container formatters

131+ classContainers ++ formatters

125

132

126

133

127divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]

134divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]

@@ -131,16 +138,18 @@ divAttrToContainers (c:cs) _ | isJust (isHeaderClass c) =

131 in

138 in

132 [(Container $ \blks ->

139 [(Container $ \blks ->

133 Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]

140 Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]

134−divAttrToContainers (c:_) _ | c `elem` codeDivs =

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.

135− [Container $ \blks -> CodeBlock ("", [], []) (concatMap blkToCode blks)]

146+ (Container $ \_ -> CodeBlock ("", [], []) "") : (divAttrToContainers cs kvs)

136divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =

147divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =

137 let kvs' = filter (\(k,_) -> k /= "indent") kvs

148 let kvs' = filter (\(k,_) -> k /= "indent") kvs

138 in

149 in

139 (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs')

150 (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs')

140divAttrToContainers (c:cs) kvs | c `elem` blockQuoteDivs =

151divAttrToContainers (c:cs) kvs | c `elem` blockQuoteDivs =

141 (Container BlockQuote) : (divAttrToContainers (cs \\ blockQuoteDivs) kvs)

152 (Container BlockQuote) : (divAttrToContainers (cs \\ blockQuoteDivs) kvs)

142−divAttrToContainers (c:cs) kvs | c `elem` divsToKeep =

143− (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs)

144divAttrToContainers (_:cs) kvs = divAttrToContainers cs kvs

153divAttrToContainers (_:cs) kvs = divAttrToContainers cs kvs

145divAttrToContainers [] (kv:kvs) | fst kv == "indent" =

154divAttrToContainers [] (kv:kvs) | fst kv == "indent" =

146 (Container BlockQuote) : divAttrToContainers [] kvs

155 (Container BlockQuote) : divAttrToContainers [] kvs

@@ -183,18 +192,23 @@ runElemToString (Tab) = ['\t']

183runElemsToString :: [RunElem] -> String

192runElemsToString :: [RunElem] -> String

184runElemsToString = concatMap runElemToString

193runElemsToString = concatMap runElemToString

185

194

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+

186

205

187inlineCodeContainer :: Container Inline -> Bool

206inlineCodeContainer :: Container Inline -> Bool

188inlineCodeContainer (Container f) = case f [] of

207inlineCodeContainer (Container f) = case f [] of

189− Span (_, classes, _) _ -> (not . null) (classes `intersect` codeSpans)

208+ Code _ "" -> True

190 _ -> False

209 _ -> False

191inlineCodeContainer _ = False

210inlineCodeContainer _ = False

192

211

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

212

199runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]

213runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]

200runToInlines _ _ (Run rs runElems)

214runToInlines _ _ (Run rs runElems)

@@ -274,7 +288,21 @@ cellToBlocks opts docx (Cell bps) = concatMap (bodyPartToBlocks opts docx) bps

274rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]

288rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]

275rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells

289rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells

276

290

291+blockCodeContainer :: Container Block -> Bool

292+blockCodeContainer (Container f) = case f [] of

293+ CodeBlock _ _ -> True

294+ _ -> False

295+blockCodeContainer _ = False

296+

277bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]

297bodyPartToBlocks :: 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)]

278bodyPartToBlocks opts docx (Paragraph pPr parparts) =

306bodyPartToBlocks opts docx (Paragraph pPr parparts) =

279 case parPartsToInlines opts docx parparts of

307 case parPartsToInlines opts docx parparts of

280 [] ->

308 [] ->

@@ -348,7 +376,7 @@ makeImagesSelfContained _ inline = inline

348bodyToBlocks :: ReaderOptions -> Docx -> Body -> [Block]

376bodyToBlocks :: ReaderOptions -> Docx -> Body -> [Block]

349bodyToBlocks opts docx (Body bps) =

377bodyToBlocks opts docx (Body bps) =

350 map (makeHeaderAnchors) $

378 map (makeHeaderAnchors) $

351− bottomUp blocksToDefinitions $

379+ blocksToDefinitions $

352 blocksToBullets $

380 blocksToBullets $

353 concatMap (bodyPartToBlocks opts docx) bps

381 concatMap (bodyPartToBlocks opts docx) bps

354

382

@@ -358,7 +386,8 @@ docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = bodyToBlocks opts d body

358

386

359ilToCode :: Inline -> String

387ilToCode :: Inline -> String

360ilToCode (Str s) = s

388ilToCode (Str s) = s

361−ilToCode _ = ""

389+ilToCode Space = " "

390+ilToCode _ = ""

362

391

363

392

364isHeaderClass :: String -> Maybe Int

393isHeaderClass :: String -> Maybe Int

@@ -369,18 +398,7 @@ isHeaderClass s | "Heading" `isPrefixOf` s =

369 _ -> Nothing

398 _ -> Nothing

370isHeaderClass _ = Nothing

399isHeaderClass _ = Nothing

371

400

372−

373blksToInlines :: [Block] -> [Inline]

401blksToInlines :: [Block] -> [Inline]

374blksToInlines (Para ils : _) = ils

402blksToInlines (Para ils : _) = ils

375blksToInlines (Plain ils : _) = ils

403blksToInlines (Plain ils : _) = ils

376blksToInlines _ = []

404blksToInlines _ = []

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"

86 "move trailing spaces outside of formatting"

87 "docx.trailing_spaces_in_formatting.docx"

88 "docx.trailing_spaces_in_formatting.native"

89+ , testCompare

90+ "inline code (with VerbatimChar style)"

91+ "docx.inline_code.docx"

92+ "docx.inline_code.native"

89 ]

93 ]

90 , testGroup "blocks"

94 , testGroup "blocks"

91 [ testCompare

95 [ testCompare

@@ -96,6 +100,10 @@ tests = [ testGroup "inlines"

96 "lists"

100 "lists"

97 "docx.lists.docx"

101 "docx.lists.docx"

98 "docx.lists.native"

102 "docx.lists.native"

103+ , testCompare

104+ "definition lists"

105+ "docx.definition_list.docx"

106+ "docx.definition_list.native"

99 , testCompare

107 , testCompare

100 "footnotes and endnotes"

108 "footnotes and endnotes"

101 "docx.notes.docx"

109 "docx.notes.docx"

@@ -108,6 +116,11 @@ tests = [ testGroup "inlines"

108 "tables"

116 "tables"

109 "docx.tables.docx"

117 "docx.tables.docx"

110 "docx.tables.native"

118 "docx.tables.native"

119+ , testCompare

120+ "code block"

121+ "docx.codeblock.docx"

122+ "docx.codeblock.native"

123+

111 ]

124 ]

112 ]

125 ]

113

126

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."]]