{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Trans.Bool.Const.Test where

import Data.Function (($))
import qualified Data.Text.Lazy as Text
import Data.Text.Lazy.Builder as Build
import Test.Tasty
import Test.Tasty.HUnit

import qualified Expr.Bool.Test as Bool
import qualified Repr.Text.Write.Test ()
import Hcompta.Repr
import Hcompta.Trans

tests :: TestTree
tests = testGroup "Const" $
	let (==>) expr expected =
		testCase (Text.unpack expected) $
		Build.toLazyText (repr_text_write $ trans_bool_const expr) @?=
		expected
	 in
 [ Bool.e1 ==> "False"
 , Bool.e2 ==> "True"
 , Bool.e3 ==> "True"
 , Bool.e4 ==> "True"
 , Bool.e5 ==> "!x"
 , Bool.e6 ==> "(x | y) & !(x & y)"
 , Bool.e7 ==> "((x | y) & !(x & y) | z) & !(((x | y) & !(x & y)) & z)"
 , Bool.e8 ==> "(x | !y) & !(x & !y)"
 ]