{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}
module HUnit where
import Test.Tasty
import Test.Tasty.HUnit
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Data.Text.Lazy as TL
import qualified Language.Symantic.Document.Term as Doc
import qualified Language.Symantic.Document.Term.Dimension as Dim
import Language.Symantic.Document.Term ((<+>))
-- * Tests
hunits :: TestTree
hunits = testGroup "HUnit" $
[ hunitsTerm
, hunitsTermDimension
]
testList :: String -> [Assertion] -> TestTree
testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as
testMessage :: TL.Text -> String
testMessage msg =
foldMap esc $ TL.unpack $
if 42 < TL.length msg then excerpt else msg
where
excerpt = TL.take 42 msg <> "…"
esc = \case
'\n' -> "\\n"
c -> [c]
hunitsTerm :: TestTree
hunitsTerm = testGroup "Term"
[ testList "Textable"
[ Doc.newline ==> "\n"
, Doc.stringH "hello" ==> "hello"
, "hello" ==> "hello"
, Doc.catV @_ @[] ["hello", "world"] ==> "hello\nworld"
]
, testList "Indentable"
[ "hello\nworld" ==> "hello\nworld"
, " "<> "hello\nworld\n!" ==> " hello\nworld\n!"
, "__"<>Doc.align "hello\nworld\n!" ==> "__hello\n world\n !"
, Doc.hang 2 "hello\nworld\n!" ==> "hello\n world\n !"
, Doc.hang 2 "hello\nworld\n!"<>"\nhello\n!" ==> "hello\n world\n !\nhello\n!"
, "let " <> Doc.align (Doc.catV $
(\(name, typ) -> Doc.fill 6 (Doc.stringH name) <+> "::" <+> Doc.stringH typ)
`List.map` [ ("abcdef","Doc")
, ("abcde","Int -> Doc -> Doc")
, ("abcdefghi","Doc") ])
==> "let abcdef :: Doc\n abcde :: Int -> Doc -> Doc\n abcdefghi :: Doc"
, "let " <> Doc.align (Doc.catV $
(\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> Doc.stringH typ)
`List.map` [ ("abcdef","Doc")
, ("abcde","Int -> Doc -> Doc")
, ("abcdefghi","Doc") ])
==> "let abcdef :: Doc\n abcde :: Int -> Doc -> Doc\n abcdefghi\n :: Doc"
, "let " <> Doc.align (Doc.catV $
(\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> " ::" <+> typ)
`List.map` [("abcdefghi","Doc ->\nDoc")])
==> "let abcdefghi\n :: Doc ->\n Doc"
, "let " <> Doc.align (Doc.catV $
(\(name, typ) -> Doc.breakableFill 6 (Doc.stringH name) <> Doc.align (" ::" <+> typ))
`List.map` [("abcdefghi","Doc ->\nDoc")])
==> "let abcdefghi\n :: Doc ->\n Doc"
]
, testList "Breakable"
[ 10`wc` be ["hello", "world"] ==> "helloworld"
, 9`wc` be ["hello", "world"] ==> "hello\nworld"
, 6`wc` be ["he", "ll", "o!"] ==> "hello!"
, 6`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hello!\nworld!"
, 5`wc` be ["hello", "world"] ==> "hello\nworld"
, 5`wc` be ["he", "llo", "world"] ==> "hello\nworld"
, 5`wc` be ["he", "ll", "o!"] ==> "hell\no!"
, 4`wc` be ["hello", "world"] ==> "hello\nworld"
, 4`wc` be ["he", "ll", "o!"] ==> "hell\no!"
, 4`wc` be ["he", "llo", "world"] ==> "he\nllo\nworld"
, 4`wc` be ["he", "llo", "w", "orld"] ==> "he\nllow\norld"
, 4`wc` be ["he", "ll", "o!", "wo", "rl", "d!"] ==> "hell\no!wo\nrld!"
, 3`wc` be ["hello", "world"] ==> "hello\nworld"
, 3`wc` be ["he", "ll"] ==> "he\nll"
, 3`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
, 1`wc` be ["he", "ll", "o!"] ==> "he\nll\no!"
, 4`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__he\n ll\n o!\n wo\n rl\n d!"
, 6`wc` ["__", Doc.align $ be ["he", "ll", "o!", "wo", "rl", "d!"]] ==> "__hell\n o!wo\n rld!"
, 16`wc` ["__", listHorV ["hello", "world"]] ==> "__[hello, world]"
, 4`wc` ["__", listHorV ["hello", "world"]] ==> "__[ hello\n , world\n ]"
, 11`wc` bs ["hello", "world"] ==> "hello world"
, 10`wc` bs ["hello", "world"] ==> "hello\nworld"
, 6`wc` bs ["hel", "lo", "wo", "rld"] ==> "hel lo\nwo rld"
, 6`wc` bs ["hel", "lo", "wo", "rld", "HEL", "LO", "WO", "RLD"] ==> "hel lo\nwo rld\nHEL LO\nWO RLD"
, 5`wc` bs ["hello", "world"] ==> "hello\nworld"
, 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefg", "abcdefg"])
==> "function(function(\n function(\n function(\n function(\n [ abcdefg\n , abcdefg\n ]\n )\n )\n )\n ))"
, 19`wc` fun (fun $ fun $ fun $ fun $ listHorV ["abcdefgh", "abcdefgh"])
==> "function(\n function(\n function(\n function(\n function(\n [ abcdefgh\n , abcdefgh\n ]\n )\n )\n )\n )\n )"
]
]
where
(==>) :: Doc.Term -> TL.Text -> Assertion; infix 0 ==>
p ==> expected = got @?= expected
where got = Doc.textTerm p
hunitsTermDimension :: TestTree
hunitsTermDimension = testGroup "Term.Dimension"
[ testList "Textable"
[ Doc.newline ==> mempty
{ Dim.dim_width = 0
, Dim.dim_height = 1
, Dim.dim_width_first = 0
, Dim.dim_width_last = 0
}
, Doc.newline <> Doc.newline ==> mempty
{ Dim.dim_height = 2
}
, Doc.space ==> Dim.Dim 1 0 1 1
, Doc.newline <> Doc.space ==> mempty
{ Dim.dim_width = 1
, Dim.dim_height = 1
, Dim.dim_width_first = 0
, Dim.dim_width_last = 1
}
, Doc.stringH "hello" ==> mempty
{ Dim.dim_width = 5
, Dim.dim_height = 0
, Dim.dim_width_first = 5
, Dim.dim_width_last = 5
}
, "hello" ==> mempty
{ Dim.dim_width = 5
, Dim.dim_height = 0
, Dim.dim_width_first = 5
, Dim.dim_width_last = 5
}
, Doc.newline <> "hello" ==> mempty
{ Dim.dim_width = 5
, Dim.dim_height = 1
, Dim.dim_width_first = 0
, Dim.dim_width_last = 5
}
, "hel" <> Doc.newline ==> mempty
{ Dim.dim_width = 3
, Dim.dim_height = 1
, Dim.dim_width_first = 3
, Dim.dim_width_last = 0
}
, ("hel" <> Doc.newline) <> "lo" ==> mempty
{ Dim.dim_width = 3
, Dim.dim_height = 1
, Dim.dim_width_first = 3
, Dim.dim_width_last = 2
}
, Doc.catV @_ @[] ["hello", "world"] ==> mempty
{ Dim.dim_width = 5
, Dim.dim_height = 1
, Dim.dim_width_first = 5
, Dim.dim_width_last = 5
}
, "hel\nlo" <> Doc.empty ==> Dim.Dim 3 1 3 2
, "hel\nlo " ==> Dim.Dim 3 1 3 3
, "lo" ==> Dim.Dim 2 0 2 2
, Doc.charH 'X' ==> Dim.Dim 1 0 1 1
, "lo"<>Doc.charH 'X' ==> Dim.Dim 3 0 3 3
, "lo"<>Doc.charH ' ' ==> Dim.Dim 3 0 3 3
, "lo"<>Doc.space ==> Dim.Dim 3 0 3 3
, (Doc.newline<>"lo")<>Doc.space ==> Dim.Dim 3 1 0 3
, (("hel"<>Doc.newline)<>"lo")<>Doc.space ==> Dim.Dim 3 1 3 3
, "hel\nlo" <> Doc.space ==> Dim.Dim 3 1 3 3
, (Dim.Dim 2 0 2 2 <> Dim.Dim 1 0 1 1) @?= Dim.Dim 3 0 3 3
]
]
where
(==>) :: Dim.Dimension -> Dim.Dim -> Assertion; infix 0 ==>
p ==> expected = got @?= expected
where got = Dim.dim p
be :: Doc.Breakable d => [d] -> d
be = Doc.foldWith Doc.breakableEmpty
bs :: Doc.Breakable d => [d] -> d
bs = Doc.foldWith Doc.breakableSpace
wc :: Doc.Breakable d => Doc.Column -> d -> d
wc = Doc.withBreakable . Just
fun :: (Doc.Indentable d, Doc.Breakable d) => d -> d
fun x = "function(" <> Doc.incrIndent 2 (Doc.ifBreak (Doc.newline<>x<>Doc.newline) x) <> ")"
listHorV :: (Doc.Indentable d, Doc.Breakable d) => [d] -> d
listHorV [] = "[]"
listHorV [x] = "["<>x<>"]"
listHorV xs =
Doc.ifBreak
(Doc.align $ "[ " <> foldr1 (\a acc -> a <> Doc.newline <> ", " <> acc) xs <> Doc.newline <> "]")
("[" <> Doc.intercalate ", " xs <> "]")