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