module Main where

import qualified Bril as B
import qualified Bril.CFG as BCFG
import Data.Aeson (eitherDecode, decode, encode, toJSON, parseJSON, Result(..))
import Data.Aeson.Types (parse)
import Data.Text
import Data.Maybe
import Data.Either
import Data.Function ((&))
import Control.Exception (try)

import Test.HUnit
import qualified Test.QuickCheck as QC
import qualified System.Exit as Exit
 
testTypes :: Test
testTypes = TestCase $ do
    assertEqual "int type" (decode "\"int\"" :: Maybe B.Type) (Just B.Int)
    assertEqual "bool type" (decode "\"bool\"" :: Maybe B.Type) (Just B.Bool)

testLiterals :: Test
testLiterals = TestCase $ do
    assertEqual "true literal"
        (parseLiteral B.Bool True) (Success $ B.BoolValue True)
    assertEqual "false literal"
        (parseLiteral B.Bool False) (Success $ B.BoolValue False)

    assertEqual "int literal"
        (parseLiteral B.Int (1434 :: Int)) (Success $ B.IntValue 1434)
    assertEqual "wrong int literal"
        (parseLiteral B.Int (100000000000000000000 :: Integer))
        (Error "Integer exceeds int64: 1.0e20")
    assertEqual "wrong int literal"
        (parseLiteral B.Int (123.5 :: Double)) (Error "Invalid integer literal: 123.5")

    where
        parseLiteral type_ x = (parse (B.parseValue type_) (toJSON x))

testInstrs :: Test
testInstrs = TestCase $ do
    assertEqual "add instr"
        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
        (Right $ B.ValueInstr B.Add B.Int "x" ["a", "b"] [] [])

    assertEqual "sub instr"
        (decode "{\"op\": \"sub\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
        (Just $ B.ValueInstr B.Sub B.Int "x" ["a", "b"] [] [])

    assertEqual "wrong instr"
        (eitherDecode "{\"op\": \"wrnog\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"]}")
        (Left "Error in $: Invalid op: wrnog" :: Either String B.Instruction)

    assertEqual "wrong arity"
        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"b\"]}")
        (Left "Error in $: wrong arity for add: got 1, 0" :: Either String B.Instruction)

    assertEqual "wrong label arity"
        (eitherDecode "{\"op\": \"add\", \"type\": \"int\", \"dest\": \"x\", \"args\": [\"a\", \"b\"], \"labels\": [\"a\"]}")
        (Left "Error in $: wrong arity for add: got 2, 1" :: Either String B.Instruction)

    assertEqual "parse effect call"
        (eitherDecode "{\"op\": \"call\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
        (Right $ B.EffectInstr B.Call ["a", "b"] ["a"] [])

    assertEqual "parse value call"
        (eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": [\"a\"]}")
        (Right $ B.ValueInstr B.Call B.Bool "z" ["a", "b"] ["a"] [])

    assertEqual "parse invalid call"
        (eitherDecode "{\"op\": \"call\", \"type\": \"bool\", \"dest\": \"z\", \"args\": [\"a\", \"b\"], \"funcs\": []}")
        (Left "Error in $: call op must have exactly one entry in \"funcs\"" :: Either String B.Instruction)

    assertEqual "parse jmp"
        (eitherDecode "{\"op\": \"jmp\", \"labels\": [\"a\"]}")
        (Right $ B.EffectInstr B.Jmp [] [] ["a"])

    assertEqual "parse br"
        (eitherDecode "{\"op\": \"br\", \"labels\": [\"a\", \"b\"], \"args\": [\"z\"]}")
        (Right $ B.EffectInstr B.Br ["z"] [] ["a", "b"])

    assertEqual "parse id"
        (eitherDecode "{\"op\": \"id\", \"dest\": \"a\", \"type\": \"bool\", \"args\": [\"b\"]}")
        (Right $ B.ValueInstr B.Id B.Bool "a" ["b"] [] [])

    assertEqual "parse label"
        (eitherDecode "{\"label\": \"test\"}")
        (Right $ B.Label "test")

testProgramFromFiles :: Test
testProgramFromFiles = TestCase $ do
    res <- try $ (B.parseBrilFromPath "bril-sources/add.json") :: IO (Either IOError (Either String B.Program))
    case res of
        (Right parseResult) -> assertBool "parse add.json" $ isRight parseResult
        _ -> assertFailure "cannot open file"

prop_InvariantBrilSerialization :: B.Program -> Bool
prop_InvariantBrilSerialization program =
    (decode (encode program)) == (Just program)


tests :: Test
tests = TestList [
        TestLabel "bril parser: type" testTypes,
        TestLabel "bril parser: literal" testLiterals,
        TestLabel "bril parser: instruction" testInstrs,
        TestLabel "bril parser: parse files" testProgramFromFiles
    ]
 
main :: IO ()
main = do
    result <- runTestTT tests

    -- QC.quickCheck prop_InvariantBrilSerialization
    if failures result > 0 then Exit.exitFailure else Exit.exitSuccess