-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Captures the various possibilities of cell
-- modification as a sum type for use by the structure recognizer
-- (see 'Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking.entityModified').
module Swarm.Game.World.Modify where

import Control.Lens (view)
import Data.Function (on)
import Swarm.Game.Entity (Entity, entityHash)

-- | Compare to 'WorldUpdate' in "Swarm.Game.World"
data CellUpdate e
  = NoChange (Maybe e)
  | Modified (CellModification e)

getModification :: CellUpdate e -> Maybe (CellModification e)
getModification :: forall e. CellUpdate e -> Maybe (CellModification e)
getModification (NoChange Maybe e
_) = forall a. Maybe a
Nothing
getModification (Modified CellModification e
x) = forall a. a -> Maybe a
Just CellModification e
x

data CellModification e
  = -- | Fields represent what existed in the cell "before" and "after", in that order.
    Swap e e
  | Remove e
  | Add e

classifyModification ::
  -- | before
  Maybe Entity ->
  -- | after
  Maybe Entity ->
  CellUpdate Entity
classifyModification :: Maybe Entity -> Maybe Entity -> CellUpdate Entity
classifyModification Maybe Entity
Nothing Maybe Entity
Nothing = forall e. Maybe e -> CellUpdate e
NoChange forall a. Maybe a
Nothing
classifyModification Maybe Entity
Nothing (Just Entity
x) = forall e. CellModification e -> CellUpdate e
Modified forall a b. (a -> b) -> a -> b
$ forall e. e -> CellModification e
Add Entity
x
classifyModification (Just Entity
x) Maybe Entity
Nothing = forall e. CellModification e -> CellUpdate e
Modified forall a b. (a -> b) -> a -> b
$ forall e. e -> CellModification e
Remove Entity
x
classifyModification (Just Entity
x) (Just Entity
y) =
  if (forall a. Eq a => a -> a -> Bool
(/=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Entity Int
entityHash) Entity
x Entity
y
    then forall e. CellModification e -> CellUpdate e
Modified forall a b. (a -> b) -> a -> b
$ forall e. e -> e -> CellModification e
Swap Entity
x Entity
y
    else forall e. Maybe e -> CellUpdate e
NoChange forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Entity
x