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.Monoid (Monoid(..))
  14 import Data.Ord (Ord(..))
  15 import Data.Semigroup (Semigroup(..))
  16 import Data.String (String)
  17 import Text.Show (Show(..))
  18 import qualified Data.List as List
  19 import qualified Data.Text.Lazy as TL
  20
  21 import qualified Language.Symantic.Document.Term as Doc
  22 import qualified Language.Symantic.Document.Term.Dimension as Dim
  23 import Language.Symantic.Document.Term ((<+>))
  24
  25 -- * Tests
  26 hunits :: TestTree
  27 hunits = testGroup "HUnit" $
  28  [ hunitsTerm
  29  , hunitsTermDimension
  30  ]
  31
  32 testList :: String -> [Assertion] -> TestTree
  33 testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
  34
  35 testMessage :: TL.Text -> String
  36 testMessage msg =
  37         foldMap esc $ TL.unpack $
  38         if 42 < TL.length msg then excerpt else msg
  39         where
  40         excerpt = TL.take 42 msg <> "…"
  41         esc = \case
  42          '\n' -> "\\n"
  43          c -> [c]
  44
  45 hunitsTerm :: TestTree
  46 hunitsTerm = testGroup "Term"
  47  [ testList "Textable"
  48    [ Doc.newline ==> "\n"
  49    , Doc.stringH "hello" ==> "hello"
  50    , "hello" ==> "hello"
  51    , Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
  52    ]
  53  , testList "Indentable"
  54    [ "hello\nworld" ==> "hello\nworld"
  55    , "  "<> "hello\nworld\n!" ==> "  hello\nworld\n!"
  56    , "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n  world\n  !"
  57    , Doc.hang 2 "hello\nworld\n!" ==> "hello\n  world\n  !"
  58    , Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n  world\n  !\nhello\n!"
  59    , "let " <> Doc.align (Doc.catV $
  60                (\(name, typ) -> Doc.fill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
  61                `List.map` [ ("abcdef","Doc")
  62                           , ("abcde","Int -> Doc -> Doc")
  63                           , ("abcdefghi","Doc") ])
  64      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi :: Doc"
  65    , "let " <> Doc.align (Doc.catV $
  66                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> Doc.stringH typ)
  67                `List.map` [ ("abcdef","Doc")
  68                           , ("abcde","Int -> Doc -> Doc")
  69                           , ("abcdefghi","Doc") ])
  70      ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi\n           :: Doc"
  71    , "let " <> Doc.align (Doc.catV $
  72                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> typ)
  73                `List.map` [("abcdefghi","Doc ->\nDoc")])
  74      ==> "let abcdefghi\n           :: Doc ->\n    Doc"
  75    , "let " <> Doc.align (Doc.catV $
  76                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> Doc.align (" ::" <+> typ))
  77                `List.map` [("abcdefghi","Doc ->\nDoc")])
  78      ==> "let abcdefghi\n           :: Doc ->\n          Doc"
  79    ]
  80  , testList "Breakable"
  81    [ 10`wc` be ["hello", "world"] ==> "helloworld"
  82    ,  9`wc` be ["hello", "world"] ==> "hello\nworld"
  83    ,  6`wc` be ["he", "ll", "o!"] ==> "hello!"
  84    ,  6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
  85    ,  5`wc` be ["hello", "world"] ==> "hello\nworld"
  86    ,  5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
  87    ,  5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
  88    ,  4`wc` be ["hello", "world"] ==> "hello\nworld"
  89    ,  4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
  90    ,  4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
  91    ,  4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
  92    ,  4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
  93    ,  3`wc` be ["hello", "world"] ==> "hello\nworld"
  94    ,  3`wc` be ["he", "ll"] ==> "he\nll"
  95    ,  3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
  96    ,  1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
  97    ,  4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n  ll\n  o!\n  wo\n  rl\n  d!"
  98    ,  6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n  o!wo\n  rld!"
  99    , 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
 100    ,  4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n  , world\n  ]"
 101    , 11`wc` bs ["hello", "world"] ==> "hello world"
 102    , 10`wc` bs ["hello", "world"] ==> "hello\nworld"
 103    ,  6`wc` bs ["hel", "lo", "wo", "rld"] ==> "hel lo\nwo rld"
 104    ,  6`wc` bs ["hel", "lo", "wo", "rld", "HEL", "LO", "WO", "RLD"] ==> "hel lo\nwo rld\nHEL LO\nWO RLD"
 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  )"
 110    ]
 111  ]
 112         where
 113         (==>) :: Doc.Term -> TL.Text -> Assertion; infix 0 ==>
 114         p ==> expected = got @?= expected
 115                 where got = Doc.textTerm p
 116
 117 hunitsTermDimension :: TestTree
 118 hunitsTermDimension = testGroup "Term.Dimension"
 119  [ testList "Textable"
 120    [ Doc.newline ==> mempty
 121        {   Dim.dim_width       = 0
 122        ,   Dim.dim_height      = 1
 123        ,   Dim.dim_width_first = 0
 124        ,   Dim.dim_width_last  = 0
 125        }
 126    , Doc.newline <> Doc.newline ==> mempty
 127        { Dim.dim_height        = 2
 128        }
 129    , Doc.space ==> Dim.Dim 1 0 1 1
 130    , Doc.newline <> Doc.space ==> mempty
 131        {   Dim.dim_width       = 1
 132        ,   Dim.dim_height      = 1
 133        ,   Dim.dim_width_first = 0
 134        ,   Dim.dim_width_last  = 1
 135        }
 136    , Doc.stringH "hello" ==> mempty
 137        {   Dim.dim_width       = 5
 138        ,   Dim.dim_height      = 0
 139        ,   Dim.dim_width_first = 5
 140        ,   Dim.dim_width_last  = 5
 141        }
 142    , "hello" ==> mempty
 143        {   Dim.dim_width       = 5
 144        ,   Dim.dim_height      = 0
 145        ,   Dim.dim_width_first = 5
 146        ,   Dim.dim_width_last  = 5
 147        }
 148    , Doc.newline <> "hello" ==> mempty
 149        {   Dim.dim_width       = 5
 150        ,   Dim.dim_height      = 1
 151        ,   Dim.dim_width_first = 0
 152        ,   Dim.dim_width_last  = 5
 153        }
 154    , "hel" <> Doc.newline ==> mempty
 155        {   Dim.dim_width       = 3
 156        ,   Dim.dim_height      = 1
 157        ,   Dim.dim_width_first = 3
 158        ,   Dim.dim_width_last  = 0
 159        }
 160    , ("hel" <> Doc.newline) <> "lo" ==> mempty
 161        {   Dim.dim_width       = 3
 162        ,   Dim.dim_height      = 1
 163        ,   Dim.dim_width_first = 3
 164        ,   Dim.dim_width_last  = 2
 165        }
 166    , Doc.catV @_ @[] ["hello", "world"] ==> mempty
 167        {   Dim.dim_width       = 5
 168        ,   Dim.dim_height      = 1
 169        ,   Dim.dim_width_first = 5
 170        ,   Dim.dim_width_last  = 5
 171        }
 172    , "hel\nlo" <> Doc.empty ==> Dim.Dim 3 1 3 2
 173    , "hel\nlo " ==> Dim.Dim 3 1 3 3
 174    , "lo" ==> Dim.Dim 2 0 2 2
 175    , Doc.charH 'X' ==> Dim.Dim 1 0 1 1
 176    , "lo"<>Doc.charH 'X' ==> Dim.Dim 3 0 3 3
 177    , "lo"<>Doc.charH ' ' ==> Dim.Dim 3 0 3 3
 178    , "lo"<>Doc.space ==> Dim.Dim 3 0 3 3
 179    , (Doc.newline<>"lo")<>Doc.space ==> Dim.Dim 3 1 0 3
 180    , (("hel"<>Doc.newline)<>"lo")<>Doc.space ==> Dim.Dim 3 1 3 3
 181    , "hel\nlo" <> Doc.space ==> Dim.Dim 3 1 3 3
 182    , (Dim.Dim 2 0 2 2 <> Dim.Dim 1 0 1 1) @?= Dim.Dim 3 0 3 3
 183    ]
 184  ]
 185         where
 186         (==>) :: Dim.Dimension -> Dim.Dim -> Assertion; infix 0 ==>
 187         p ==> expected = got @?= expected
 188                 where got = Dim.dim p
 189
 190 be :: Doc.Breakable d => [d] -> d
 191 be = Doc.foldWith Doc.breakableEmpty
 192 bs :: Doc.Breakable d => [d] -> d
 193 bs = Doc.foldWith Doc.breakableSpace
 194 wc :: Doc.Breakable d => Doc.Column -> d -> d
 195 wc = Doc.withBreakable . Just
 196
 197 fun :: (Doc.Indentable d, Doc.Breakable d) => d -> d
 198 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifBreak (Doc.newline<>x<>Doc.newline) x) <> ")"
 199
 200 listHorV :: (Doc.Indentable d, Doc.Breakable d) => [d] -> d
 201 listHorV [] = "[]"
 202 listHorV [x] = "["<>x<>"]"
 203 listHorV xs =
 204         Doc.ifBreak
 205          (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
 206          ("[" <> Doc.intercalate ", " xs <> "]")