@@ -55,6 +55,8 @@ module Text.Pandoc.Shared (
5555 normalizeSpaces,
5656 extractSpaces,
5757 normalize,
58+ normalizeInlines,
59+ normalizeBlocks,
5860 stringify,
5961 compactify,
6062 compactify',
@@ -84,7 +86,6 @@ module Text.Pandoc.Shared (
8486
8587import Text.Pandoc.Definition
8688import Text.Pandoc.Walk
87−import Text.Pandoc.Generic
8889import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))
8990import qualified Text.Pandoc.Builder as B
9091import qualified Text.Pandoc.UTF8 as UTF8
@@ -350,72 +351,142 @@ extractSpaces f is =
350351-- | Normalize @Pandoc@ document, consolidating doubled 'Space's,
351352-- combining adjacent 'Str's and 'Emph's, remove 'Null's and
352353-- empty elements, etc.
353−normalize :: (Eq a, Data a) => a -> a
354−normalize = topDown removeEmptyBlocks .
355− topDown consolidateInlines .
356− bottomUp (removeEmptyInlines . removeTrailingInlineSpaces)
357−
358−removeEmptyBlocks :: [Block] -> [Block]
359−removeEmptyBlocks (Null : xs) = removeEmptyBlocks xs
360−removeEmptyBlocks (BulletList [] : xs) = removeEmptyBlocks xs
361−removeEmptyBlocks (OrderedList _ [] : xs) = removeEmptyBlocks xs
362−removeEmptyBlocks (DefinitionList [] : xs) = removeEmptyBlocks xs
363−removeEmptyBlocks (RawBlock _ [] : xs) = removeEmptyBlocks xs
364−removeEmptyBlocks (x:xs) = x : removeEmptyBlocks xs
365−removeEmptyBlocks [] = []
366−
367−removeEmptyInlines :: [Inline] -> [Inline]
368−removeEmptyInlines (Emph [] : zs) = removeEmptyInlines zs
369−removeEmptyInlines (Strong [] : zs) = removeEmptyInlines zs
370−removeEmptyInlines (Subscript [] : zs) = removeEmptyInlines zs
371−removeEmptyInlines (Superscript [] : zs) = removeEmptyInlines zs
372−removeEmptyInlines (SmallCaps [] : zs) = removeEmptyInlines zs
373−removeEmptyInlines (Strikeout [] : zs) = removeEmptyInlines zs
374−removeEmptyInlines (RawInline _ [] : zs) = removeEmptyInlines zs
375−removeEmptyInlines (Code _ [] : zs) = removeEmptyInlines zs
376−removeEmptyInlines (Str "" : zs) = removeEmptyInlines zs
377−removeEmptyInlines (x : xs) = x : removeEmptyInlines xs
378−removeEmptyInlines [] = []
379−
380−removeTrailingInlineSpaces :: [Inline] -> [Inline]
381−removeTrailingInlineSpaces = reverse . removeLeadingInlineSpaces . reverse
382−
383−removeLeadingInlineSpaces :: [Inline] -> [Inline]
384−removeLeadingInlineSpaces = dropWhile isSpaceOrEmpty
385−
386−consolidateInlines :: [Inline] -> [Inline]
387−consolidateInlines (Str x : ys) =
354+normalize :: Pandoc -> Pandoc
355+normalize (Pandoc (Meta meta) blocks) =
356+ Pandoc (Meta $ M.map go meta) (normalizeBlocks blocks)
357+ where go (MetaInlines xs) = MetaInlines $ normalizeInlines xs
358+ go (MetaBlocks xs) = MetaBlocks $ normalizeBlocks xs
359+ go (MetaList ms) = MetaList $ map go ms
360+ go (MetaMap m) = MetaMap $ M.map go m
361+ go x = x
362+
363+normalizeBlocks :: [Block] -> [Block]
364+normalizeBlocks (Null : xs) = normalizeBlocks xs
365+normalizeBlocks (Div attr bs : xs) =
366+ Div attr (normalizeBlocks bs) : normalizeBlocks xs
367+normalizeBlocks (BlockQuote bs : xs) =
368+ case normalizeBlocks bs of
369+ [] -> normalizeBlocks xs
370+ bs' -> BlockQuote bs' : normalizeBlocks xs
371+normalizeBlocks (BulletList [] : xs) = normalizeBlocks xs
372+normalizeBlocks (BulletList items : xs) =
373+ BulletList (map normalizeBlocks items) : normalizeBlocks xs
374+normalizeBlocks (OrderedList _ [] : xs) = normalizeBlocks xs
375+normalizeBlocks (OrderedList attr items : xs) =
376+ OrderedList attr (map normalizeBlocks items) : normalizeBlocks xs
377+normalizeBlocks (DefinitionList [] : xs) = normalizeBlocks xs
378+normalizeBlocks (DefinitionList items : xs) =
379+ DefinitionList (map go items) : normalizeBlocks xs
380+ where go (ils, bs) = (normalizeInlines ils, map normalizeBlocks bs)
381+normalizeBlocks (RawBlock _ "" : xs) = normalizeBlocks xs
382+normalizeBlocks (Para ils : xs) =
383+ case normalizeInlines ils of
384+ [] -> normalizeBlocks xs
385+ ils' -> Para ils' : normalizeBlocks xs
386+normalizeBlocks (Plain ils : xs) =
387+ case normalizeInlines ils of
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) =
388401 case concat (x : map fromStr strs) of
389− "" -> consolidateInlines rest
390− n -> Str n : consolidateInlines rest
402+ "" -> rest
403+ n -> Str n : rest
391404 where
392− (strs, rest) = span isStr ys
405+ (strs, rest) = span isStr $ normalizeInlines ys
393406 isStr (Str _) = True
394407 isStr _ = False
395408 fromStr (Str z) = z
396− fromStr _ = error "consolidateInlines - fromStr - not a Str"
397−consolidateInlines (Space : ys) = Space : rest
409+ fromStr _ = error "normalizeInlines - fromStr - not a Str"
410+normalizeInlines (Space : ys) =
411+ if null rest
412+ then []
413+ else Space : rest
398414 where isSp Space = True
399415 isSp _ = False
400− rest = consolidateInlines $ dropWhile isSp ys
401−consolidateInlines (Emph xs : Emph ys : zs) = consolidateInlines $
402− Emph (xs ++ ys) : zs
403−consolidateInlines (Strong xs : Strong ys : zs) = consolidateInlines $
404− Strong (xs ++ ys) : zs
405−consolidateInlines (Subscript xs : Subscript ys : zs) = consolidateInlines $
406− Subscript (xs ++ ys) : zs
407−consolidateInlines (Superscript xs : Superscript ys : zs) = consolidateInlines $
408− Superscript (xs ++ ys) : zs
409−consolidateInlines (SmallCaps xs : SmallCaps ys : zs) = consolidateInlines $
410− SmallCaps (xs ++ ys) : zs
411−consolidateInlines (Strikeout xs : Strikeout ys : zs) = consolidateInlines $
412− Strikeout (xs ++ ys) : zs
413−consolidateInlines (RawInline f x : RawInline f' y : zs) | f == f' =
414− consolidateInlines $ RawInline f (x ++ y) : zs
415−consolidateInlines (Code a1 x : Code a2 y : zs) | a1 == a2 =
416− consolidateInlines $ Code a1 (x ++ y) : zs
417−consolidateInlines (x : xs) = x : consolidateInlines xs
418−consolidateInlines [] = []
416+ rest = dropWhile isSp $ normalizeInlines ys
417+normalizeInlines (Emph xs : zs) =
418+ case normalizeInlines zs of
419+ (Emph ys : rest) -> normalizeInlines $
420+ Emph (normalizeInlines $ xs ++ ys) : rest
421+ rest -> case normalizeInlines xs of
422+ [] -> rest
423+ xs' -> Emph xs' : rest
424+normalizeInlines (Strong xs : zs) =
425+ case normalizeInlines zs of
426+ (Strong ys : rest) -> normalizeInlines $
427+ Strong (normalizeInlines $ xs ++ ys) : rest
428+ rest -> case normalizeInlines xs of
429+ [] -> rest
430+ xs' -> Strong xs' : rest
431+normalizeInlines (Subscript xs : zs) =
432+ case normalizeInlines zs of
433+ (Subscript ys : rest) -> normalizeInlines $
434+ Subscript (normalizeInlines $ xs ++ ys) : rest
435+ rest -> case normalizeInlines xs of
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 [] = []
419490
420491-- | Convert pandoc structure to a string with formatting removed.
421492-- Footnotes are skipped (since we don't want their contents in link