module WorldTypesTest (suite) where


import Test.Tasty
import Test.Tasty.HUnit
import World.Types
  ( Combinable (..)
  , Pos
  , LatticeProposal (..)
  , LatticePropList (..)
  , AgentProposal (..)
  , AgentPropList (..)
  , Proposal (..)
  )


suite :: TestTree
suite = testGroup "world types tests" $
  [ latticePropTests
  , agentPropTests
  ]


latticePropTests :: TestTree
latticePropTests = testGroup "lattice proposal tests" $
  [ testCase "combine LatticePropList with identity" $
    let 
      propList :: LatticePropList (Maybe Int) (Maybe Int)
      propList = LatticePropList
        [ LatticeProposal (0, 0) (Just 0) (Just 0) (Just 0)
        , LatticeProposal (0, 1) Nothing (Just 0) (Just 0)
        , LatticeProposal (1, 1) (Just 0) Nothing Nothing
        ]
    in combine identity propList @?= propList
  , testCase "incompatible proposal lists are not combinable" $
    let
      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing ]
      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ]
    in
      combinable (LatticePropList a) (LatticePropList a') @?= False
  , testCase "compatible proposal lists are combinable" $
    let
      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing ]
      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a' = [ LatticeProposal (0, 0) (Just 0) (Just 4) (Just 2) ]
    in
      combinable (LatticePropList a) (LatticePropList a') @?= True
  , testCase "otherwise incompatible proposal lists are still compatible for different cells" $
    let
      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a = [ LatticeProposal (0, 1) (Just 0) Nothing Nothing ]
      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ]
    in
      combinable (LatticePropList a) (LatticePropList a') @?= True 
  , testCase "a single incompatible proposal results in overall incompatibility" $
    let
      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing 
          , LatticeProposal (0, 1) (Just 0) Nothing Nothing 
          ]
      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
      a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ]
    in
      combinable (LatticePropList a) (LatticePropList a') @?= False
  ]


agentPropTests :: TestTree
agentPropTests = testGroup "lattice proposal tests" $
  [ testCase "combine AgentPropList with identity" $
    let 
      propList :: AgentPropList (Maybe Int)
      propList = AgentPropList
        [ AgentProposal 0 (Just (0, 0)) (Just 0)
        , AgentProposal 0 (Just (0, 1)) Nothing
        , AgentProposal 0 (Just (1, 1)) Nothing
        ]
    in combine identity propList @?= propList
  , testCase "incompatible proposal lists are not combinable" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
      a' :: [AgentProposal (Maybe Int)]
      a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= False
  , testCase "compatible proposal lists are combinable" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
      a' :: [AgentProposal (Maybe Int) ]
      a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= True
  , testCase "trying to move an agent to two different locations is incompatible" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 1)) (Just 0) ]
      a' :: [AgentProposal (Maybe Int)]
      a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= False
  , testCase "a single incompatible proposal results in overall incompatibility" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) 
          , AgentProposal 0 (Just (0, 1)) (Just 0) 
          ]
      a' :: [AgentProposal (Maybe Int)]
      a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= False
  , testCase "two updates moving different agents to the same location are incompatible" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 0)) Nothing ]
      a' :: [AgentProposal (Maybe Int)]
      a' = [ AgentProposal 1 (Just (0, 0)) Nothing ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= False
   , testCase "two updates moving the same agent to the same location are compatible" $
    let
      a :: [AgentProposal (Maybe Int)]
      a = [ AgentProposal 0 (Just (0, 0)) Nothing ]
      a' :: [AgentProposal (Maybe Int)]
      a' = [ AgentProposal 0 (Just (0, 0)) Nothing ]
    in
      combinable (AgentPropList a) (AgentPropList a') @?= True
  ]