63d5e0c · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Added 'normalize' to Text.Pandoc.Shared.

63d5e0cJohn MacFarlane16 years ago

src/Text/Pandoc/Shared.hs+53−1

compare with master

unifiedsplit

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

57 -- * Pandoc block and inline list processing

58 orderedListMarkers,

59 normalizeSpaces,

60+ normalize,

60 stringify,

61 stringify,

61 compactify,

62 compactify,

62 Element (..),

63 Element (..),

@@ -88,7 +89,7 @@ import Network.URI ( isAllowedInURI, escapeURIString, unEscapeString )

88import Codec.Binary.UTF8.String ( encodeString, decodeString )

89import Codec.Binary.UTF8.String ( encodeString, decodeString )

89import System.Directory

90import System.Directory

90import System.FilePath ( (</>) )

91import System.FilePath ( (</>) )

91−import Data.Generics (Typeable, Data)

92+import Data.Generics (Typeable, Data, everywhere', mkT)

92import qualified Control.Monad.State as S

93import qualified Control.Monad.State as S

93import Paths_pandoc (getDataFileName)

94import Paths_pandoc (getDataFileName)

@@ -339,6 +340,57 @@ normalizeSpaces = cleanup . dropWhile isSpaceOrEmpty

339 cleanup ((Str ""):rest) = cleanup rest

340 cleanup ((Str ""):rest) = cleanup rest

340 cleanup (x:rest) = x : cleanup rest

341 cleanup (x:rest) = x : cleanup rest

341

342

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

344+-- combining adjacent 'Str's and 'Emph's, remove 'Null's and

345+-- empty elements, etc.

346+normalize :: Pandoc -> Pandoc

347+normalize = everywhere' (mkT normalizeInlines) .

348+ everywhere' (mkT normalizeBlocks)

349+

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

351+normalizeBlocks (Null : xs) = normalizeBlocks xs

352+normalizeBlocks (RawHtml x : RawHtml y : zs) = normalizeBlocks $

353+ RawHtml (x++y) : zs

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

355+normalizeBlocks [] = []

356+

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

358+normalizeInlines (Str x : ys) =

359+ case concat (x : map fromStr strs) of

360+ "" -> normalizeInlines rest

361+ n -> Str n : normalizeInlines rest

362+ where

363+ (strs, rest) = span isStr ys

364+ isStr (Str _) = True

365+ isStr _ = False

366+ fromStr (Str z) = z

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

368+normalizeInlines (Space : ys) =

369+ if null rest

370+ then []

371+ else Space : rest

372+ where isSpace Space = True

373+ isSpace _ = False

374+ rest = normalizeInlines $ dropWhile isSpace ys

375+normalizeInlines (Emph xs : Emph ys : zs) = normalizeInlines $

376+ Emph (xs ++ ys) : zs

377+normalizeInlines (Strong xs : Strong ys : zs) = normalizeInlines $

378+ Strong (xs ++ ys) : zs

379+normalizeInlines (Subscript xs : Subscript ys : zs) = normalizeInlines $

380+ Subscript (xs ++ ys) : zs

381+normalizeInlines (Superscript xs : Superscript ys : zs) = normalizeInlines $

382+ Superscript (xs ++ ys) : zs

383+normalizeInlines (SmallCaps xs : SmallCaps ys : zs) = normalizeInlines $

384+ SmallCaps (xs ++ ys) : zs

385+normalizeInlines (Strikeout xs : Strikeout ys : zs) = normalizeInlines $

386+ Strikeout (xs ++ ys) : zs

387+normalizeInlines (TeX x : TeX y : zs) = normalizeInlines $

388+ TeX (x ++ y) : zs

389+normalizeInlines (HtmlInline x : HtmlInline y : zs) = normalizeInlines $

390+ HtmlInline (x ++ y) : zs

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

392+normalizeInlines [] = []

393+

342-- | Convert list of inlines to a string with formatting removed.

394-- | Convert list of inlines to a string with formatting removed.

343stringify :: [Inline] -> String

395stringify :: [Inline] -> String

344stringify = queryWith go

396stringify = queryWith go