1 {-# LANGUAGE OverloadedLists #-}
2 {-# LANGUAGE TypeApplications #-}
6 import Test.Tasty.HUnit
8 import Data.Foldable (Foldable(..))
9 import Data.Function (($), (.))
10 import Data.Functor ((<$>))
12 import Data.Maybe (Maybe(..))
13 import Data.Ord (Ord(..))
14 import Data.Semigroup (Semigroup(..))
15 import Data.String (String)
16 import Text.Show (Show(..))
17 import qualified Data.List as List
18 import qualified Data.Text.Lazy as TL
20 import qualified Language.Symantic.Document.Term as Doc
21 import Language.Symantic.Document.Term ((<+>))
25 hunits = testGroup "HUnit" $
30 (==>) :: Doc.Term -> TL.Text -> Assertion
31 p ==> expected = got @?= expected
32 where got = Doc.textTerm p
34 testList :: String -> [Assertion] -> TestTree
35 testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
37 testMessage :: TL.Text -> String
39 foldMap esc $ TL.unpack $
40 if 42 < TL.length msg then excerpt else msg
42 excerpt = TL.take 42 msg <> "…"
47 hunitsTerm :: TestTree
48 hunitsTerm = testGroup "Term"
50 [ Doc.newline ==> "\n"
51 , Doc.stringH "hello" ==> "hello"
53 , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
55 , testList "Indentable"
56 [ "hello\nworld" ==> "hello\nworld"
57 , " "<> "hello\nworld\n!" ==> " hello\nworld\n!"
58 , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n world\n !"
59 , Doc.hang 2 "hello\nworld\n!" ==> "hello\n world\n !"
60 , Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n world\n !\nhello\n!"
61 , "let " <> Doc.align (Doc.catV $
62 (\(name, typ) -> Doc.fill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
63 `List.map` [ ("abcdef","Doc")
64 , ("abcde","Int -> Doc -> Doc")
65 , ("abcdefghi","Doc") ])
66 ==> "let abcdef :: Doc\n abcde :: Int -> Doc -> Doc\n abcdefghi :: Doc"
67 , "let " <> Doc.align (Doc.catV $
68 (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> Doc.stringH typ)
69 `List.map` [ ("abcdef","Doc")
70 , ("abcde","Int -> Doc -> Doc")
71 , ("abcdefghi","Doc") ])
72 ==> "let abcdef :: Doc\n abcde :: Int -> Doc -> Doc\n abcdefghi\n :: Doc"
73 , "let " <> Doc.align (Doc.catV $
74 (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> typ)
75 `List.map` [("abcdefghi","Doc ->\nDoc")])
76 ==> "let abcdefghi\n :: Doc ->\n Doc"
77 , "let " <> Doc.align (Doc.catV $
78 (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> Doc.align (" ::" <+> typ))
79 `List.map` [("abcdefghi","Doc ->\nDoc")])
80 ==> "let abcdefghi\n :: Doc ->\n Doc"
82 , testList "Breakable"
83 [ 10`wc` be ["hello", "world"] ==> "helloworld"
84 , 9`wc` be ["hello", "world"] ==> "hello\nworld"
85 , 6`wc` be ["he", "ll", "o!"] ==> "hello!"
86 , 6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
87 , 5`wc` be ["hello", "world"] ==> "hello\nworld"
88 , 5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
89 , 5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
90 , 4`wc` be ["hello", "world"] ==> "hello\nworld"
91 , 4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
92 , 4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
93 , 4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
94 , 4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
95 , 3`wc` be ["hello", "world"] ==> "hello\nworld"
96 , 3`wc` be ["he", "ll"] ==> "he\nll"
97 , 3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
98 , 1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
99 , 4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n ll\n o!\n wo\n rl\n d!"
100 , 6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n o!wo\n rld!"
101 , 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
102 , 4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n , world\n ]"
103 , 11`wc` bs ["hello", "world"] ==> "hello world"
104 , 10`wc` bs ["hello", "world"] ==> "hello\nworld"
105 , 5`wc` bs ["hello", "world"] ==> "hello\nworld"
106 , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
107 ==> "function(function(\n function(\n function(\n function(\n [ abcdefg\n , abcdefg\n ]\n )\n )\n )\n ))"
108 , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
109 ==> "function(\n function(\n function(\n function(\n function(\n [ abcdefgh\n , abcdefgh\n ]\n )\n )\n )\n )\n )"
113 be :: Doc.Breakable d => [d] -> d
114 be = Doc.foldWith Doc.breakableEmpty
115 bs :: Doc.Breakable d => [d] -> d
116 bs = Doc.foldWith Doc.breakableSpace
117 wc :: Doc.Breakable d => Doc.Column -> d -> d
118 wc = Doc.withBreakable . Just
120 fun :: (Doc.Indentable d, Doc.Breakable d) => d -> d
121 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifBreak (Doc.newline<>x<>Doc.newline) x) <> ")"
123 listHorV :: (Doc.Indentable d, Doc.Breakable d) => [d] -> d
125 listHorV [x] = "["<>x<>"]"
128 (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
129 ("[" <> Doc.intercalate ", " xs <> "]")