{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs     #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Board.PlacedPiece
-- Copyright   : (c) Michael Szvetits, 2023
-- License     : BSD-3-Clause (see the file LICENSE)
-- Maintainer  : typedbyte@qualified.name
-- Stability   : stable
-- Portability : portable
--
-- Types and functions to create and analyze placed chess pieces.
-----------------------------------------------------------------------------
module Chess.Board.PlacedPiece
  ( -- * Representing Placed Pieces
    PlacedPiece(..)
  , placedPiece
    -- * Analyzing Placed Pieces
  , assumeType
  ) where

-- base
import Control.Applicative (Alternative, empty)
import Data.Type.Equality  ((:~:)(Refl), testEquality)
import GHC.Records         (HasField, getField)

import Chess.Board.Position (Position)
import Chess.Color          (Color)
import Chess.Piece          (Piece(..), PieceType, same)
import Chess.Some           (Some(Some))

-- | Represents a chess piece that is currently placed on the board.
data PlacedPiece t = PlacedPiece
  { forall (t :: PieceType'). PlacedPiece t -> Position
position :: Position
    -- ^ The position of the placed chess piece.
  , forall (t :: PieceType'). PlacedPiece t -> Piece t
piece :: Piece t
    -- ^ The placed chess piece.
  }
  deriving (PlacedPiece t -> PlacedPiece t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
/= :: PlacedPiece t -> PlacedPiece t -> Bool
$c/= :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
== :: PlacedPiece t -> PlacedPiece t -> Bool
$c== :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
Eq, PlacedPiece t -> PlacedPiece t -> Bool
PlacedPiece t -> PlacedPiece t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (t :: PieceType'). Eq (PlacedPiece t)
forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
forall (t :: PieceType').
PlacedPiece t -> PlacedPiece t -> Ordering
forall (t :: PieceType').
PlacedPiece t -> PlacedPiece t -> PlacedPiece t
min :: PlacedPiece t -> PlacedPiece t -> PlacedPiece t
$cmin :: forall (t :: PieceType').
PlacedPiece t -> PlacedPiece t -> PlacedPiece t
max :: PlacedPiece t -> PlacedPiece t -> PlacedPiece t
$cmax :: forall (t :: PieceType').
PlacedPiece t -> PlacedPiece t -> PlacedPiece t
>= :: PlacedPiece t -> PlacedPiece t -> Bool
$c>= :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
> :: PlacedPiece t -> PlacedPiece t -> Bool
$c> :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
<= :: PlacedPiece t -> PlacedPiece t -> Bool
$c<= :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
< :: PlacedPiece t -> PlacedPiece t -> Bool
$c< :: forall (t :: PieceType'). PlacedPiece t -> PlacedPiece t -> Bool
compare :: PlacedPiece t -> PlacedPiece t -> Ordering
$ccompare :: forall (t :: PieceType').
PlacedPiece t -> PlacedPiece t -> Ordering
Ord, Int -> PlacedPiece t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: PieceType'). Int -> PlacedPiece t -> ShowS
forall (t :: PieceType'). [PlacedPiece t] -> ShowS
forall (t :: PieceType'). PlacedPiece t -> String
showList :: [PlacedPiece t] -> ShowS
$cshowList :: forall (t :: PieceType'). [PlacedPiece t] -> ShowS
show :: PlacedPiece t -> String
$cshow :: forall (t :: PieceType'). PlacedPiece t -> String
showsPrec :: Int -> PlacedPiece t -> ShowS
$cshowsPrec :: forall (t :: PieceType'). Int -> PlacedPiece t -> ShowS
Show)

instance Eq (Some PlacedPiece) where
  Some PlacedPiece t
p1 == :: Some PlacedPiece -> Some PlacedPiece -> Bool
== Some PlacedPiece t
p2 =
    PlacedPiece t
p1.position forall a. Eq a => a -> a -> Bool
== PlacedPiece t
p2.position Bool -> Bool -> Bool
&&
    forall (a :: PieceType') (b :: PieceType').
Piece a -> Piece b -> Bool
same PlacedPiece t
p1.piece PlacedPiece t
p2.piece

instance Ord (Some PlacedPiece) where
  compare :: Some PlacedPiece -> Some PlacedPiece -> Ordering
compare (Some PlacedPiece t
p1) (Some PlacedPiece t
p2) =
    forall a. Ord a => a -> a -> Ordering
compare PlacedPiece t
p1.position PlacedPiece t
p2.position forall a. Semigroup a => a -> a -> a
<>
    forall a. Ord a => a -> a -> Ordering
compare (forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some PlacedPiece t
p1.piece) (forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some PlacedPiece t
p2.piece)

instance Show (Some PlacedPiece) where
  show :: Some PlacedPiece -> String
show (Some PlacedPiece t
piece) = forall a. Show a => a -> String
show PlacedPiece t
piece

instance HasField "color" (PlacedPiece t) Color where
  getField :: PlacedPiece t -> Color
getField = (.piece.color)
  {-# INLINE getField #-}

instance HasField "type'" (PlacedPiece t) (PieceType t) where
  getField :: PlacedPiece t -> PieceType t
getField = (.piece.type')
  {-# INLINE getField #-}

-- | Smart constructor for creating 'Some' 'PlacedPiece'.
placedPiece :: Position -> Piece t -> Some PlacedPiece
placedPiece :: forall (t :: PieceType'). Position -> Piece t -> Some PlacedPiece
placedPiece Position
position = forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: PieceType'). Position -> Piece t -> PlacedPiece t
PlacedPiece Position
position

-- | Assumes that the given placed piece has the specified piece type.
assumeType :: Alternative f => PieceType t -> PlacedPiece a -> f (PlacedPiece t)
assumeType :: forall (f :: * -> *) (t :: PieceType') (a :: PieceType').
Alternative f =>
PieceType t -> PlacedPiece a -> f (PlacedPiece t)
assumeType PieceType t
type' PlacedPiece a
placed =
  case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality PieceType t
type' PlacedPiece a
placed.piece.type' of
    Just t :~: a
Refl -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PlacedPiece a
placed
    Maybe (t :~: a)
Nothing   -> forall (f :: * -> *) a. Alternative f => f a
empty