aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Shared.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Shared.hs')
-rw-r--r--src/Text/Pandoc/Shared.hs150
1 files changed, 0 insertions, 150 deletions
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 3df016996..6f52a8290 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -55,9 +55,6 @@ module Text.Pandoc.Shared (
orderedListMarkers,
normalizeSpaces,
extractSpaces,
- normalize,
- normalizeInlines,
- normalizeBlocks,
removeFormatting,
stringify,
capitalize,
@@ -398,153 +395,6 @@ extractSpaces f is =
_ -> mempty in
(left <> f (B.trimInlines . B.Many $ contents) <> right)
--- | Normalize @Pandoc@ document, consolidating doubled 'Space's,
--- combining adjacent 'Str's and 'Emph's, remove 'Null's and
--- empty elements, etc.
-normalize :: Pandoc -> Pandoc
-normalize (Pandoc (Meta meta) blocks) =
- Pandoc (Meta $ M.map go meta) (normalizeBlocks blocks)
- where go (MetaInlines xs) = MetaInlines $ normalizeInlines xs
- go (MetaBlocks xs) = MetaBlocks $ normalizeBlocks xs
- go (MetaList ms) = MetaList $ map go ms
- go (MetaMap m) = MetaMap $ M.map go m
- go x = x
-
-normalizeBlocks :: [Block] -> [Block]
-normalizeBlocks (Null : xs) = normalizeBlocks xs
-normalizeBlocks (Div attr bs : xs) =
- Div attr (normalizeBlocks bs) : normalizeBlocks xs
-normalizeBlocks (BlockQuote bs : xs) =
- case normalizeBlocks bs of
- [] -> normalizeBlocks xs
- bs' -> BlockQuote bs' : normalizeBlocks xs
-normalizeBlocks (BulletList [] : xs) = normalizeBlocks xs
-normalizeBlocks (BulletList items : xs) =
- BulletList (map normalizeBlocks items) : normalizeBlocks xs
-normalizeBlocks (OrderedList _ [] : xs) = normalizeBlocks xs
-normalizeBlocks (OrderedList attr items : xs) =
- OrderedList attr (map normalizeBlocks items) : normalizeBlocks xs
-normalizeBlocks (DefinitionList [] : xs) = normalizeBlocks xs
-normalizeBlocks (DefinitionList items : xs) =
- DefinitionList (map go items) : normalizeBlocks xs
- where go (ils, bs) = (normalizeInlines ils, map normalizeBlocks bs)
-normalizeBlocks (RawBlock _ "" : xs) = normalizeBlocks xs
-normalizeBlocks (RawBlock f x : xs) =
- case normalizeBlocks xs of
- (RawBlock f' x' : rest) | f' == f ->
- RawBlock f (x ++ ('\n':x')) : rest
- rest -> RawBlock f x : rest
-normalizeBlocks (Para ils : xs) =
- case normalizeInlines ils of
- [] -> normalizeBlocks xs
- ils' -> Para ils' : normalizeBlocks xs
-normalizeBlocks (Plain ils : xs) =
- case normalizeInlines ils of
- [] -> normalizeBlocks xs
- ils' -> Plain ils' : normalizeBlocks xs
-normalizeBlocks (Header lev attr ils : xs) =
- Header lev attr (normalizeInlines ils) : normalizeBlocks xs
-normalizeBlocks (Table capt aligns widths hdrs rows : xs) =
- Table (normalizeInlines capt) aligns widths
- (map normalizeBlocks hdrs) (map (map normalizeBlocks) rows)
- : normalizeBlocks xs
-normalizeBlocks (x:xs) = x : normalizeBlocks xs
-normalizeBlocks [] = []
-
-normalizeInlines :: [Inline] -> [Inline]
-normalizeInlines (Str x : ys) =
- case concat (x : map fromStr strs) of
- "" -> rest
- n -> Str n : rest
- where
- (strs, rest) = span isStr $ normalizeInlines ys
- isStr (Str _) = True
- isStr _ = False
- fromStr (Str z) = z
- fromStr _ = error "normalizeInlines - fromStr - not a Str"
-normalizeInlines (Space : SoftBreak : ys) =
- SoftBreak : normalizeInlines ys
-normalizeInlines (Space : ys) =
- if null rest
- then []
- else Space : rest
- where isSp Space = True
- isSp _ = False
- rest = dropWhile isSp $ normalizeInlines ys
-normalizeInlines (Emph xs : zs) =
- case normalizeInlines zs of
- (Emph ys : rest) -> normalizeInlines $
- Emph (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> Emph xs' : rest
-normalizeInlines (Strong xs : zs) =
- case normalizeInlines zs of
- (Strong ys : rest) -> normalizeInlines $
- Strong (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> Strong xs' : rest
-normalizeInlines (Subscript xs : zs) =
- case normalizeInlines zs of
- (Subscript ys : rest) -> normalizeInlines $
- Subscript (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> Subscript xs' : rest
-normalizeInlines (Superscript xs : zs) =
- case normalizeInlines zs of
- (Superscript ys : rest) -> normalizeInlines $
- Superscript (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> Superscript xs' : rest
-normalizeInlines (SmallCaps xs : zs) =
- case normalizeInlines zs of
- (SmallCaps ys : rest) -> normalizeInlines $
- SmallCaps (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> SmallCaps xs' : rest
-normalizeInlines (Strikeout xs : zs) =
- case normalizeInlines zs of
- (Strikeout ys : rest) -> normalizeInlines $
- Strikeout (normalizeInlines $ xs ++ ys) : rest
- rest -> case normalizeInlines xs of
- [] -> rest
- xs' -> Strikeout xs' : rest
-normalizeInlines (RawInline _ [] : ys) = normalizeInlines ys
-normalizeInlines (RawInline f xs : zs) =
- case normalizeInlines zs of
- (RawInline f' ys : rest) | f == f' -> normalizeInlines $
- RawInline f (xs ++ ys) : rest
- rest -> RawInline f xs : rest
-normalizeInlines (Code _ "" : ys) = normalizeInlines ys
-normalizeInlines (Code attr xs : zs) =
- case normalizeInlines zs of
- (Code attr' ys : rest) | attr == attr' -> normalizeInlines $
- Code attr (xs ++ ys) : rest
- rest -> Code attr xs : rest
--- allow empty spans, they may carry identifiers etc.
--- normalizeInlines (Span _ [] : ys) = normalizeInlines ys
-normalizeInlines (Span attr xs : zs) =
- case normalizeInlines zs of
- (Span attr' ys : rest) | attr == attr' -> normalizeInlines $
- Span attr (normalizeInlines $ xs ++ ys) : rest
- rest -> Span attr (normalizeInlines xs) : rest
-normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) :
- normalizeInlines ys
-normalizeInlines (Quoted qt ils : ys) =
- Quoted qt (normalizeInlines ils) : normalizeInlines ys
-normalizeInlines (Link attr ils t : ys) =
- Link attr (normalizeInlines ils) t : normalizeInlines ys
-normalizeInlines (Image attr ils t : ys) =
- Image attr (normalizeInlines ils) t : normalizeInlines ys
-normalizeInlines (Cite cs ils : ys) =
- Cite cs (normalizeInlines ils) : normalizeInlines ys
-normalizeInlines (x : xs) = x : normalizeInlines xs
-normalizeInlines [] = []
-
-- | Extract inlines, removing formatting.
removeFormatting :: Walkable Inline a => a -> [Inline]
removeFormatting = query go . walk deNote