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    , "let " <> Doc.align (Doc.catV $
  77                (\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) $ " ::" <+> typ)
  78                `List.map` [("abcdefghi","Doc ->\nDoc")])
  79      ==> "let abcdefghi\n           :: Doc ->\n          Doc"
  80    ]
  81  , testList "Doc_Wrap"
  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.Doc_Wrap d => [d] -> d
 113 be = Doc.foldWith Doc.breakableEmpty
 114 bs :: Doc.Doc_Wrap d => [d] -> d
 115 bs = Doc.foldWith Doc.breakableSpace
 116 wc :: Doc.Doc_Wrap d => Doc.Column d -> d -> d
 117 wc = Doc.withWrapColumn
 118
 119 fun :: (Doc.Doc_Align d, Doc.Doc_Wrap d, Num (Doc.Indent d)) => d -> d
 120 fun x = "function(" <> Doc.incrIndent 2 (Doc.ifFit (x) (Doc.newline<>x<>Doc.newline)) <> ")"
 121
 122 listHorV :: (Doc.Doc_Align d, Doc.Doc_Wrap d) => [d] -> d
 123 listHorV [] = "[]"
 124 listHorV [x] = "["<>x<>"]"
 125 listHorV xs =
 126         Doc.ifFit
 127          ("[" <> Doc.intercalate ", " xs <> "]")
 128          (Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")