import Test.HUnit
import Graphics.Gloss.Data.Color
import Graphics.Gloss.Data.Picture
import Graphics.Gloss.Interface.Pure.Game

import Scratchy.Syntax

-- Test Pure
testPure :: Test
testPure = TestCase $ do
    let p = Pure ()
    case p of
        Pure () -> return ()
        _ -> assertFailure "Pure should construct correctly"

-- Test SetBackgroundColor construction
testSetBackgroundColorConstruct :: Test
testSetBackgroundColorConstruct = TestCase $ do
    let p = SetBackgroundColor red (Pure ())
    case p of
        SetBackgroundColor c _ -> 
            assertEqual "Color should be red" c red
        _ -> assertFailure "SetBackgroundColor should construct correctly"

-- Test combine SetBackgroundColor
testCombineSetBackgroundColor :: Test
testCombineSetBackgroundColor = TestCase $ do
    let p1 = SetBackgroundColor red (Pure ())
        p2 = SetBackgroundColor blue (Pure ())
        combined = combine p1 p2
    case combined of
        SetBackgroundColor c (SetBackgroundColor _ (Pure ())) -> 
            assertEqual "First color should be red" c red
        _ -> assertFailure "combine should nest SetBackgroundColor correctly"

-- Test NewSprite construction
testNewSpriteConstruct :: Test
testNewSpriteConstruct = TestCase $ do
    let p = NewSprite (5, 5) (circleSolid 10) (\_ -> Pure ())
    case p of
        NewSprite cell _ _ -> do
            assertEqual "Cell should be (5, 5)" cell (5, 5)
        _ -> assertFailure "NewSprite should construct correctly"

-- Test OnKeyEvent construction
testOnKeyEventConstruct :: Test
testOnKeyEventConstruct = TestCase $ do
    let p = OnKeyEvent (SpecialKey KeyDown) (Pure ()) (Pure ())
    case p of
        OnKeyEvent key _ _ -> 
            assertEqual "Key should be KeyDown" key (SpecialKey KeyDown)
        _ -> assertFailure "OnKeyEvent should construct correctly"

-- Test OnTargetReached construction
testOnTargetReachedConstruct :: Test
testOnTargetReachedConstruct = TestCase $ do
    let p = OnTargetReached 0 (\_ -> Pure ()) (Pure ())
    case p of
        OnTargetReached ptr _ _ -> 
            assertEqual "Sprite pointer should be 0" ptr 0
        _ -> assertFailure "OnTargetReached should construct correctly"

-- Test After (timer) construction
testAfterConstruct :: Test
testAfterConstruct = TestCase $ do
    let p = After 10 (Pure ()) (Pure ())
    case p of
        After dur _ _ -> 
            assertEqual "Duration should be 10" dur 10
        _ -> assertFailure "After should construct correctly"

-- Test InspectCell construction
testInspectCellConstruct :: Test
testInspectCellConstruct = TestCase $ do
    let p = InspectCell (0, 0) (\case
                              IsFree -> Pure ()
                              _ -> Pure ())
    case p of
        InspectCell cell _ -> 
            assertEqual "Cell should be (0, 0)" cell (0, 0)
        _ -> assertFailure "InspectCell should construct correctly"

-- Test combine nesting
testCombineNesting :: Test
testCombineNesting = TestCase $ do
    let p1 = SetBackgroundColor red (Pure ())
        p2 = SetBackgroundColor blue (Pure ())
        p3 = SetBackgroundColor green (Pure ())
        combined = combine p1 (combine p2 p3)
    case combined of
        SetBackgroundColor _ _ -> return ()
        _ -> assertFailure "combine should nest correctly"

-- Test dirVec
testDirVec :: Test
testDirVec = TestCase $ do
    assertEqual "dirVec U" (dirVec U) (0, 1)
    assertEqual "dirVec D" (dirVec D) (0, -1)
    assertEqual "dirVec L" (dirVec L) (-1, 0)
    assertEqual "dirVec R" (dirVec R) (1, 0)

-- Test nextCell
testNextCell :: Test
testNextCell = TestCase $ do
    assertEqual "nextCell U (0,0)" (nextCell U (0, 0)) (0, 1)
    assertEqual "nextCell D (5,5)" (nextCell D (5, 5)) (5, 4)
    assertEqual "nextCell L (3,3)" (nextCell L (3, 3)) (2, 3)
    assertEqual "nextCell R (2,2)" (nextCell R (2, 2)) (3, 2)

-- Test inBounds
testInBounds :: Test
testInBounds = TestCase $ do
    assertBool "Center should be in bounds" (inBounds (15, 15))
    assertBool "(0, 0) should be in bounds" (inBounds (0, 0))
    assertBool "(29, 29) should be in bounds" (inBounds (29, 29))
    assertBool "(-1, 0) should be out of bounds" (not (inBounds (-1, 0)))
    assertBool "(30, 15) should be out of bounds" (not (inBounds (30, 15)))
    assertBool "(15, -1) should be out of bounds" (not (inBounds (15, -1)))

-- Run all tests
allTests :: Test
allTests = TestList
    [ TestLabel "Pure" testPure
    , TestLabel "SetBackgroundColorConstruct" testSetBackgroundColorConstruct
    , TestLabel "CombineSetBackgroundColor" testCombineSetBackgroundColor
    , TestLabel "NewSpriteConstruct" testNewSpriteConstruct
    , TestLabel "OnKeyEventConstruct" testOnKeyEventConstruct
    , TestLabel "OnTargetReachedConstruct" testOnTargetReachedConstruct
    , TestLabel "AfterConstruct" testAfterConstruct
    , TestLabel "InspectCellConstruct" testInspectCellConstruct
    , TestLabel "CombineNesting" testCombineNesting
    , TestLabel "DirVec" testDirVec
    , TestLabel "NextCell" testNextCell
    , TestLabel "InBounds" testInBounds
    ]

main :: IO ()
main = runTestTT allTests >> return ()