{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Chess.Piece
(
PieceType'(..)
, PieceType(..)
, Piece(..)
, somePiece
, fromSome
, equals
, same
, isOfType
, assume
)where
import Control.Applicative (Alternative, empty)
import Data.Type.Equality ((:~:)(Refl), TestEquality, testEquality)
import Chess.Color (Color)
import Chess.Some (Some(Some))
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)
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
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
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
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
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'
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
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
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