module LatticeTest (suite) where

import Test.Tasty
import Test.Tasty.HUnit
import World.Types 
  ( Combinable (..)
  , LatticeProposal (..)
  , LatticePropList (..)
  )
import World.Lattice 
  (LatticeCell (..)
  , Lattice
  , LatticeRule
  , updateLattice
  , applyLatticeProposals
  )

suite :: TestTree
suite = testGroup "lattice tests" $
  [ latticeGrowth
  , proposalApplication
  ]


data GrowKind = Empty | Plant deriving (Show, Enum, Eq)
instance Combinable GrowKind where
  identity = Empty
  combinable _ _ = True
  combine Plant _ = Plant
  combine _ Plant = Plant
  combine Empty Empty = Empty

data GrowFlags = None deriving (Show, Eq)


newtype MergeInt = MergeInt Int deriving (Show, Eq)
instance Combinable MergeInt where
  identity = MergeInt 0
  combinable _ _ = True
  combine (MergeInt x) (MergeInt y) = MergeInt $ x+y


latticeGrowth :: TestTree
latticeGrowth = testCase "growth update rule" $
  let
    plant = LatticeCell Plant None
    empty = LatticeCell Empty None
    lattice = [[ empty, empty, plant ]]
    rules =
      [ 
        -- empty
        \l x y -> 
          if kind ((l !! y) !! (x+1)) == Plant
          then LatticeCell Plant None
          else LatticeCell Empty None
        -- plant
        , \_ _ _ -> LatticeCell Plant None
      ] :: [LatticeRule GrowKind GrowFlags]
    lattice' = updateLattice lattice rules
    lattice'' = updateLattice lattice' rules
  in do
    lattice' @?= [[ empty, plant, plant ]]
    lattice'' @?= [[ plant, plant, plant ]]



proposalApplication :: TestTree
proposalApplication = testGroup "apply proposal lists to lattices" $
  [ testCase "update cell kinds" $
    let
      plant = LatticeCell Plant Nothing
      empty = LatticeCell Empty Nothing
      lattice = [[ empty, plant, empty ]]
      proposals :: LatticePropList GrowKind (Maybe Bool)
      proposals = LatticePropList
        [ LatticeProposal (0, 0) Empty Plant Nothing
        , LatticeProposal (1, 0) Plant Empty Nothing
        , LatticeProposal (2, 0) Empty Plant Nothing
        ]
      lattice' = applyLatticeProposals lattice proposals
    in
      lattice' @?= [[ plant, empty, plant ]]
  , testCase "update cell kinds and flags" $
    let
      plant = LatticeCell Plant (Just True)
      empty = LatticeCell Empty Nothing
      lattice = [[ empty, plant, empty ]]
      proposals :: LatticePropList GrowKind (Maybe Bool)
      proposals = LatticePropList
        [ LatticeProposal (0, 0) Empty Plant (Just False)
        , LatticeProposal (2, 0) Empty Plant (Just True)
        ]
      lattice' = applyLatticeProposals lattice proposals
    in
      lattice' @?= [
        [ LatticeCell Plant (Just False)
        , LatticeCell Plant Nothing -- reset by the application process
        , LatticeCell Plant (Just True)
        ]
      ]
  , testCase "cell flags combine correctly" $
    let
      lattice = [[ LatticeCell Empty (MergeInt 4) ]]
      proposals :: LatticePropList GrowKind MergeInt
      proposals = LatticePropList
        [ LatticeProposal (0, 0) Empty Plant (MergeInt $ 0-1)
        , LatticeProposal (0, 0) Empty Plant (MergeInt $ 0-2)
        , LatticeProposal (0, 0) Empty Plant (MergeInt $ 0-3)
        ]
      lattice' = applyLatticeProposals lattice proposals
    in
      lattice' @?= [
        [ LatticeCell Plant (MergeInt $ 0-6)
        ]
      ]
  , testCase "invalid proposals are not applied" $
    let
      plant = LatticeCell Plant Nothing
      empty = LatticeCell Empty Nothing
      lattice = [[ empty, plant, empty ]]
      proposals :: LatticePropList GrowKind (Maybe Bool)
      proposals = LatticePropList
        [ LatticeProposal (0, 0) Plant Plant Nothing
        , LatticeProposal (1, 0) Plant Empty Nothing
        , LatticeProposal (2, 0) Empty Plant Nothing
        ]
      lattice' = applyLatticeProposals lattice proposals
    in
      lattice' @?= [[ empty, empty, plant ]]

  ]