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.Ord (Ord(..))
13 import Data.Semigroup (Semigroup(..))
14 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 "Doc_Align"
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"
79 [ 10`wc` be ["hello", "world"] ==> "helloworld"
80 , 9`wc` be ["hello", "world"] ==> "hello\nworld"
81 , 6`wc` be ["he", "ll", "o!"] ==> "hello!"
82 , 6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
83 , 5`wc` be ["hello", "world"] ==> "hello\nworld"
84 , 5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
85 , 5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
86 , 4`wc` be ["hello", "world"] ==> "hello\nworld"
87 , 4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
88 , 4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
89 , 4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
90 , 4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
91 , 3`wc` be ["hello", "world"] ==> "hello\nworld"
92 , 3`wc` be ["he", "ll"] ==> "he\nll"
93 , 3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
94 , 1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
95 , 4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n ll\n o!\n wo\n rl\n d!"
96 , 6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n o!wo\n rld!"
97 , 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
98 , 4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n , world\n ]"
99 , 11`wc` bs ["hello", "world"] ==> "hello world"
100 , 10`wc` bs ["hello", "world"] ==> "hello\nworld"
101 , 5`wc` bs ["hello", "world"] ==> "hello\nworld"
102 , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
103 ==> "function(function(\n function(\n function(\n function(\n [ abcdefg\n , abcdefg\n ]\n )\n )\n )\n ))"
104 , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
105 ==> "function(\n function(\n function(\n function(\n function(\n [ abcdefgh\n , abcdefgh\n ]\n )\n )\n )\n )\n )"
109 be :: Doc.Doc_Wrap d => [d] -> d
110 be = Doc.foldWith Doc.breakableEmpty
111 bs :: Doc.Doc_Wrap d => [d] -> d
112 bs = Doc.foldWith Doc.breakableSpace
113 wc :: Doc.Doc_Wrap d => Doc.Column d -> d -> d
114 wc = Doc.withWrapColumn
116 fun :: (Doc.Doc_Align d, Doc.Doc_Wrap d, Num (Doc.Indent d)) => d -> d
117 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifFit (x) (Doc.newline<>x<>Doc.newline)) <> ")"
119 listHorV :: (Doc.Doc_Align d, Doc.Doc_Wrap d) => [d] -> d
121 listHorV [x] = "["<>x<>"]"
124 ("[" <> Doc.intercalate ", " xs <> "]")
125 (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")