{-# 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.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 Language.Symantic.Document.Term ((<+>))

-- * Tests
hunits :: TestTree
hunits = testGroup "HUnit" $
 [ hunitsTerm
 ]

infix 0 ==>
(==>) :: Doc.Term -> TL.Text -> Assertion
p ==> expected = got @?= expected
	where got = Doc.textTerm p

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"
   ,  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  )"
   ]
 ]

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