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.Ord (Ord(..))
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.String (String)
  15 import Text.Show (Show(..))
  16 import qualified Data.List as List
  17 import qualified Data.Text.Lazy as TL
  18
  19 import qualified Language.Symantic.Document.Term as Doc
  20 import Language.Symantic.Document.Term ((<+>))
  21
  22 -- * Tests
  23 hunits :: TestTree
  24 hunits = testGroup "HUnit" $
  25  [ hunitsTerm
  26  ]
  27
  28 infix 0 ==>
  29 (==>) :: Doc.Term -> TL.Text -> Assertion
  30 p ==> expected = got @?= expected
  31         where got = Doc.textTerm p
  32
  33 testList :: String -> [Assertion] -> TestTree
  34 testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
  35
  36 testMessage :: TL.Text -> String
  37 testMessage msg =
  38         foldMap esc $ TL.unpack $
  39         if 42 < TL.length msg then excerpt else msg
  40         where
  41         excerpt = TL.take 42 msg <> "…"
  42         esc = \case
  43          '\n' -> "\\n"
  44          c -> [c]
  45
  46 hunitsTerm :: TestTree
  47 hunitsTerm = testGroup "Term"
  48  [ testList "Textable"
  49    [ Doc.newline ==> "\n"
  50    , Doc.stringH "hello" ==> "hello"
  51    , "hello" ==> "hello"
  52    , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
  53    ]
  54  , testList "Alignable"
  55    [ "hello\nworld" ==> "hello\nworld"
  56    , "  "<> "hello\nworld\n!" ==> "  hello\nworld\n!"
  57    , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n  world\n  !"
  58    , Doc.hang 2 "hello\nworld\n!" ==> "hello\n  world\n  !"
  59    , Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n  world\n  !\nhello\n!"
  60    , "let " <> Doc.align (Doc.catV $
  61                (\(name, typ) -> Doc.fill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
  62                `List.map` [ ("abcdef","Doc")
  63                           , ("abcde","Int -> Doc -> Doc")
  64                           , ("abcdefghi","Doc") ])
  65      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi :: Doc"
  66    , "let " <> Doc.align (Doc.catV $
  67                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> Doc.stringH typ)
  68                `List.map` [ ("abcdef","Doc")
  69                           , ("abcde","Int -> Doc -> Doc")
  70                           , ("abcdefghi","Doc") ])
  71      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi\n           :: Doc"
  72    , "let " <> Doc.align (Doc.catV $
  73                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> typ)
  74                `List.map` [("abcdefghi","Doc ->\nDoc")])
  75      ==> "let abcdefghi\n           :: Doc ->\n    Doc"
  76    , "let " <> Doc.align (Doc.catV $
  77                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> Doc.align (" ::" <+> typ))
  78                `List.map` [("abcdefghi","Doc ->\nDoc")])
  79      ==> "let abcdefghi\n           :: Doc ->\n          Doc"
  80    ]
  81  , testList "Wrapable"
  82    [ 10`wc` be ["hello", "world"] ==> "helloworld"
  83    ,  9`wc` be ["hello", "world"] ==> "hello\nworld"
  84    ,  6`wc` be ["he", "ll", "o!"] ==> "hello!"
  85    ,  6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
  86    ,  5`wc` be ["hello", "world"] ==> "hello\nworld"
  87    ,  5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
  88    ,  5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
  89    ,  4`wc` be ["hello", "world"] ==> "hello\nworld"
  90    ,  4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
  91    ,  4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
  92    ,  4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
  93    ,  4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
  94    ,  3`wc` be ["hello", "world"] ==> "hello\nworld"
  95    ,  3`wc` be ["he", "ll"] ==> "he\nll"
  96    ,  3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
  97    ,  1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
  98    ,  4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n  ll\n  o!\n  wo\n  rl\n  d!"
  99    ,  6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n  o!wo\n  rld!"
 100    , 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
 101    ,  4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n  , world\n  ]"
 102    , 11`wc` bs ["hello", "world"] ==> "hello world"
 103    , 10`wc` bs ["hello", "world"] ==> "hello\nworld"
 104    ,  5`wc` bs ["hello", "world"] ==> "hello\nworld"
 105    , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
 106      ==> "function(function(\n    function(\n      function(\n        function(\n          [ abcdefg\n          , abcdefg\n          ]\n          )\n        )\n      )\n    ))"
 107    , 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
 108      ==> "function(\n  function(\n    function(\n      function(\n        function(\n          [ abcdefgh\n          , abcdefgh\n          ]\n          )\n        )\n      )\n    )\n  )"
 109    ]
 110  ]
 111
 112 be :: Doc.Wrapable d => [d] -> d
 113 be = Doc.foldWith Doc.breakableEmpty
 114 bs :: Doc.Wrapable d => [d] -> d
 115 bs = Doc.foldWith Doc.breakableSpace
 116 wc :: Doc.Wrapable d => Doc.Column -> d -> d
 117 wc = Doc.withWrapColumn
 118
 119 fun :: (Doc.Alignable d, Doc.Wrapable d) => d -> d
 120 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifWrap (Doc.newline<>x<>Doc.newline) x) <> ")"
 121
 122 listHorV :: (Doc.Alignable d, Doc.Wrapable d) => [d] -> d
 123 listHorV [] = "[]"
 124 listHorV [x] = "["<>x<>"]"
 125 listHorV xs =
 126         Doc.ifWrap
 127          (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
 128          ("[" <> Doc.intercalate ", " xs <> "]")