symantic-document/test/HUnit.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 {-# LANGUAGE TypeApplications #-}
   3 module HUnit where
   4
   5 import Test.Tasty
   6 import Test.Tasty.HUnit
   7
   8 import Data.Foldable (Foldable(..))
   9 import Data.Function (($), (.))
  10 import Data.Functor ((<$>))
  11 import Data.Int (Int)
  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
  19
  20 import qualified Language.Symantic.Document.Term as Doc
  21 import Language.Symantic.Document.Term ((<+>))
  22
  23 -- * Tests
  24 hunits :: TestTree
  25 hunits = testGroup "HUnit" $
  26  [ hunitsTerm
  27  ]
  28
  29 infix 0 ==>
  30 (==>) :: Doc.Term -> TL.Text -> Assertion
  31 p ==> expected = got @?= expected
  32         where got = Doc.textTerm p
  33
  34 testList :: String -> [Assertion] -> TestTree
  35 testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
  36
  37 testMessage :: TL.Text -> String
  38 testMessage msg =
  39         foldMap esc $ TL.unpack $
  40         if 42 < TL.length msg then excerpt else msg
  41         where
  42         excerpt = TL.take 42 msg <> "…"
  43         esc = \case
  44          '\n' -> "\\n"
  45          c -> [c]
  46
  47 hunitsTerm :: TestTree
  48 hunitsTerm = testGroup "Term"
  49  [ testList "Textable"
  50    [ Doc.newline ==> "\n"
  51    , Doc.stringH "hello" ==> "hello"
  52    , "hello" ==> "hello"
  53    , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
  54    ]
  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"
  81    ]
  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    ,  6`wc` bs ["hel", "lo", "wo", "rld"] ==> "hel lo\nwo rld"
 106    ,  6`wc` bs ["hel", "lo", "wo", "rld", "HEL", "LO", "WO", "RLD"] ==> "hel lo\nwo rld\nHEL LO\nWO RLD"
 107    ,  5`wc` bs ["hello", "world"] ==> "hello\nworld"
 108    , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
 109      ==> "function(function(\n    function(\n      function(\n        function(\n          [ abcdefg\n          , abcdefg\n          ]\n          )\n        )\n      )\n    ))"
 110    , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
 111      ==> "function(\n  function(\n    function(\n      function(\n        function(\n          [ abcdefgh\n          , abcdefgh\n          ]\n          )\n        )\n      )\n    )\n  )"
 112    ]
 113  ]
 114
 115 be :: Doc.Breakable d => [d] -> d
 116 be = Doc.foldWith Doc.breakableEmpty
 117 bs :: Doc.Breakable d => [d] -> d
 118 bs = Doc.foldWith Doc.breakableSpace
 119 wc :: Doc.Breakable d => Doc.Column -> d -> d
 120 wc = Doc.withBreakable . Just
 121
 122 fun :: (Doc.Indentable d, Doc.Breakable d) => d -> d
 123 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifBreak (Doc.newline<>x<>Doc.newline) x) <> ")"
 124
 125 listHorV :: (Doc.Indentable d, Doc.Breakable d) => [d] -> d
 126 listHorV [] = "[]"
 127 listHorV [x] = "["<>x<>"]"
 128 listHorV xs =
 129         Doc.ifBreak
 130          (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
 131          ("[" <> Doc.intercalate ", " xs <> "]")