{-# 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 <> "]")