8165014 · typeable/pandoc

git.iko.soy/typeable/pandoc

Removed `--normalize` option and normalization functions from Shared.

* Removed normalize, normalizeInlines, normalizeBlocks from Text.Pandoc.Shared. These shouldn't now be necessary, since normalization is handled automatically by the Builder monoid instance. * Remove `--normalize` command-line option. * Don't use normalize in tests. * A few revisions to readers so they work well without normalize.

commit8165014df679338d5bf228d84efc74b2c5ac39d2 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 11 Dec 2016, 22:09 (10 years ago) parent08110c3

13 files changed+30−214

compare with master

unifiedsplit

MANUAL.txt−5 pandoc.hs+1−7 src/Text/Pandoc/Readers/RST.hs+1−1 src/Text/Pandoc/Readers/Txt2Tags.hs+6−2 src/Text/Pandoc/Shared.hs−150 src/Text/Pandoc/Writers/Docx.hs+2−2 src/Text/Pandoc/Writers/DokuWiki.hs+11−4 tests/Tests/Helpers.hs+4−4 tests/Tests/Old.hs+2−10 tests/Tests/Readers/Org.hs+1−1 tests/Tests/Readers/Txt2Tags.hs+1−1 tests/Tests/Shared.hs+1−21 tests/rst-reader.native−6

MANUAL.txt−5

@@ -478,11 +478,6 @@ Reader options

478478 underlying document (which is accessible from filters and may be

479479 printed in some output formats).

480480

481−`--normalize`

482−

483−: Normalize the document after reading: merge adjacent

484− `Str` or `Emph` elements, for example, and remove repeated `Space`s.

485−

486481`-p`, `--preserve-tabs`

487482

488483: Preserve tabs instead of converting them to spaces (the default).

pandoc.hs+1−7

@@ -35,7 +35,7 @@ import Text.Pandoc.Builder (setMeta)

3535import Text.Pandoc.PDF (makePDF)

3636import Text.Pandoc.Walk (walk)

3737import Text.Pandoc.Shared ( tabFilter, readDataFileUTF8, readDataFile,

38− safeRead, headerShift, normalize, err, warn,

38+ safeRead, headerShift, err, warn,

3939 openURL )

4040import Text.Pandoc.MediaBag ( mediaDirectory, extractMediaBag, MediaBag )

4141import Text.Pandoc.XML ( toEntities )

@@ -731,12 +731,6 @@ options =

731731 "PROGRAM")

732732 "" -- "External JSON filter"

733733

734− , Option "" ["normalize"]

735− (NoArg

736− (\opt -> return opt { optTransforms =

737− normalize : optTransforms opt } ))

738− "" -- "Normalize the Pandoc AST"

739−

740734 , Option "p" ["preserve-tabs"]

741735 (NoArg

742736 (\opt -> return opt { optPreserveTabs = True }))

src/Text/Pandoc/Readers/RST.hs+1−1

@@ -744,7 +744,7 @@ addNewRole roleString fields = do

744744 M.insert role (baseRole, fmt, attr) customRoles

745745 }

746746

747− return $ B.singleton Null

747+ return mempty

748748 where

749749 countKeys k = length . filter (== k) . map fst $ fields

750750 inheritedRole =

src/Text/Pandoc/Readers/Txt2Tags.hs+6−2

@@ -447,9 +447,13 @@ inlineMarkup p f c special = try $ do

447447 lastChar <- anyChar

448448 end <- many1 (char c)

449449 let parser inp = parseFromString (mconcat <$> many p) inp

450− let start' = special (drop 2 start)

450+ let start' = case drop 2 start of

451+ "" -> mempty

452+ xs -> special xs

451453 body' <- parser (middle ++ [lastChar])

452− let end' = special (drop 2 end)

454+ let end' = case drop 2 end of

455+ "" -> mempty

456+ xs -> special xs

453457 return $ f (start' <> body' <> end')

454458 Nothing -> do -- Either bad or case such as *****

455459 guard (l >= 5)

src/Text/Pandoc/Shared.hs−150

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

5555 orderedListMarkers,

5656 normalizeSpaces,

5757 extractSpaces,

58− normalize,

59− normalizeInlines,

60− normalizeBlocks,

6158 removeFormatting,

6259 stringify,

6360 capitalize,

@@ -398,153 +395,6 @@ extractSpaces f is =

398395 _ -> mempty in

399396 (left <> f (B.trimInlines . B.Many $ contents) <> right)

400397

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

402−-- combining adjacent 'Str's and 'Emph's, remove 'Null's and

403−-- empty elements, etc.

404−normalize :: Pandoc -> Pandoc

405−normalize (Pandoc (Meta meta) blocks) =

406− Pandoc (Meta $ M.map go meta) (normalizeBlocks blocks)

407− where go (MetaInlines xs) = MetaInlines $ normalizeInlines xs

408− go (MetaBlocks xs) = MetaBlocks $ normalizeBlocks xs

409− go (MetaList ms) = MetaList $ map go ms

410− go (MetaMap m) = MetaMap $ M.map go m

411− go x = x

412−

413−normalizeBlocks :: [Block] -> [Block]

414−normalizeBlocks (Null : xs) = normalizeBlocks xs

415−normalizeBlocks (Div attr bs : xs) =

416− Div attr (normalizeBlocks bs) : normalizeBlocks xs

417−normalizeBlocks (BlockQuote bs : xs) =

418− case normalizeBlocks bs of

419− [] -> normalizeBlocks xs

420− bs' -> BlockQuote bs' : normalizeBlocks xs

421−normalizeBlocks (BulletList [] : xs) = normalizeBlocks xs

422−normalizeBlocks (BulletList items : xs) =

423− BulletList (map normalizeBlocks items) : normalizeBlocks xs

424−normalizeBlocks (OrderedList _ [] : xs) = normalizeBlocks xs

425−normalizeBlocks (OrderedList attr items : xs) =

426− OrderedList attr (map normalizeBlocks items) : normalizeBlocks xs

427−normalizeBlocks (DefinitionList [] : xs) = normalizeBlocks xs

428−normalizeBlocks (DefinitionList items : xs) =

429− DefinitionList (map go items) : normalizeBlocks xs

430− where go (ils, bs) = (normalizeInlines ils, map normalizeBlocks bs)

431−normalizeBlocks (RawBlock _ "" : xs) = normalizeBlocks xs

432−normalizeBlocks (RawBlock f x : xs) =

433− case normalizeBlocks xs of

434− (RawBlock f' x' : rest) | f' == f ->

435− RawBlock f (x ++ ('\n':x')) : rest

436− rest -> RawBlock f x : rest

437−normalizeBlocks (Para ils : xs) =

438− case normalizeInlines ils of

439− [] -> normalizeBlocks xs

440− ils' -> Para ils' : normalizeBlocks xs

441−normalizeBlocks (Plain ils : xs) =

442− case normalizeInlines ils of

443− [] -> normalizeBlocks xs

444− ils' -> Plain ils' : normalizeBlocks xs

445−normalizeBlocks (Header lev attr ils : xs) =

446− Header lev attr (normalizeInlines ils) : normalizeBlocks xs

447−normalizeBlocks (Table capt aligns widths hdrs rows : xs) =

448− Table (normalizeInlines capt) aligns widths

449− (map normalizeBlocks hdrs) (map (map normalizeBlocks) rows)

450− : normalizeBlocks xs

451−normalizeBlocks (x:xs) = x : normalizeBlocks xs

452−normalizeBlocks [] = []

453−

454−normalizeInlines :: [Inline] -> [Inline]

455−normalizeInlines (Str x : ys) =

456− case concat (x : map fromStr strs) of

457− "" -> rest

458− n -> Str n : rest

459− where

460− (strs, rest) = span isStr $ normalizeInlines ys

461− isStr (Str _) = True

462− isStr _ = False

463− fromStr (Str z) = z

464− fromStr _ = error "normalizeInlines - fromStr - not a Str"

465−normalizeInlines (Space : SoftBreak : ys) =

466− SoftBreak : normalizeInlines ys

467−normalizeInlines (Space : ys) =

468− if null rest

469− then []

470− else Space : rest

471− where isSp Space = True

472− isSp _ = False

473− rest = dropWhile isSp $ normalizeInlines ys

474−normalizeInlines (Emph xs : zs) =

475− case normalizeInlines zs of

476− (Emph ys : rest) -> normalizeInlines $

477− Emph (normalizeInlines $ xs ++ ys) : rest

478− rest -> case normalizeInlines xs of

479− [] -> rest

480− xs' -> Emph xs' : rest

481−normalizeInlines (Strong xs : zs) =

482− case normalizeInlines zs of

483− (Strong ys : rest) -> normalizeInlines $

484− Strong (normalizeInlines $ xs ++ ys) : rest

485− rest -> case normalizeInlines xs of

486− [] -> rest

487− xs' -> Strong xs' : rest

488−normalizeInlines (Subscript xs : zs) =

489− case normalizeInlines zs of

490− (Subscript ys : rest) -> normalizeInlines $

491− Subscript (normalizeInlines $ xs ++ ys) : rest

492− rest -> case normalizeInlines xs of

493− [] -> rest

494− xs' -> Subscript xs' : rest

495−normalizeInlines (Superscript xs : zs) =

496− case normalizeInlines zs of

497− (Superscript ys : rest) -> normalizeInlines $

498− Superscript (normalizeInlines $ xs ++ ys) : rest

499− rest -> case normalizeInlines xs of

500− [] -> rest

501− xs' -> Superscript xs' : rest

502−normalizeInlines (SmallCaps xs : zs) =

503− case normalizeInlines zs of

504− (SmallCaps ys : rest) -> normalizeInlines $

505− SmallCaps (normalizeInlines $ xs ++ ys) : rest

506− rest -> case normalizeInlines xs of

507− [] -> rest

508− xs' -> SmallCaps xs' : rest

509−normalizeInlines (Strikeout xs : zs) =

510− case normalizeInlines zs of

511− (Strikeout ys : rest) -> normalizeInlines $

512− Strikeout (normalizeInlines $ xs ++ ys) : rest

513− rest -> case normalizeInlines xs of

514− [] -> rest

515− xs' -> Strikeout xs' : rest

516−normalizeInlines (RawInline _ [] : ys) = normalizeInlines ys

517−normalizeInlines (RawInline f xs : zs) =

518− case normalizeInlines zs of

519− (RawInline f' ys : rest) | f == f' -> normalizeInlines $

520− RawInline f (xs ++ ys) : rest

521− rest -> RawInline f xs : rest

522−normalizeInlines (Code _ "" : ys) = normalizeInlines ys

523−normalizeInlines (Code attr xs : zs) =

524− case normalizeInlines zs of

525− (Code attr' ys : rest) | attr == attr' -> normalizeInlines $

526− Code attr (xs ++ ys) : rest

527− rest -> Code attr xs : rest

528−-- allow empty spans, they may carry identifiers etc.

529−-- normalizeInlines (Span _ [] : ys) = normalizeInlines ys

530−normalizeInlines (Span attr xs : zs) =

531− case normalizeInlines zs of

532− (Span attr' ys : rest) | attr == attr' -> normalizeInlines $

533− Span attr (normalizeInlines $ xs ++ ys) : rest

534− rest -> Span attr (normalizeInlines xs) : rest

535−normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) :

536− normalizeInlines ys

537−normalizeInlines (Quoted qt ils : ys) =

538− Quoted qt (normalizeInlines ils) : normalizeInlines ys

539−normalizeInlines (Link attr ils t : ys) =

540− Link attr (normalizeInlines ils) t : normalizeInlines ys

541−normalizeInlines (Image attr ils t : ys) =

542− Image attr (normalizeInlines ils) t : normalizeInlines ys

543−normalizeInlines (Cite cs ils : ys) =

544− Cite cs (normalizeInlines ils) : normalizeInlines ys

545−normalizeInlines (x : xs) = x : normalizeInlines xs

546−normalizeInlines [] = []

547−

548398-- | Extract inlines, removing formatting.

549399removeFormatting :: Walkable Inline a => a -> [Inline]

550400removeFormatting = query go . walk deNote

src/Text/Pandoc/Writers/Docx.hs+2−2

@@ -141,7 +141,7 @@ defaultWriterState = WriterState{

141141 , stDelId = 1

142142 , stStyleMaps = defaultStyleMaps

143143 , stFirstPara = False

144− , stTocTitle = normalizeInlines [Str "Table of Contents"]

144+ , stTocTitle = [Str "Table of Contents"]

145145 , stDynamicParaProps = []

146146 , stDynamicTextProps = []

147147 }

@@ -207,7 +207,7 @@ isValidChar (ord -> c)

207207 | otherwise = False

208208

209209metaValueToInlines :: MetaValue -> [Inline]

210−metaValueToInlines (MetaString s) = normalizeInlines [Str s]

210+metaValueToInlines (MetaString s) = [Str s]

211211metaValueToInlines (MetaInlines ils) = ils

212212metaValueToInlines (MetaBlocks bs) = query return bs

213213metaValueToInlines (MetaBool b) = [Str $ show b]

src/Text/Pandoc/Writers/DokuWiki.hs+11−4

@@ -45,7 +45,7 @@ import Text.Pandoc.Options ( WriterOptions(

4545 , writerTemplate

4646 , writerWrapText), WrapOption(..) )

4747import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting

48− , camelCaseToHyphenated, trimr, normalize, substitute )

48+ , camelCaseToHyphenated, trimr, substitute )

4949import Text.Pandoc.Writers.Shared ( defField, metaToJSON )

5050import Text.Pandoc.ImageSize

5151import Text.Pandoc.Templates ( renderTemplate' )

@@ -80,7 +80,7 @@ type DokuWiki = ReaderT WriterEnvironment (State WriterState)

8080-- | Convert Pandoc to DokuWiki.

8181writeDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String

8282writeDokuWiki opts document = return $

83− runDokuWiki (pandocToDokuWiki opts $ normalize document)

83+ runDokuWiki (pandocToDokuWiki opts document)

8484

8585runDokuWiki :: DokuWiki a -> a

8686runDokuWiki = flip evalState def . flip runReaderT def

@@ -394,9 +394,16 @@ blockListToDokuWiki :: WriterOptions -- ^ Options

394394 -> DokuWiki String

395395blockListToDokuWiki opts blocks = do

396396 backSlash <- stBackSlashLB <$> ask

397+ let blocks' = consolidateRawBlocks blocks

397398 if backSlash

398− then (backSlashLineBreaks . vcat) <$> mapM (blockToDokuWiki opts) blocks

399− else vcat <$> mapM (blockToDokuWiki opts) blocks

399+ then (backSlashLineBreaks . vcat) <$> mapM (blockToDokuWiki opts) blocks'

400+ else vcat <$> mapM (blockToDokuWiki opts) blocks'

401+

402+consolidateRawBlocks :: [Block] -> [Block]

403+consolidateRawBlocks [] = []

404+consolidateRawBlocks (RawBlock f1 b1 : RawBlock f2 b2 : xs)

405+ | f1 == f2 = consolidateRawBlocks (RawBlock f1 (b1 ++ "\n" ++ b2) : xs)

406+consolidateRawBlocks (x:xs) = x : consolidateRawBlocks xs

400407

401408-- | Convert list of Pandoc inline elements to DokuWiki.

402409inlineListToDokuWiki :: WriterOptions -> [Inline] -> DokuWiki String

tests/Tests/Helpers.hs+4−4

@@ -17,7 +17,7 @@ import Test.Framework

1717import Test.Framework.Providers.HUnit

1818import Test.Framework.Providers.QuickCheck2

1919import Test.HUnit (assertBool)

20−import Text.Pandoc.Shared (normalize, trimr)

20+import Text.Pandoc.Shared (trimr)

2121import Text.Pandoc.Options

2222import Text.Pandoc.Writers.Native (writeNative)

2323import qualified Test.QuickCheck.Property as QP

@@ -81,10 +81,10 @@ class ToPandoc a where

8181 toPandoc :: a -> Pandoc

8282

8383instance ToPandoc Pandoc where

84− toPandoc = normalize

84+ toPandoc = id

8585

8686instance ToPandoc Blocks where

87− toPandoc = normalize . doc

87+ toPandoc = doc

8888

8989instance ToPandoc Inlines where

90− toPandoc = normalize . doc . plain

90+ toPandoc = doc . plain

tests/Tests/Old.hs+2−10

@@ -11,15 +11,10 @@ import System.FilePath ( (</>), (<.>), takeDirectory, splitDirectories,

1111import System.Directory

1212import System.Exit

1313import Data.Algorithm.Diff

14−import Text.Pandoc.Shared ( normalize )

15−import Text.Pandoc.Options

16−import Text.Pandoc.Writers.Native ( writeNative )

17−import Text.Pandoc.Readers.Native ( readNative )

1814import Prelude hiding ( readFile )

1915import qualified Data.ByteString.Lazy as B

2016import Text.Pandoc.UTF8 (toStringLazy)

2117import Text.Printf

22−import Tests.Helpers (purely)

2318

2419readFileUTF8 :: FilePath -> IO String

2520readFileUTF8 f = B.readFile f >>= return . toStringLazy

@@ -193,12 +188,9 @@ lhsWriterTests format

193188

194189lhsReaderTest :: String -> Test

195190lhsReaderTest format =

196− testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]

191+ test "lhs" ["-r", format, "-w", "native"]

197192 ("lhs-test" <.> format) norm

198− where normalizer = purely $ \nat -> do

199− d <- readNative def nat

200− writeNative def $ normalize d

201− norm = if format == "markdown+lhs"

193+ where norm = if format == "markdown+lhs"

202194 then "lhs-test-markdown.native"

203195 else "lhs-test.native"

204196

tests/Tests/Readers/Org.hs+1−1

@@ -1525,7 +1525,7 @@ tests =

15251525 , ""

15261526 , "#+RESULTS:"

15271527 , ": 65" ] =?>

1528− rawBlock "html" ""

1528+ (mempty :: Blocks)

15291529

15301530 , "Source block with toggling header arguments" =:

15311531 unlines [ "#+BEGIN_SRC sh :noeval"

tests/Tests/Readers/Txt2Tags.hs+1−1

@@ -88,7 +88,7 @@ tests =

8888 para "1970-01-01"

8989 , "Macros: Mod Time" =:

9090 "%%mtime" =?>

91− para ""

91+ para (str "")

9292 , "Macros: Infile" =:

9393 "%%infile" =?>

9494 para "in"

tests/Tests/Shared.hs+1−21

@@ -1,9 +1,7 @@

11module Tests.Shared (tests) where

3−import Text.Pandoc.Definition

43import Text.Pandoc.Shared

54import Test.Framework

6−import Tests.Helpers

75import Text.Pandoc.Arbitrary()

86import Test.Framework.Providers.HUnit

97import Test.HUnit ( assertBool, (@?=) )

@@ -11,13 +9,7 @@ import Text.Pandoc.Builder

119import System.FilePath.Posix (joinPath)

1210

1311tests :: [Test]

14−tests = [ testGroup "normalize"

15− [ property "p_normalize_blocks_rt" p_normalize_blocks_rt

16− , property "p_normalize_inlines_rt" p_normalize_inlines_rt

17− , property "p_normalize_no_trailing_spaces"

18− p_normalize_no_trailing_spaces

19− ]

20− , testGroup "compactify'DL"

12+tests = [ testGroup "compactify'DL"

2113 [ testCase "compactify'DL with empty def" $

2214 assertBool "compactify'DL"

2315 (let x = [(str "word", [para (str "def"), mempty])]

@@ -26,18 +18,6 @@ tests = [ testGroup "normalize"

2618 , testGroup "collapseFilePath" testCollapse

2719 ]

2820

29−p_normalize_blocks_rt :: [Block] -> Bool

30−p_normalize_blocks_rt bs =

31− normalizeBlocks bs == normalizeBlocks (normalizeBlocks bs)

32−

33−p_normalize_inlines_rt :: [Inline] -> Bool

34−p_normalize_inlines_rt ils =

35− normalizeInlines ils == normalizeInlines (normalizeInlines ils)

36−

37−p_normalize_no_trailing_spaces :: [Inline] -> Bool

38−p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space

39− where ils' = normalizeInlines $ ils ++ [Space]

40−

4121testCollapse :: [Test]

4222testCollapse = map (testCase "collapse")

4323 [ (collapseFilePath (joinPath [ ""]) @?= (joinPath [ ""]))

tests/rst-reader.native−6

@@ -327,15 +327,9 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa

327327,Para [Str "Some",Space,Superscript [Str "of"],Space,Str "these",Space,Superscript [Str "words"],Space,Str "are",Space,Str "in",Space,Superscript [Str "superscript"],Str "."]

328328,Para [Str "Reset",Space,Str "default-role",Space,Str "to",Space,Str "the",Space,Str "default",Space,Str "default."]

329329,Para [Str "And",Space,Str "now",Space,Str "some-invalid-string-3231231",Space,Str "is",Space,Str "nonsense."]

330−,Null

331330,Para [Str "And",Space,Str "now",Space,Str "with",Space,RawInline (Format "html") "<b>inline</b> <span id=\"test\">HTML</span>",Str "."]

332−,Null

333331,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["haskell","sourceCode"],[]) "fmap id [1,2..10]",Str "."]

334−,Null

335−,Null

336332,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["py","python","indirect","sourceCode"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]

337−,Null

338−,Null

339333,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["c","different-indirect","sourceCode"],[]) "int x = 15;",Str "."]

340334,Header 2 ("literal-symbols",[],[]) [Str "Literal",Space,Str "symbols"]

341335,Para [Str "2*2",Space,Str "=",Space,Str "4*1"]]