d247e9f72e
Previously we used the following Project Gutenberg conventions for plain output: - extra space before and after level 1 and 2 headings - all-caps for strong emphasis `LIKE THIS` - underscores surrounding regular emphasis `_like this_` This commit makes `plain` output plainer. Strong and Emph inlines are rendered without special formatting. Headings are also rendered without special formatting, and with only one blank line following. To restore the former behavior, use `-t plain+gutenberg`. API change: Add `Ext_gutenberg` constructor to `Extension`. See #5741.
25 lines
639 B
Haskell
25 lines
639 B
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Tests.Writers.Plain (tests) where
|
|
|
|
import Prelude
|
|
import Test.Tasty
|
|
import Tests.Helpers
|
|
import Text.Pandoc
|
|
import Text.Pandoc.Arbitrary ()
|
|
import Text.Pandoc.Builder
|
|
|
|
|
|
infix 4 =:
|
|
(=:) :: (ToString a, ToPandoc a)
|
|
=> String -> (a, String) -> TestTree
|
|
(=:) = test (purely (writePlain def{ writerExtensions =
|
|
enableExtension Ext_gutenberg plainExtensions }) .
|
|
toPandoc)
|
|
|
|
|
|
tests :: [TestTree]
|
|
tests = [ "strongly emphasized text to uppercase"
|
|
=: strong "Straße"
|
|
=?> "STRASSE"
|
|
]
|