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