1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Tests.Writers.RST (tests) where
4
5import Prelude
6import Control.Monad.Identity
7import Test.Tasty
8import Test.Tasty.HUnit
9import Tests.Helpers
10import Text.Pandoc
11import Text.Pandoc.Arbitrary ()
12import Text.Pandoc.Builder
13import Text.Pandoc.Writers.RST
14import qualified Data.Text as T
15
16infix 4 =:
17(=:) :: (ToString a, ToPandoc a)
18     => String -> (a, String) -> TestTree
19(=:) = test (purely (writeRST def . toPandoc))
20
21testTemplate :: (ToString a, ToString c, ToPandoc a) =>
22                String -> String -> (a, c) -> TestTree
23testTemplate t = case runIdentity (compileTemplate [] (T.pack t)) of
24    Left e -> error $ "Could not compile RST template: " ++ e
25    Right templ -> test (purely (writeRST def{ writerTemplate = Just templ }) . toPandoc)
26
27bodyTemplate :: Template T.Text
28bodyTemplate = case runIdentity (compileTemplate [] "$body$\n") of
29                    Left e      -> error $
30                      "Could not compile RST bodyTemplate" ++ e
31                    Right templ -> templ
32
33tests :: [TestTree]
34tests = [ testGroup "rubrics"
35          [ "in list item" =:
36              bulletList [header 2 (text "foo")] =?>
37              "-  .. rubric:: foo"
38          , "in definition list item" =:
39              definitionList [(text "foo", [header 2 (text "bar"),
40                                            para $ text "baz"])] =?>
41              unlines
42              [ "foo"
43              , "   .. rubric:: bar"
44              , ""
45              , "   baz"]
46          , "in block quote" =:
47              blockQuote (header 1 (text "bar")) =?>
48              "   .. rubric:: bar"
49          , "with id" =:
50              blockQuote (headerWith ("foo",[],[]) 1 (text "bar")) =?>
51              unlines
52              [ "   .. rubric:: bar"
53              , "      :name: foo"]
54          , "with id class" =:
55              blockQuote (headerWith ("foo",["baz"],[]) 1 (text "bar")) =?>
56              unlines
57              [ "   .. rubric:: bar"
58              , "      :name: foo"
59              , "      :class: baz"]
60          ]
61        , testGroup "ligatures" -- handling specific sequences of blocks
62          [ "a list is closed by a comment before a quote" =: -- issue 4248
63            bulletList [plain "bulleted"] <> blockQuote (plain "quoted") =?>
64              unlines
65              [ "-  bulleted"
66              , ""
67              , ".."
68              , ""
69              , "   quoted"]
70          ]
71        , testGroup "flatten"
72          [ testCase "emerges nested styles as expected" $
73            flatten (Emph [Str "1", Strong [Str "2"], Str "3"]) @?=
74            [Emph [Str "1"], Strong [Str "2"], Emph [Str "3"]]
75          , testCase "could introduce trailing spaces" $
76            flatten (Emph [Str "f", Space, Strong [Str "2"]]) @?=
77            [Emph [Str "f", Space], Strong [Str "2"]]
78            -- the test above is the reason why we call
79            -- stripLeadingTrailingSpace through transformNested after
80            -- flatten
81          , testCase "preserves empty parents" $
82            flatten (Image ("",[],[]) [] ("loc","title")) @?=
83            [Image ("",[],[]) [] ("loc","title")]
84          ]
85        , testGroup "inlines"
86          [ "are removed when empty" =: -- #4434
87            plain (strong (str "")) =?> ""
88          , "do not cause the introduction of extra spaces when removed" =:
89            plain (strong (str "") <> emph (str "text")) =?> "*text*"
90          , "spaces are stripped at beginning and end" =:
91            -- pandoc issue 4327 "The text within inline markup may not
92            -- begin or end with whitespace"
93            -- http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html#inline-markup
94            strong (space <> str "text" <> space <> space) =?> "**text**"
95          , "single space stripped" =:
96            strong space =?> ""
97          , "give priority to strong style over emphasis" =:
98            strong (emph (strong (str "s"))) =?> "**s**"
99          , "links are not elided by outer style" =:
100            strong (emph (link "loc" "" (str "text"))) =?>
101            "`text <loc>`__"
102          , "RST inlines cannot start nor end with spaces" =:
103            emph (str "f" <> space <> strong (str "d") <> space <> str "l") =?>
104            "*f*\\ **d**\\ *l*"
105          , "keeps quotes" =:
106            strong (str "f" <> doubleQuoted (str "d") <> str "l") =?>
107            "**f“d”l**"
108          , "backslash inserted between str and code" =:
109            str "/api?query=" <> code "foo" =?>
110            "/api?query=\\ ``foo``"
111          ]
112        , testGroup "headings"
113          [ "normal heading" =:
114              header 1 (text "foo") =?>
115              unlines
116              [ "foo"
117              , "==="]
118          -- note: heading normalization is only done in standalone mode
119          , test (purely (writeRST def{ writerTemplate = Just bodyTemplate })
120                       . toPandoc)
121            "heading levels" $
122              header 1 (text "Header 1") <>
123              header 3 (text "Header 2") <>
124              header 2 (text "Header 2") <>
125              header 1 (text "Header 1") <>
126              header 4 (text "Header 2") <>
127              header 5 (text "Header 3") <>
128              header 3 (text "Header 2") =?>
129              unlines
130              [ "Header 1"
131              , "========"
132              , ""
133              , "Header 2"
134              , "--------"
135              , ""
136              , "Header 2"
137              , "--------"
138              , ""
139              , "Header 1"
140              , "========"
141              , ""
142              , "Header 2"
143              , "--------"
144              , ""
145              , "Header 3"
146              , "~~~~~~~~"
147              , ""
148              , "Header 2"
149              , "--------"]
150          , test (purely (writeRST def{ writerTemplate = Just bodyTemplate }) . toPandoc)
151            "minimal heading levels" $
152              header 2 (text "Header 1") <>
153              header 3 (text "Header 2") <>
154              header 2 (text "Header 1") <>
155              header 4 (text "Header 2") <>
156              header 5 (text "Header 3") <>
157              header 3 (text "Header 2") =?>
158              unlines
159              [ "Header 1"
160              , "========"
161              , ""
162              , "Header 2"
163              , "--------"
164              , ""
165              , "Header 1"
166              , "========"
167              , ""
168              , "Header 2"
169              , "--------"
170              , ""
171              , "Header 3"
172              , "~~~~~~~~"
173              , ""
174              , "Header 2"
175              , "--------"]
176          ]
177        , testTemplate "$subtitle$\n" "subtitle" $
178          setMeta "subtitle" ("subtitle" :: Inlines) (doc $ plain "") =?>
179          ("subtitle" :: String)
180        ]
181