module Chess.Internal.Notation (parseMove, parseCoordinateNotation, parseCoordinateStringWithPromotion) where

import Chess.Internal.Move
import Chess.Internal.Board
import Chess.Internal.Piece
import Data.List
import Data.Char
import Data.Attoparsec.Text
import qualified Data.Text as T
import Control.Applicative

parseMove :: GameState -> String -> Maybe Move
parseMove :: GameState -> String -> Maybe Move
parseMove = GameState -> String -> Maybe Move
parseCoordinateNotation

parseCoordinateNotation :: GameState -> String -> Maybe Move
parseCoordinateNotation :: GameState -> String -> Maybe Move
parseCoordinateNotation GameState
game String
moveString = case Parser (Coordinates, Coordinates, Maybe PieceType)
-> Text
-> Either String (Coordinates, Coordinates, Maybe PieceType)
forall a. Parser a -> Text -> Either String a
parseOnly Parser (Coordinates, Coordinates, Maybe PieceType)
parseCoordinateStringWithPromotion (String -> Text
T.pack String
moveString) of
                                              Left String
_ -> Maybe Move
forall a. Maybe a
Nothing
                                              Right (Coordinates
start, Coordinates
end, Maybe PieceType
promotion) -> GameState
-> Coordinates -> Coordinates -> Maybe PieceType -> Maybe Move
findMoveForCoordinates GameState
game Coordinates
start Coordinates
end Maybe PieceType
promotion

findMoveForCoordinates :: GameState -> Coordinates -> Coordinates -> Maybe PieceType -> Maybe Move
findMoveForCoordinates :: GameState
-> Coordinates -> Coordinates -> Maybe PieceType -> Maybe Move
findMoveForCoordinates GameState
game Coordinates
start Coordinates
end Maybe PieceType
Nothing | [Move] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Move]
moves Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Move -> Maybe Move
forall a. a -> Maybe a
Just (Move -> Maybe Move) -> Move -> Maybe Move
forall a b. (a -> b) -> a -> b
$ [Move] -> Move
forall a. [a] -> a
head [Move]
moves
        where moves :: [Move]
moves = GameState -> Coordinates -> Coordinates -> [Move]
findMovesMatchingCoordinates GameState
game Coordinates
start Coordinates
end
findMoveForCoordinates GameState
game Coordinates
start Coordinates
end (Just PieceType
promotion) = Coordinates -> Coordinates -> PieceType -> [Move] -> Maybe Move
findPromotionMove Coordinates
start Coordinates
end PieceType
promotion [Move]
moves
        where moves :: [Move]
moves = GameState -> Coordinates -> Coordinates -> [Move]
findMovesMatchingCoordinates GameState
game Coordinates
start Coordinates
end
findMoveForCoordinates GameState
_ Coordinates
_ Coordinates
_ Maybe PieceType
_ = Maybe Move
forall a. Maybe a
Nothing

findPromotionMove :: Coordinates -> Coordinates -> PieceType -> [Move] -> Maybe Move
findPromotionMove :: Coordinates -> Coordinates -> PieceType -> [Move] -> Maybe Move
findPromotionMove Coordinates
start Coordinates
end PieceType
promotion = (Move -> Bool) -> [Move] -> Maybe Move
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Move -> Bool
matchPromotionMove
        where matchPromotionMove :: Move -> Bool
matchPromotionMove (Promotion Piece
_ Coordinates
s Coordinates
e PieceType
p) = Coordinates
s Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
e Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end Bool -> Bool -> Bool
&& PieceType
p PieceType -> PieceType -> Bool
forall a. Eq a => a -> a -> Bool
== PieceType
promotion
              matchPromotionMove Move
_ = Bool
False

findMovesMatchingCoordinates :: GameState -> Coordinates -> Coordinates -> [Move]
findMovesMatchingCoordinates :: GameState -> Coordinates -> Coordinates -> [Move]
findMovesMatchingCoordinates GameState
game Coordinates
start Coordinates
end = (Move -> Bool) -> [Move] -> [Move]
forall a. (a -> Bool) -> [a] -> [a]
filter (Coordinates -> Coordinates -> Move -> Bool
coordinatesMatch Coordinates
start Coordinates
end) [Move]
allMoves
        where allMoves :: [Move]
allMoves = GameState -> [Move]
generateAllMoves GameState
game

coordinatesMatch :: Coordinates -> Coordinates -> Move -> Bool
coordinatesMatch :: Coordinates -> Coordinates -> Move -> Bool
coordinatesMatch Coordinates
start Coordinates
end (Movement Piece
_ Coordinates
from Coordinates
to) = Coordinates
from Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
to Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end
coordinatesMatch Coordinates
start Coordinates
end (Capture Piece
_ Coordinates
from Coordinates
to) = Coordinates
from Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
to Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end
coordinatesMatch Coordinates
start Coordinates
end (EnPassant Piece
_ Coordinates
from Coordinates
to) = Coordinates
from Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
to Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end
coordinatesMatch Coordinates
start Coordinates
end (PawnDoubleMove Piece
_ Coordinates
from Coordinates
to) = Coordinates
from Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
to Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end
coordinatesMatch Coordinates
start Coordinates
end (Promotion Piece
_ Coordinates
from Coordinates
to PieceType
_) = Coordinates
from Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
start Bool -> Bool -> Bool
&& Coordinates
to Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== Coordinates
end
coordinatesMatch Coordinates
start Coordinates
end (Castling Color
White CastlingType
Short) = Coordinates
start Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
7, Int
4) Bool -> Bool -> Bool
&& Coordinates
end Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
7, Int
6)
coordinatesMatch Coordinates
start Coordinates
end (Castling Color
White CastlingType
Long) = Coordinates
start Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
7, Int
4) Bool -> Bool -> Bool
&& Coordinates
end Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
7, Int
2)
coordinatesMatch Coordinates
start Coordinates
end (Castling Color
Black CastlingType
Short) = Coordinates
start Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0, Int
4) Bool -> Bool -> Bool
&& Coordinates
end Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0, Int
6)
coordinatesMatch Coordinates
start Coordinates
end (Castling Color
Black CastlingType
Long) = Coordinates
start Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0, Int
4) Bool -> Bool -> Bool
&& Coordinates
end Coordinates -> Coordinates -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0, Int
2)

parseCoordinateStringWithPromotion :: Parser (Coordinates, Coordinates, Maybe PieceType)
parseCoordinateStringWithPromotion :: Parser (Coordinates, Coordinates, Maybe PieceType)
parseCoordinateStringWithPromotion = do (Coordinates
coord1, Coordinates
coord2) <- Parser (Coordinates, Coordinates)
parseCoordinateString
                                        Maybe PieceType
promotion <- Parser (Maybe PieceType)
parsePromotion
                                        Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput
                                        (Coordinates, Coordinates, Maybe PieceType)
-> Parser (Coordinates, Coordinates, Maybe PieceType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Coordinates
coord1, Coordinates
coord2, Maybe PieceType
promotion)

parseCoordinateString :: Parser (Coordinates, Coordinates)
parseCoordinateString :: Parser (Coordinates, Coordinates)
parseCoordinateString = do Coordinates
coord1 <- Parser Coordinates
parseCoordinates
                           Char
_ <- Char -> Parser Char
char Char
'-'
                           Coordinates
coord2 <- Parser Coordinates
parseCoordinates
                           (Coordinates, Coordinates) -> Parser (Coordinates, Coordinates)
forall (m :: * -> *) a. Monad m => a -> m a
return (Coordinates
coord1, Coordinates
coord2)

parseCoordinates :: Parser Coordinates
parseCoordinates :: Parser Coordinates
parseCoordinates = do Char
column <- Parser Char
letter
                      Char
row <- Parser Char
digit
                      case String -> Maybe Coordinates
parseCoordinate [Char -> Char
toLower Char
column, Char
row] of
                              Just Coordinates
coordinates -> Coordinates -> Parser Coordinates
forall (m :: * -> *) a. Monad m => a -> m a
return Coordinates
coordinates
                              Maybe Coordinates
Nothing -> String -> Parser Coordinates
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse coordinate"

parsePromotion :: Parser (Maybe PieceType)
parsePromotion :: Parser (Maybe PieceType)
parsePromotion = (PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just (PieceType -> Maybe PieceType)
-> Parser Text PieceType -> Parser (Maybe PieceType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text PieceType
parsePromotionEqualSign) Parser (Maybe PieceType)
-> Parser (Maybe PieceType) -> Parser (Maybe PieceType)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (PieceType -> Maybe PieceType
forall a. a -> Maybe a
Just (PieceType -> Maybe PieceType)
-> Parser Text PieceType -> Parser (Maybe PieceType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text PieceType
parsePromotionParenthesis) Parser (Maybe PieceType)
-> Parser (Maybe PieceType) -> Parser (Maybe PieceType)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe PieceType -> Parser (Maybe PieceType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PieceType
forall a. Maybe a
Nothing

parsePromotionEqualSign :: Parser PieceType
parsePromotionEqualSign :: Parser Text PieceType
parsePromotionEqualSign = do Char
_ <- Char -> Parser Char
char Char
'='
                             Char
promotionChar <- (Char -> Bool) -> Parser Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"NBRQ")
                             case Char -> Maybe PieceType
parsePieceType Char
promotionChar of
                                     Just PieceType
piece -> PieceType -> Parser Text PieceType
forall (m :: * -> *) a. Monad m => a -> m a
return PieceType
piece
                                     Maybe PieceType
Nothing -> String -> Parser Text PieceType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid promotion piecetype"

parsePromotionParenthesis :: Parser PieceType
parsePromotionParenthesis :: Parser Text PieceType
parsePromotionParenthesis = do Char
_ <- Char -> Parser Char
char Char
'('
                               Char
promotionChar <- (Char -> Bool) -> Parser Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"NBRQ")
                               Char
_ <- Char -> Parser Char
char Char
')'
                               case Char -> Maybe PieceType
parsePieceType Char
promotionChar of
                                       Just PieceType
piece -> PieceType -> Parser Text PieceType
forall (m :: * -> *) a. Monad m => a -> m a
return PieceType
piece
                                       Maybe PieceType
Nothing -> String -> Parser Text PieceType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid promotion piecetype"