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"