module Chess.Internal.Piece (Piece(..), Color(..), PieceType(..), opponent, printPiece,
                    parsePiece, pieceChars, parsePieceType) where

import Data.Char

data Piece = Piece Color PieceType
           deriving (Int -> Piece -> ShowS
[Piece] -> ShowS
Piece -> String
(Int -> Piece -> ShowS)
-> (Piece -> String) -> ([Piece] -> ShowS) -> Show Piece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Piece] -> ShowS
$cshowList :: [Piece] -> ShowS
show :: Piece -> String
$cshow :: Piece -> String
showsPrec :: Int -> Piece -> ShowS
$cshowsPrec :: Int -> Piece -> ShowS
Show, Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c== :: Piece -> Piece -> Bool
Eq)

data Color = White | Black
           deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq)

data PieceType = Pawn | Knight | Bishop | Rook | Queen | King
           deriving (Int -> PieceType -> ShowS
[PieceType] -> ShowS
PieceType -> String
(Int -> PieceType -> ShowS)
-> (PieceType -> String)
-> ([PieceType] -> ShowS)
-> Show PieceType
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, PieceType -> PieceType -> Bool
(PieceType -> PieceType -> Bool)
-> (PieceType -> PieceType -> Bool) -> Eq PieceType
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)

opponent :: Color -> Color
opponent :: Color -> Color
opponent Color
White = Color
Black
opponent Color
Black = Color
White

pieceChars :: [(PieceType, Char)]
pieceChars :: [(PieceType, Char)]
pieceChars = [(PieceType
Pawn, Char
'P'), (PieceType
Knight, Char
'N'), (PieceType
Bishop, Char
'B'), (PieceType
Rook, Char
'R'), (PieceType
Queen, Char
'Q'), (PieceType
King, Char
'K')]

printPiece :: Piece -> String
printPiece :: Piece -> String
printPiece (Piece Color
color PieceType
pieceType) = case Color
color of
                               Color
White -> [Char -> Char
toUpper Char
c]
                               Color
Black -> [Char -> Char
toLower Char
c]
    where (Just Char
c) = PieceType -> [(PieceType, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PieceType
pieceType [(PieceType, Char)]
pieceChars

parsePiece :: Char -> Maybe Piece
parsePiece :: Char -> Maybe Piece
parsePiece Char
c = do
  PieceType
pieceType <- Char -> Maybe PieceType
parsePieceType Char
c
  Piece -> Maybe Piece
forall (m :: * -> *) a. Monad m => a -> m a
return (if Char -> Bool
isUpper Char
c then Color -> PieceType -> Piece
Piece Color
White PieceType
pieceType else Color -> PieceType -> Piece
Piece Color
Black PieceType
pieceType)

parsePieceType :: Char -> Maybe PieceType
parsePieceType :: Char -> Maybe PieceType
parsePieceType Char
c = Char -> [(PieceType, Char)] -> Maybe PieceType
forall a b. Eq a => a -> [(b, a)] -> Maybe b
rlookup (Char -> Char
toUpper Char
c) [(PieceType, Char)]
pieceChars
    where rlookup :: a -> [(b, a)] -> Maybe b
rlookup a
x = a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x ([(a, b)] -> Maybe b)
-> ([(b, a)] -> [(a, b)]) -> [(b, a)] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (a, b)) -> [(b, a)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> (a, b)
forall b a. (b, a) -> (a, b)
swap
          swap :: (b, a) -> (a, b)
swap (b
x, a
y) = (a
y, b
x)