1{-# LANGUAGE OverloadedStrings #-}
2{- |
3   Module      : Tests.Readers.Man
4   Copyright   : © 2018-2019 Yan Pas <yanp.bugz@gmail.com>,
5                   2018-2021 John MacFarlane
6   License     : GNU GPL, version 2 or above
7
8   Maintainer  : John MacFarlane <jgm@berkeley.edu>
9   Stability   : alpha
10   Portability : portable
11
12Tests for the Man reader.
13-}
14module Tests.Readers.Man (tests) where
15
16import Prelude
17import Data.Text (Text)
18import Test.Tasty
19import Tests.Helpers
20import Text.Pandoc
21import Text.Pandoc.Arbitrary ()
22import Text.Pandoc.Builder
23import Text.Pandoc.Readers.Man
24
25man :: Text -> Pandoc
26man = purely $ readMan def
27
28infix 4 =:
29(=:) :: ToString c
30     => String -> (Text, c) -> TestTree
31(=:) = test man
32
33toRow :: [Blocks] -> Row
34toRow = Row nullAttr . map simpleCell
35
36tests :: [TestTree]
37tests = [
38  -- .SH "HEllo bbb" "aaa"" as"
39  testGroup "Macros" [
40      "Bold" =:
41      ".B foo"
42      =?> para (strong "foo")
43    , "Italic" =:
44      ".I bar\n"
45      =?> para (emph "bar")
46    , "BoldItalic" =:
47      ".BI foo bar"
48      =?> para (strong (str "foo") <> emph (str "bar"))
49    , "H1" =:
50      ".SH The header\n"
51      =?> header 1 (text "The header")
52    , "H2" =:
53      ".SS \"The header 2\""
54      =?> header 2 (text "The header 2")
55    , "Macro args" =:
56      ".B \"single arg with \"\"Q\"\"\""
57      =?>para (strong $ text "single arg with \"Q\"")
58    , "Argument from next line" =:
59      ".B\nsingle arg with \"Q\""
60      =?>para (strong $ text "single arg with \"Q\"")
61    , "comment" =:
62      ".\\\"bla\naaa"
63      =?>para (str "aaa")
64    , "link" =:
65      ".BR aa (1)"
66      =?> para (strong (str "aa") <> str "(1)")
67    ],
68  testGroup "Escapes" [
69      "fonts" =:
70      "aa\\fIbb\\fRcc"
71      =?>para (str "aa" <> emph (str "bb") <> str "cc")
72    , "nested fonts" =:
73      "\\f[BI]hi\\f[I] there\\f[R]"
74      =?> para (emph (strong (text "hi") <> text " there"))
75    , "nested fonts 2" =:
76      "\\f[R]hi \\f[I]there \\f[BI]bold\\f[R] ok"
77      =?> para (text "hi " <> emph (text "there " <> strong (text "bold")) <>
78                                   text " ok")
79    , "skip" =:
80      "a\\%\\\n\\:b\\0"
81      =?>para (str "ab\8199")
82    , "replace" =:
83      "\\-\\ \\\\\\[lq]\\[rq]\\[em]\\[en]\\*(lq\\*(rq"
84      =?>para (text "- \\“”—–“”")
85    , "replace2" =:
86      "\\t\\e\\`\\^\\|\\'" =?>para (text "\\`\8202\8198'")
87    , "comment  with \\\"" =:
88      "Foo \\\" bar\n" =?>para (text "Foo")
89    , "comment with \\#" =:
90      "Foo\\#\nbar\n" =?>para (text "Foobar")
91    , "two letter escapes" =:
92      "\\(oA\\(~O" =?>para (text "ÅÕ")
93    , "bracketed escapes" =:
94      "\\[oA]\\[~O]\\[Do]\\[Ye]\\[product]\\[ul]" =?>para (text "ÅÕ$¥∏_")
95    , "unicode escapes" =:
96      "\\[u2020]" =?>para (text "†")
97    , "unicode escapes (combined)" =:
98      "\\[u0075_u0301]" =?>para (text "\250")
99    , "unknown escape (#5034)" =:
100       "\\9" =?>para (text "9")
101    ],
102  testGroup "Lists" [
103      "bullet" =:
104      ".IP \"\\[bu]\"\nfirst\n.IP \"\\[bu]\"\nsecond"
105      =?> bulletList [para $ str "first", para $ str "second"]
106    , "ordered" =:
107      ".IP 2 a\nfirst\n.IP 3 a\nsecond"
108      =?> orderedListWith (2,Decimal,DefaultDelim) [para $ str "first", para $ str "second"]
109    , "upper" =:
110      ".IP A) a\nfirst\n.IP B) a\nsecond"
111      =?> orderedListWith (1,UpperAlpha,OneParen) [para $ str "first", para $ str "second"]
112    , "nested" =:
113      ".IP \"\\[bu]\"\nfirst\n.RS\n.IP \"\\[bu]\"\n1a\n.IP \"\\[bu]\"\n1b\n.RE"
114      =?> bulletList [para (str "first") <> bulletList [para $ str "1a", para $ str "1b"]]
115    , "change in list style" =:
116      ".IP \\[bu]\nfirst\n.IP 1\nsecond"
117      =?> bulletList [para (str "first")] <>
118            orderedListWith (1,Decimal,DefaultDelim) [para (str "second")]
119    ],
120  testGroup "CodeBlocks" [
121      "cb1"=:
122      ".nf\naa\n\tbb\n.fi"
123      =?> codeBlock "aa\n\tbb"
124    ],
125  testGroup "Tables" [
126      "t1" =:
127      ".TS\nallbox;\nl l l.\na\tb\tc\nd\te\tf\n.TE"
128      =?> table
129            emptyCaption
130            (replicate 3 (AlignLeft, ColWidthDefault))
131            (TableHead nullAttr [])
132            [TableBody nullAttr 0 [] $ map toRow
133              [map (plain . str ) ["a", "b", "c"],
134               map (plain . str ) ["d", "e", "f"]]]
135            (TableFoot nullAttr []),
136      "longcell" =:
137      ".TS\n;\nr.\nT{\na\nb\nc d\nT}\nf\n.TE"
138      =?> table
139            emptyCaption
140            [(AlignRight, ColWidthDefault)]
141            (TableHead nullAttr [])
142            [TableBody nullAttr 0 [] $ map toRow [[plain $ text "a b c d"], [plain $ str "f"]]]
143            (TableFoot nullAttr [])
144    ]
145  ]
146