{-# LANGUAGE TemplateHaskell #-}
module Main where

import Data.Generics.Is
import Language.Haskell.TH
import Control.Applicative
import Control.Monad
import System.Exit

assertEq :: String -> Bool -> Bool -> IO ()                                    
assertEq _ a b | a == b = return ()                                               
assertEq a_str a b = do                                                               
  putStrLn $ a_str ++ " /=\n" ++ show b                                        
  exitFailure                                                                   

main :: IO ()
main = $(
  let
    -- Test cases: pattern, expression, pattern matches expression
    testCasesPat :: [(Q Pat, Q Exp, Bool)]
    testCasesPat = 
        [ ([p| Just _ |]  , [e| Just "a" |] , True)
        , ([p| [_,_,_] |] , [e| [1,2,3] |] , True)
        , ([p| [_,_] |] , [e| [1,2,3] |] , False)
        , ([p| Left{} |] , [e| Left 3 |] , True)
        ]

    -- Test cases: pattern, expression, constructor matches expression
    testCasesName :: [(Name, Q Exp, Bool)]
    testCasesName =
        [ ('Just , [e| Just 'b' |] , True)
        , ('(:) , [e| [] |] , False)
        , ('[]  , [e| [] |] , True)
        , ('(:) , [e| [1,2,3] |] , True)
        , ('(,,,) , [e| (1,2,3,4) |] , True)
        ]
    
    -- Utility functions
    assertEqTH :: Bool -> Exp -> Exp -> Exp -> Exp
    assertEqTH b e_yes e_no e = 
      assertEqExpr (AppE e_yes e) b `andThen` assertEqExpr (AppE e_no e) (not b)

    boolExp :: Bool -> Exp
    boolExp b = if b then ConE 'True else ConE 'False

    andThen :: Exp -> Exp -> Exp
    x `andThen` y = AppE (AppE (VarE '(>>)) x) y

    assertEqExpr :: Exp -> Bool -> Exp
    assertEqExpr e b = AppE (AppE (AppE (VarE 'assertEq) (LitE (StringL (pprint e)))) e) (boolExp b)
  in do
    es1 <- forM testCasesPat $ \(p, e, b) ->
      assertEqTH b <$> isP p <*> isNotP p <*> e

    es2 <- forM testCasesName $ \(n, e, b) ->
      assertEqTH b <$> is n <*> isNot n <*> e

    return $ foldl1 andThen $ es1 ++ es2

  )