{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs     #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Chess.Piece
-- 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 chess pieces.
-----------------------------------------------------------------------------
module Chess.Piece
  ( -- * Representing Pieces
    PieceType'(..)
  , PieceType(..)
  , Piece(..)
  , somePiece
  , fromSome
    -- * Analyzing Piece Types
  , equals
    -- * Analyzing Pieces
  , same
  , isOfType
  , assume
  )where

-- base
import Control.Applicative (Alternative, empty)
import Data.Type.Equality  ((:~:)(Refl), TestEquality, testEquality)

import Chess.Color (Color)
import Chess.Some  (Some(Some))

-- | Represents the piece types involved in a chess game on the type-level.
data PieceType'
  = Pawn'
  | Knight'
  | Bishop'
  | Rook'
  | Queen'
  | King'
  deriving (PieceType' -> PieceType' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PieceType' -> PieceType' -> Bool
$c/= :: PieceType' -> PieceType' -> Bool
== :: PieceType' -> PieceType' -> Bool
$c== :: PieceType' -> PieceType' -> Bool
Eq, Eq PieceType'
PieceType' -> PieceType' -> Bool
PieceType' -> PieceType' -> Ordering
PieceType' -> PieceType' -> PieceType'
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
min :: PieceType' -> PieceType' -> PieceType'
$cmin :: PieceType' -> PieceType' -> PieceType'
max :: PieceType' -> PieceType' -> PieceType'
$cmax :: PieceType' -> PieceType' -> PieceType'
>= :: PieceType' -> PieceType' -> Bool
$c>= :: PieceType' -> PieceType' -> Bool
> :: PieceType' -> PieceType' -> Bool
$c> :: PieceType' -> PieceType' -> Bool
<= :: PieceType' -> PieceType' -> Bool
$c<= :: PieceType' -> PieceType' -> Bool
< :: PieceType' -> PieceType' -> Bool
$c< :: PieceType' -> PieceType' -> Bool
compare :: PieceType' -> PieceType' -> Ordering
$ccompare :: PieceType' -> PieceType' -> Ordering
Ord, ReadPrec [PieceType']
ReadPrec PieceType'
Int -> ReadS PieceType'
ReadS [PieceType']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PieceType']
$creadListPrec :: ReadPrec [PieceType']
readPrec :: ReadPrec PieceType'
$creadPrec :: ReadPrec PieceType'
readList :: ReadS [PieceType']
$creadList :: ReadS [PieceType']
readsPrec :: Int -> ReadS PieceType'
$creadsPrec :: Int -> ReadS PieceType'
Read, Int -> PieceType' -> ShowS
[PieceType'] -> ShowS
PieceType' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PieceType'] -> ShowS
$cshowList :: [PieceType'] -> ShowS
show :: PieceType' -> String
$cshow :: PieceType' -> String
showsPrec :: Int -> PieceType' -> ShowS
$cshowsPrec :: Int -> PieceType' -> ShowS
Show)

-- | Represents the piece types involved in a chess game on the term-level.
data PieceType t where
  Pawn   :: PieceType Pawn'
  Knight :: PieceType Knight'
  Bishop :: PieceType Bishop'
  Rook   :: PieceType Rook'
  Queen  :: PieceType Queen'
  King   :: PieceType King'

deriving instance Eq   (PieceType t)
deriving instance Ord  (PieceType t)
deriving instance Show (PieceType t)

instance TestEquality PieceType where
  testEquality :: forall (a :: PieceType') (b :: PieceType').
PieceType a -> PieceType b -> Maybe (a :~: b)
testEquality PieceType a
Pawn   PieceType b
Pawn   = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
Knight PieceType b
Knight = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
Bishop PieceType b
Bishop = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
Rook   PieceType b
Rook   = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
Queen  PieceType b
Queen  = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
King   PieceType b
King   = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
  testEquality PieceType a
_      PieceType b
_      = forall a. Maybe a
Nothing

-- | Returns true if two piece types are the same.
equals :: PieceType a -> PieceType b -> Bool
equals :: forall (a :: PieceType') (b :: PieceType').
PieceType a -> PieceType b -> Bool
equals PieceType a
type1 PieceType b
type2 =
  case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality PieceType a
type1 PieceType b
type2 of
    Just a :~: b
Refl -> Bool
True
    Maybe (a :~: b)
Nothing   -> Bool
False

-- | Represents a chess piece, which is a combination of its type and its color.
data Piece t = Piece
  { forall (t :: PieceType'). Piece t -> PieceType t
type' :: PieceType t
  , forall (t :: PieceType'). Piece t -> Color
color :: Color
  }
  deriving (Piece t -> Piece t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: PieceType'). Piece t -> Piece t -> Bool
/= :: Piece t -> Piece t -> Bool
$c/= :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
== :: Piece t -> Piece t -> Bool
$c== :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
Eq, Piece t -> Piece t -> Bool
Piece t -> Piece 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 (Piece t)
forall (t :: PieceType'). Piece t -> Piece t -> Bool
forall (t :: PieceType'). Piece t -> Piece t -> Ordering
forall (t :: PieceType'). Piece t -> Piece t -> Piece t
min :: Piece t -> Piece t -> Piece t
$cmin :: forall (t :: PieceType'). Piece t -> Piece t -> Piece t
max :: Piece t -> Piece t -> Piece t
$cmax :: forall (t :: PieceType'). Piece t -> Piece t -> Piece t
>= :: Piece t -> Piece t -> Bool
$c>= :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
> :: Piece t -> Piece t -> Bool
$c> :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
<= :: Piece t -> Piece t -> Bool
$c<= :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
< :: Piece t -> Piece t -> Bool
$c< :: forall (t :: PieceType'). Piece t -> Piece t -> Bool
compare :: Piece t -> Piece t -> Ordering
$ccompare :: forall (t :: PieceType'). Piece t -> Piece t -> Ordering
Ord, Int -> Piece t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: PieceType'). Int -> Piece t -> ShowS
forall (t :: PieceType'). [Piece t] -> ShowS
forall (t :: PieceType'). Piece t -> String
showList :: [Piece t] -> ShowS
$cshowList :: forall (t :: PieceType'). [Piece t] -> ShowS
show :: Piece t -> String
$cshow :: forall (t :: PieceType'). Piece t -> String
showsPrec :: Int -> Piece t -> ShowS
$cshowsPrec :: forall (t :: PieceType'). Int -> Piece t -> ShowS
Show)

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

instance Ord (Some Piece) where
  compare :: Some Piece -> Some Piece -> Ordering
compare (Some Piece t
p1) (Some Piece t
p2) =
    case (Piece t
p1.type', Piece t
p2.type') of
      (PieceType t
Pawn  , PieceType t
Pawn  ) -> Ordering
compareColor
      (PieceType t
Pawn  , PieceType t
_     ) -> Ordering
LT
      (PieceType t
Knight, PieceType t
Pawn  ) -> Ordering
GT
      (PieceType t
Knight, PieceType t
Knight) -> Ordering
compareColor
      (PieceType t
Knight, PieceType t
_     ) -> Ordering
LT
      (PieceType t
Bishop, PieceType t
Pawn  ) -> Ordering
GT
      (PieceType t
Bishop, PieceType t
Knight) -> Ordering
GT
      (PieceType t
Bishop, PieceType t
Bishop) -> Ordering
compareColor
      (PieceType t
Bishop, PieceType t
_     ) -> Ordering
LT
      (PieceType t
Rook  , PieceType t
King  ) -> Ordering
LT
      (PieceType t
Rook  , PieceType t
Queen ) -> Ordering
LT
      (PieceType t
Rook  , PieceType t
Rook  ) -> Ordering
compareColor
      (PieceType t
Rook  , PieceType t
_     ) -> Ordering
GT
      (PieceType t
Queen , PieceType t
King  ) -> Ordering
LT
      (PieceType t
Queen , PieceType t
Queen ) -> Ordering
compareColor
      (PieceType t
Queen , PieceType t
_     ) -> Ordering
GT
      (PieceType t
King  , PieceType t
King  ) -> Ordering
compareColor
      (PieceType t
King  , PieceType t
_     ) -> Ordering
GT
    where
      compareColor :: Ordering
compareColor = forall a. Ord a => a -> a -> Ordering
compare Piece t
p1.color Piece t
p2.color

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

-- | Smart constructor for creating 'Some' 'Piece'.
somePiece :: PieceType t -> Color -> Some Piece
somePiece :: forall (t :: PieceType'). PieceType t -> Color -> Some Piece
somePiece PieceType t
type' Color
color = forall {k} (f :: k -> *) (t :: k). f t -> Some f
Some forall a b. (a -> b) -> a -> b
$ forall (t :: PieceType'). PieceType t -> Color -> Piece t
Piece PieceType t
type' Color
color

-- | Smart constructor for creating 'Some' 'Piece' from 'Some' 'PieceType'.
fromSome :: Some PieceType -> Color -> Some Piece
fromSome :: Some PieceType -> Color -> Some Piece
fromSome (Some PieceType t
type') = forall (t :: PieceType'). PieceType t -> Color -> Some Piece
somePiece PieceType t
type'

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

-- | Returns true if two pieces are the same.
same :: Piece a -> Piece b -> Bool
same :: forall (a :: PieceType') (b :: PieceType').
Piece a -> Piece b -> Bool
same Piece a
piece1 Piece b
piece2 =
  case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality Piece a
piece1.type' Piece b
piece2.type' of
    Just a :~: b
Refl -> Piece a
piece1.color forall a. Eq a => a -> a -> Bool
== Piece b
piece2.color
    Maybe (a :~: b)
Nothing   -> Bool
False

-- | Returns true if the given piece has the specified piece type.
isOfType :: PieceType t -> Piece a -> Bool
isOfType :: forall (t :: PieceType') (a :: PieceType').
PieceType t -> Piece a -> Bool
isOfType PieceType t
type' Piece a
piece =
  case forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality PieceType t
type' Piece a
piece.type' of
    Just t :~: a
Refl -> Bool
True
    Maybe (t :~: a)
Nothing   -> Bool
False