3cb76d9 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge branch 'master' of git://github.com/jgm/pandoc into dokuwiki

3cb76d9Clare Macrae12 years ago

man/make-pandoc-man-pages.hs+3−3

compare with master

unifiedsplit

@@ -27,7 +27,7 @@ main = do

28 unless (null ds1 && null ds2) $ do

29 rmContents <- UTF8.readFile "README"

30− let (Pandoc meta blocks) = readMarkdown def rmContents

30+ let (Pandoc meta blocks) = normalize $ readMarkdown def rmContents

31 let manBlocks = removeSect [Str "Wrappers"]

32 $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks

33 let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks

@@ -67,13 +67,13 @@ capitalize (Str xs) = Str $ map toUpper xs

67capitalize x = x

69removeSect :: [Inline] -> [Block] -> [Block]

70−removeSect ils (Header 1 _ x:xs) | normalize x == normalize ils =

70+removeSect ils (Header 1 _ x:xs) | x == ils =

71 dropWhile (not . isHeader1) xs

72removeSect ils (x:xs) = x : removeSect ils xs

73removeSect _ [] = []

75extractSect :: [Inline] -> [Block] -> [Block]

76−extractSect ils (Header 1 _ z:xs) | normalize z == normalize ils =

76+extractSect ils (Header 1 _ z:xs) | z == ils =

77 bottomUp promoteHeader $ takeWhile (not . isHeader1) xs

78 where promoteHeader (Header n attr x) = Header (n-1) attr x

79 promoteHeader x = x

pandoc.hs+6−2

@@ -49,7 +49,7 @@ import System.Console.GetOpt

49import Data.Char ( toLower )

50import Data.List ( intercalate, isPrefixOf, isSuffixOf, sort )

51import System.Directory ( getAppUserDataDirectory, findExecutable,

52− doesFileExist )

52+ doesFileExist, Permissions(..), getPermissions )

53import System.IO ( stdout, stderr )

54import System.IO.Error ( isDoesNotExistError )

55import qualified Control.Exception as E

@@ -104,8 +104,12 @@ externalFilter f args' d = do

104 Nothing -> do

105 exists <- doesFileExist f

106 if exists

107+ then do

108+ isExecutable <- executable `fmap`

109+ getPermissions f

107− then return $

110+ return $

108 case map toLower $ takeExtension f of

111 case map toLower $ takeExtension f of

112+ _ | isExecutable -> (f, args')

109 ".py" -> ("python", f:args')

113 ".py" -> ("python", f:args')

110 ".hs" -> ("runhaskell", f:args')

114 ".hs" -> ("runhaskell", f:args')

111 ".pl" -> ("perl", f:args')

115 ".pl" -> ("perl", f:args')

src/Text/Pandoc/Readers/Docx.hs+44−33

@@ -110,6 +110,11 @@ data DEnv = DEnv { docxOptions :: ReaderOptions

110

111type DocxContext = ReaderT DEnv (State DState)

112

113+updateDState :: (DState -> DState) -> DocxContext ()

114+updateDState f = do

115+ st <- get

116+ put $ f st

117+

113evalDocxContext :: DocxContext a -> DEnv -> DState -> a

118evalDocxContext :: DocxContext a -> DEnv -> DState -> a

114evalDocxContext ctx env st = evalState (runReaderT ctx env) st

119evalDocxContext ctx env st = evalState (runReaderT ctx env) st

115

120

@@ -148,42 +153,48 @@ runStyleToContainers rPr =

148 in

153 in

149 classContainers ++ formatters

154 classContainers ++ formatters

150

155

151−

156+parStyleToContainers :: ParagraphStyle -> [Container Block]

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

153−divAttrToContainers (c:cs) _ | Just n <- isHeaderClass c =

157+parStyleToContainers pPr | (c:cs) <- pStyle pPr, Just n <- isHeaderClass c =

154− [Container $ \_ ->

155− Header n ("", delete ("Heading" ++ show n) cs, []) []]

158+ [Container $ \_ -> Header n ("", delete ("Heading" ++ show n) cs, []) []]

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

159+parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` divsToKeep =

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

160+ let pPr' = pPr { pStyle = cs }

158−divAttrToContainers (c:cs) kvs | c `elem` codeDivs =

161+ in

162+ (Container $ Div ("", [c], [])) : (parStyleToContainers pPr')

163+parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` codeDivs =

159 -- This is a bit of a cludge. We make the codeblock from the raw

164 -- This is a bit of a cludge. We make the codeblock from the raw

160 -- parparts in bodyPartToBlocks. But we need something to match against.

165 -- parparts in bodyPartToBlocks. But we need something to match against.

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

166+ let pPr' = pPr { pStyle = cs }

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

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

164 in

167 in

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

168+ (Container $ \_ -> CodeBlock ("", [], []) "") : (parStyleToContainers pPr')

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

169+parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` listParagraphDivs =

167− (Container BlockQuote) : (divAttrToContainers (cs \\ blockQuoteDivs) kvs)

170+ let pPr' = pPr { pStyle = cs, indentation = Nothing}

168−divAttrToContainers (_:cs) kvs = divAttrToContainers cs kvs

169−divAttrToContainers [] kvs | Just numString <- lookup "indent" kvs =

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

171 in

172− case numString of

172+ (Container $ Div ("", [c], [])) : (parStyleToContainers pPr')

173− "0" -> divAttrToContainers [] kvs'

174− ('-' : _) -> divAttrToContainers [] kvs'

175− _ -> (Container BlockQuote) : divAttrToContainers [] kvs'

176−divAttrToContainers _ _ = []

177−

178

173

179−parStyleToContainers :: ParagraphStyle -> [Container Block]

174+parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` blockQuoteDivs =

175+ let pPr' = pPr { pStyle = cs \\ blockQuoteDivs }

176+ in

177+ (Container BlockQuote) : (parStyleToContainers pPr')

180−parStyleToContainers pPr =

178+parStyleToContainers pPr | (_:cs) <- pStyle pPr =

181− let classes = pStyle pPr

179+ let pPr' = pPr { pStyle = cs}

182− kvs = case indent pPr of

180+ in

183− Just n -> [("indent", show n)]

181+ parStyleToContainers pPr'

184− Nothing -> []

182+parStyleToContainers pPr | null (pStyle pPr),

183+ Just left <- indentation pPr >>= leftParIndent,

184+ Just hang <- indentation pPr >>= hangingParIndent =

185+ let pPr' = pPr { indentation = Nothing }

186+ in

187+ case (left - hang) > 0 of

188+ True -> (Container BlockQuote) : (parStyleToContainers pPr')

189+ False -> parStyleToContainers pPr'

190+parStyleToContainers pPr | null (pStyle pPr),

191+ Just left <- indentation pPr >>= leftParIndent =

192+ let pPr' = pPr { indentation = Nothing }

185 in

193 in

186− divAttrToContainers classes kvs

194+ case left > 0 of

195+ True -> (Container BlockQuote) : (parStyleToContainers pPr')

196+ False -> parStyleToContainers pPr'

197+parStyleToContainers _ = []

187

198

188

199

189strToInlines :: String -> [Inline]

200strToInlines :: String -> [Inline]

@@ -289,7 +300,7 @@ parPartToInlines (BookMark _ anchor) =

289 let newAnchor = case anchor `elem` (M.elems anchorMap) of

300 let newAnchor = case anchor `elem` (M.elems anchorMap) of

290 True -> uniqueIdent [Str anchor] (M.elems anchorMap)

301 True -> uniqueIdent [Str anchor] (M.elems anchorMap)

291 False -> anchor

302 False -> anchor

292− put DState{ docxAnchorMap = M.insert anchor newAnchor anchorMap}

303+ updateDState $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}

293 return [Span (anchor, ["anchor"], []) []]

304 return [Span (anchor, ["anchor"], []) []]

294parPartToInlines (Drawing relid) = do

305parPartToInlines (Drawing relid) = do

295 (Docx _ _ _ rels _) <- asks docxDocument

306 (Docx _ _ _ rels _) <- asks docxDocument

@@ -329,7 +340,7 @@ makeHeaderAnchor (Header n (_, classes, kvs) ils)

329 do

340 do

330 hdrIDMap <- gets docxAnchorMap

341 hdrIDMap <- gets docxAnchorMap

331 let newIdent = uniqueIdent ils (M.elems hdrIDMap)

342 let newIdent = uniqueIdent ils (M.elems hdrIDMap)

332− put DState{docxAnchorMap = M.insert ident newIdent hdrIDMap}

343+ updateDState $ \s -> s {docxAnchorMap = M.insert ident newIdent hdrIDMap}

333 return $ Header n (newIdent, classes, kvs) (ils \\ (x:xs))

344 return $ Header n (newIdent, classes, kvs) (ils \\ (x:xs))

334-- Otherwise we just give it a name, and register that name (associate

345-- Otherwise we just give it a name, and register that name (associate

335-- it with itself.)

346-- it with itself.)

@@ -337,7 +348,7 @@ makeHeaderAnchor (Header n (_, classes, kvs) ils) =

337 do

348 do

338 hdrIDMap <- gets docxAnchorMap

349 hdrIDMap <- gets docxAnchorMap

339 let newIdent = uniqueIdent ils (M.elems hdrIDMap)

350 let newIdent = uniqueIdent ils (M.elems hdrIDMap)

340− put DState{docxAnchorMap = M.insert newIdent newIdent hdrIDMap}

351+ updateDState $ \s -> s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap}

341 return $ Header n (newIdent, classes, kvs) ils

352 return $ Header n (newIdent, classes, kvs) ils

342makeHeaderAnchor blk = return blk

353makeHeaderAnchor blk = return blk

343

354

src/Text/Pandoc/Readers/Docx/Parse.hs+26−5

@@ -42,6 +42,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)

42 , Relationship

43 , Media

44 , RunStyle(..)

45+ , ParIndentation(..)

45 , ParagraphStyle(..)

46 , ParagraphStyle(..)

46 , Row(..)

47 , Row(..)

47 , Cell(..)

48 , Cell(..)

@@ -341,16 +342,37 @@ testBitMask bitMaskS n =

341 [] -> False

342 [] -> False

342 ((n', _) : _) -> ((n' .|. n) /= 0)

343 ((n', _) : _) -> ((n' .|. n) /= 0)

343

344

345+data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer

346+ , rightParIndent :: Maybe Integer

347+ , hangingParIndent :: Maybe Integer}

348+ deriving Show

349+

344data ParagraphStyle = ParagraphStyle { pStyle :: [String]

350data ParagraphStyle = ParagraphStyle { pStyle :: [String]

345− , indent :: Maybe Integer

351+ , indentation :: Maybe ParIndentation

346 }

352 }

347 deriving Show

353 deriving Show

348

354

349defaultParagraphStyle :: ParagraphStyle

355defaultParagraphStyle :: ParagraphStyle

350defaultParagraphStyle = ParagraphStyle { pStyle = []

356defaultParagraphStyle = ParagraphStyle { pStyle = []

351− , indent = Nothing

357+ , indentation = Nothing

352 }

358 }

353

359

360+elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation

361+elemToParIndentation ns element

362+ | qName (elName element) == "ind" &&

363+ qURI (elName element) == (lookup "w" ns) =

364+ Just $ ParIndentation {

365+ leftParIndent =

366+ findAttr (QName "left" (lookup "w" ns) (Just "w")) element >>=

367+ stringToInteger

368+ , rightParIndent =

369+ findAttr (QName "right" (lookup "w" ns) (Just "w")) element >>=

370+ stringToInteger

371+ , hangingParIndent =

372+ findAttr (QName "hanging" (lookup "w" ns) (Just "w")) element >>=

373+ stringToInteger}

374+elemToParIndentation _ _ = Nothing

375+

354elemToParagraphStyle :: NameSpaces -> Element -> ParagraphStyle

376elemToParagraphStyle :: NameSpaces -> Element -> ParagraphStyle

355elemToParagraphStyle ns element =

377elemToParagraphStyle ns element =

356 case findChild (QName "pPr" (lookup "w" ns) (Just "w")) element of

378 case findChild (QName "pPr" (lookup "w" ns) (Just "w")) element of

@@ -360,10 +382,9 @@ elemToParagraphStyle ns element =

360 mapMaybe

382 mapMaybe

361 (findAttr (QName "val" (lookup "w" ns) (Just "w")))

383 (findAttr (QName "val" (lookup "w" ns) (Just "w")))

362 (findChildren (QName "pStyle" (lookup "w" ns) (Just "w")) pPr)

384 (findChildren (QName "pStyle" (lookup "w" ns) (Just "w")) pPr)

363− , indent =

385+ , indentation =

364 findChild (QName "ind" (lookup "w" ns) (Just "w")) pPr >>=

386 findChild (QName "ind" (lookup "w" ns) (Just "w")) pPr >>=

365− findAttr (QName "left" (lookup "w" ns) (Just "w")) >>=

387+ elemToParIndentation ns

366− stringToInteger

367 }

388 }

368 Nothing -> defaultParagraphStyle

389 Nothing -> defaultParagraphStyle

369

390

src/Text/Pandoc/Shared.hs+131−60

@@ -55,6 +55,8 @@ module Text.Pandoc.Shared (

55 normalizeSpaces,

56 extractSpaces,

57 normalize,

58+ normalizeInlines,

59+ normalizeBlocks,

58 stringify,

60 stringify,

59 compactify,

61 compactify,

60 compactify',

62 compactify',

@@ -84,7 +86,6 @@ module Text.Pandoc.Shared (

85import Text.Pandoc.Definition

87import Text.Pandoc.Definition

86import Text.Pandoc.Walk

88import Text.Pandoc.Walk

87−import Text.Pandoc.Generic

88import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))

89import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))

89import qualified Text.Pandoc.Builder as B

90import qualified Text.Pandoc.Builder as B

90import qualified Text.Pandoc.UTF8 as UTF8

91import qualified Text.Pandoc.UTF8 as UTF8

@@ -350,72 +351,142 @@ extractSpaces f is =

350-- | Normalize @Pandoc@ document, consolidating doubled 'Space's,

351-- | Normalize @Pandoc@ document, consolidating doubled 'Space's,

351-- combining adjacent 'Str's and 'Emph's, remove 'Null's and

352-- combining adjacent 'Str's and 'Emph's, remove 'Null's and

352-- empty elements, etc.

353-- empty elements, etc.

353−normalize :: (Eq a, Data a) => a -> a

354+normalize :: Pandoc -> Pandoc

354−normalize = topDown removeEmptyBlocks .

355+normalize (Pandoc (Meta meta) blocks) =

355− topDown consolidateInlines .

356+ Pandoc (Meta $ M.map go meta) (normalizeBlocks blocks)

356− bottomUp (removeEmptyInlines . removeTrailingInlineSpaces)

357+ where go (MetaInlines xs) = MetaInlines $ normalizeInlines xs

357−

358+ go (MetaBlocks xs) = MetaBlocks $ normalizeBlocks xs

358−removeEmptyBlocks :: [Block] -> [Block]

359+ go (MetaList ms) = MetaList $ map go ms

359−removeEmptyBlocks (Null : xs) = removeEmptyBlocks xs

360+ go (MetaMap m) = MetaMap $ M.map go m

360−removeEmptyBlocks (BulletList [] : xs) = removeEmptyBlocks xs

361+ go x = x

361−removeEmptyBlocks (OrderedList _ [] : xs) = removeEmptyBlocks xs

362+

362−removeEmptyBlocks (DefinitionList [] : xs) = removeEmptyBlocks xs

363+normalizeBlocks :: [Block] -> [Block]

363−removeEmptyBlocks (RawBlock _ [] : xs) = removeEmptyBlocks xs

364+normalizeBlocks (Null : xs) = normalizeBlocks xs

364−removeEmptyBlocks (x:xs) = x : removeEmptyBlocks xs

365+normalizeBlocks (Div attr bs : xs) =

365−removeEmptyBlocks [] = []

366+ Div attr (normalizeBlocks bs) : normalizeBlocks xs

366−

367+normalizeBlocks (BlockQuote bs : xs) =

367−removeEmptyInlines :: [Inline] -> [Inline]

368+ case normalizeBlocks bs of

368−removeEmptyInlines (Emph [] : zs) = removeEmptyInlines zs

369+ [] -> normalizeBlocks xs

369−removeEmptyInlines (Strong [] : zs) = removeEmptyInlines zs

370+ bs' -> BlockQuote bs' : normalizeBlocks xs

370−removeEmptyInlines (Subscript [] : zs) = removeEmptyInlines zs

371+normalizeBlocks (BulletList [] : xs) = normalizeBlocks xs

371−removeEmptyInlines (Superscript [] : zs) = removeEmptyInlines zs

372+normalizeBlocks (BulletList items : xs) =

372−removeEmptyInlines (SmallCaps [] : zs) = removeEmptyInlines zs

373+ BulletList (map normalizeBlocks items) : normalizeBlocks xs

373−removeEmptyInlines (Strikeout [] : zs) = removeEmptyInlines zs

374+normalizeBlocks (OrderedList _ [] : xs) = normalizeBlocks xs

374−removeEmptyInlines (RawInline _ [] : zs) = removeEmptyInlines zs

375+normalizeBlocks (OrderedList attr items : xs) =

375−removeEmptyInlines (Code _ [] : zs) = removeEmptyInlines zs

376+ OrderedList attr (map normalizeBlocks items) : normalizeBlocks xs

376−removeEmptyInlines (Str "" : zs) = removeEmptyInlines zs

377+normalizeBlocks (DefinitionList [] : xs) = normalizeBlocks xs

377−removeEmptyInlines (x : xs) = x : removeEmptyInlines xs

378+normalizeBlocks (DefinitionList items : xs) =

378−removeEmptyInlines [] = []

379+ DefinitionList (map go items) : normalizeBlocks xs

379−

380+ where go (ils, bs) = (normalizeInlines ils, map normalizeBlocks bs)

380−removeTrailingInlineSpaces :: [Inline] -> [Inline]

381+normalizeBlocks (RawBlock _ "" : xs) = normalizeBlocks xs

381−removeTrailingInlineSpaces = reverse . removeLeadingInlineSpaces . reverse

382+normalizeBlocks (Para ils : xs) =

382−

383+ case normalizeInlines ils of

383−removeLeadingInlineSpaces :: [Inline] -> [Inline]

384+ [] -> normalizeBlocks xs

384−removeLeadingInlineSpaces = dropWhile isSpaceOrEmpty

385+ ils' -> Para ils' : normalizeBlocks xs

385−

386+normalizeBlocks (Plain ils : xs) =

386−consolidateInlines :: [Inline] -> [Inline]

387+ case normalizeInlines ils of

387−consolidateInlines (Str x : ys) =

388+ [] -> normalizeBlocks xs

389+ ils' -> Plain ils' : normalizeBlocks xs

390+normalizeBlocks (Header lev attr ils : xs) =

391+ Header lev attr (normalizeInlines ils) : normalizeBlocks xs

392+normalizeBlocks (Table capt aligns widths hdrs rows : xs) =

393+ Table (normalizeInlines capt) aligns widths

394+ (map normalizeBlocks hdrs) (map (map normalizeBlocks) rows)

395+ : normalizeBlocks xs

396+normalizeBlocks (x:xs) = x : normalizeBlocks xs

397+normalizeBlocks [] = []

398+

399+normalizeInlines :: [Inline] -> [Inline]

400+normalizeInlines (Str x : ys) =

388 case concat (x : map fromStr strs) of

401 case concat (x : map fromStr strs) of

389− "" -> consolidateInlines rest

402+ "" -> rest

390− n -> Str n : consolidateInlines rest

403+ n -> Str n : rest

391 where

404 where

392− (strs, rest) = span isStr ys

405+ (strs, rest) = span isStr $ normalizeInlines ys

393 isStr (Str _) = True

406 isStr (Str _) = True

394 isStr _ = False

407 isStr _ = False

395 fromStr (Str z) = z

408 fromStr (Str z) = z

396− fromStr _ = error "consolidateInlines - fromStr - not a Str"

409+ fromStr _ = error "normalizeInlines - fromStr - not a Str"

397−consolidateInlines (Space : ys) = Space : rest

410+normalizeInlines (Space : ys) =

411+ if null rest

412+ then []

413+ else Space : rest

398 where isSp Space = True

414 where isSp Space = True

399 isSp _ = False

415 isSp _ = False

400− rest = consolidateInlines $ dropWhile isSp ys

416+ rest = dropWhile isSp $ normalizeInlines ys

401−consolidateInlines (Emph xs : Emph ys : zs) = consolidateInlines $

417+normalizeInlines (Emph xs : zs) =

418+ case normalizeInlines zs of

419+ (Emph ys : rest) -> normalizeInlines $

402− Emph (xs ++ ys) : zs

420+ Emph (normalizeInlines $ xs ++ ys) : rest

403−consolidateInlines (Strong xs : Strong ys : zs) = consolidateInlines $

421+ rest -> case normalizeInlines xs of

404− Strong (xs ++ ys) : zs

422+ [] -> rest

405−consolidateInlines (Subscript xs : Subscript ys : zs) = consolidateInlines $

423+ xs' -> Emph xs' : rest

406− Subscript (xs ++ ys) : zs

424+normalizeInlines (Strong xs : zs) =

407−consolidateInlines (Superscript xs : Superscript ys : zs) = consolidateInlines $

425+ case normalizeInlines zs of

408− Superscript (xs ++ ys) : zs

426+ (Strong ys : rest) -> normalizeInlines $

409−consolidateInlines (SmallCaps xs : SmallCaps ys : zs) = consolidateInlines $

427+ Strong (normalizeInlines $ xs ++ ys) : rest

410− SmallCaps (xs ++ ys) : zs

428+ rest -> case normalizeInlines xs of

411−consolidateInlines (Strikeout xs : Strikeout ys : zs) = consolidateInlines $

429+ [] -> rest

412− Strikeout (xs ++ ys) : zs

430+ xs' -> Strong xs' : rest

413−consolidateInlines (RawInline f x : RawInline f' y : zs) | f == f' =

431+normalizeInlines (Subscript xs : zs) =

414− consolidateInlines $ RawInline f (x ++ y) : zs

432+ case normalizeInlines zs of

415−consolidateInlines (Code a1 x : Code a2 y : zs) | a1 == a2 =

433+ (Subscript ys : rest) -> normalizeInlines $

416− consolidateInlines $ Code a1 (x ++ y) : zs

434+ Subscript (normalizeInlines $ xs ++ ys) : rest

417−consolidateInlines (x : xs) = x : consolidateInlines xs

435+ rest -> case normalizeInlines xs of

418−consolidateInlines [] = []

436+ [] -> rest

437+ xs' -> Subscript xs' : rest

438+normalizeInlines (Superscript xs : zs) =

439+ case normalizeInlines zs of

440+ (Superscript ys : rest) -> normalizeInlines $

441+ Superscript (normalizeInlines $ xs ++ ys) : rest

442+ rest -> case normalizeInlines xs of

443+ [] -> rest

444+ xs' -> Superscript xs' : rest

445+normalizeInlines (SmallCaps xs : zs) =

446+ case normalizeInlines zs of

447+ (SmallCaps ys : rest) -> normalizeInlines $

448+ SmallCaps (normalizeInlines $ xs ++ ys) : rest

449+ rest -> case normalizeInlines xs of

450+ [] -> rest

451+ xs' -> SmallCaps xs' : rest

452+normalizeInlines (Strikeout xs : zs) =

453+ case normalizeInlines zs of

454+ (Strikeout ys : rest) -> normalizeInlines $

455+ Strikeout (normalizeInlines $ xs ++ ys) : rest

456+ rest -> case normalizeInlines xs of

457+ [] -> rest

458+ xs' -> Strikeout xs' : rest

459+normalizeInlines (RawInline _ [] : ys) = normalizeInlines ys

460+normalizeInlines (RawInline f xs : zs) =

461+ case normalizeInlines zs of

462+ (RawInline f' ys : rest) | f == f' -> normalizeInlines $

463+ RawInline f (xs ++ ys) : rest

464+ rest -> RawInline f xs : rest

465+normalizeInlines (Code _ "" : ys) = normalizeInlines ys

466+normalizeInlines (Code attr xs : zs) =

467+ case normalizeInlines zs of

468+ (Code attr' ys : rest) | attr == attr' -> normalizeInlines $

469+ Code attr (xs ++ ys) : rest

470+ rest -> Code attr xs : rest

471+-- allow empty spans, they may carry identifiers etc.

472+-- normalizeInlines (Span _ [] : ys) = normalizeInlines ys

473+normalizeInlines (Span attr xs : zs) =

474+ case normalizeInlines zs of

475+ (Span attr' ys : rest) | attr == attr' -> normalizeInlines $

476+ Span attr (normalizeInlines $ xs ++ ys) : rest

477+ rest -> Span attr (normalizeInlines xs) : rest

478+normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) :

479+ normalizeInlines ys

480+normalizeInlines (Quoted qt ils : ys) =

481+ Quoted qt (normalizeInlines ils) : normalizeInlines ys

482+normalizeInlines (Link ils t : ys) =

483+ Link (normalizeInlines ils) t : normalizeInlines ys

484+normalizeInlines (Image ils t : ys) =

485+ Image (normalizeInlines ils) t : normalizeInlines ys

486+normalizeInlines (Cite cs ils : ys) =

487+ Cite cs (normalizeInlines ils) : normalizeInlines ys

488+normalizeInlines (x : xs) = x : normalizeInlines xs

489+normalizeInlines [] = []

419

490

420-- | Convert pandoc structure to a string with formatting removed.

491-- | Convert pandoc structure to a string with formatting removed.

421-- Footnotes are skipped (since we don't want their contents in link

492-- Footnotes are skipped (since we don't want their contents in link

src/Text/Pandoc/Writers/Docx.hs+6−3

@@ -514,8 +514,11 @@ blockToOpenXML :: WriterOptions -> Block -> WS [Element]

514blockToOpenXML _ Null = return []

515blockToOpenXML opts (Div _ bs) = blocksToOpenXML opts bs

516blockToOpenXML opts (Header lev (ident,_,_) lst) = do

517+

517− contents <- withParaProp (pStyle $ "Heading" ++ show lev) $

518+ paraProps <- withParaProp (pStyle $ "Heading" ++ show lev) $

518− blockToOpenXML opts (Para lst)

519+ getParaProps False

520+ contents <- inlinesToOpenXML opts lst

521+

519 usedIdents <- gets stSectionIds

522 usedIdents <- gets stSectionIds

520 let bookmarkName = if null ident

523 let bookmarkName = if null ident

521 then uniqueIdent lst usedIdents

524 then uniqueIdent lst usedIdents

@@ -525,7 +528,7 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do

525 let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')

528 let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id')

526 ,("w:name",bookmarkName)] ()

529 ,("w:name",bookmarkName)] ()

527 let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()

530 let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()

528− return $ [bookmarkStart] ++ contents ++ [bookmarkEnd]

531+ return [mknode "w:p" [] (paraProps ++ [bookmarkStart, bookmarkEnd] ++ contents)]

529blockToOpenXML opts (Plain lst) = withParaProp (pStyle "Compact")

532blockToOpenXML opts (Plain lst) = withParaProp (pStyle "Compact")

530 $ blockToOpenXML opts (Para lst)

533 $ blockToOpenXML opts (Para lst)

531-- title beginning with fig: indicates that the image is a figure

534-- title beginning with fig: indicates that the image is a figure

tests/Tests/Readers/Docx.hs+4

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

112 "blockquotes (parsing indent as blockquote)"

113 "docx.block_quotes.docx"

114 "docx.block_quotes_parse_indent.native"

115+ , testCompare

116+ "hanging indents"

117+ "docx.hanging_indent.docx"

118+ "docx.hanging_indent.native"

115 , testCompare

119 , testCompare

116 "tables"

120 "tables"

117 "docx.tables.docx"

121 "docx.tables.docx"

tests/Tests/Shared.hs+5−3

@@ -16,11 +16,13 @@ tests = [ testGroup "normalize"

16 ]

18p_normalize_blocks_rt :: [Block] -> Bool

19−p_normalize_blocks_rt bs = normalize bs == normalize (normalize bs)

19+p_normalize_blocks_rt bs =

20+ normalizeBlocks bs == normalizeBlocks (normalizeBlocks bs)

21p_normalize_inlines_rt :: [Inline] -> Bool

22p_normalize_inlines_rt :: [Inline] -> Bool

22−p_normalize_inlines_rt ils = normalize ils == normalize (normalize ils)

23+p_normalize_inlines_rt ils =

24+ normalizeInlines ils == normalizeInlines (normalizeInlines ils)

24p_normalize_no_trailing_spaces :: [Inline] -> Bool

26p_normalize_no_trailing_spaces :: [Inline] -> Bool

25p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space

27p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space

26− where ils' = normalize $ ils ++ [Space]

28+ where ils' = normalizeInlines $ ils ++ [Space]

tests/docx.hanging_indent.docxnew file

Binary file not shown.

tests/docx.hanging_indent.nativenew file+3

@@ -0,0 +1,3 @@

1+[Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "hanging",Space,Str "indent,",Space,Str "with",Space,Str "the",Space,Str "left",Space,Str "side",Space,Str "set",Space,Str "to",Space,Str "the",Space,Str "left",Space,Str "margin,",Space,Str "and",Space,Str "it",Space,Str "wraps",Space,Str "around",Space,Str "the",Space,Str "line."]

2+,BlockQuote

3+ [Para [Str "Five",Space,Str "years",Space,Str "have",Space,Str "passed,",Space,Str "five",Space,Str "summers",Space,Str "with",Space,Str "the",Space,Str "length"]]]