module SAN (
  SANFullMove(..),
  sanFullMove
) where

import Control.Monad (liftM)

import Text.ParserCombinators.Parsec

data SANFullMove = SANFullMove !SANMove !SANAnnotation
  deriving (Eq, Show)

data SANMove = SANMove !SANPieceInfo !SANSquare |
               SANCapture !SANPieceInfo !SANSquare |
               SANLongCastling |
               SANShortCastling
  deriving (Eq, Show)

data SANPieceInfo = SANPieceInfo !SANPiece (Maybe SANCol)
  deriving (Eq, Show)

data SANPiece = Pawn | Knight | Bishop | Rook | Queen | King
  deriving (Eq, Show)

type SANCol = Char

type SANSquare = String

type SANAnnotation = String

optionMaybe :: GenParser tok st a -> GenParser tok st (Maybe a)
optionMaybe p = option Nothing (liftM Just p)

sanCol :: Parser Char
sanCol = oneOf "abcdefgh"

sanSquare :: Parser SANSquare
sanSquare = do
  col <- sanCol
  ln <- oneOf "12345678"
  return [col,ln]

sanPiece :: Parser SANPiece
sanPiece = do
  option Pawn $ do
    c <- oneOf "NBRQK"
    return $ case c of
      'N' -> Knight
      'B' -> Bishop
      'R' -> Rook
      'Q' -> Queen
      'K' -> King
      _   -> error "can't happen!"

sanPieceInfo :: Parser SANPieceInfo
sanPieceInfo = do
  p <- sanPiece
  col <- optionMaybe sanCol
  return (SANPieceInfo p col)

sanCastling :: Parser SANMove
sanCastling = do
  string "O-O"
  option SANShortCastling (string "-O" >> return SANLongCastling)

sanAnnotation :: Parser SANAnnotation
sanAnnotation = many (oneOf "!?+#")

sanCapture :: Parser SANMove
sanCapture = do
  pinf <- sanPieceInfo
  char 'x'
  s <- sanSquare
  return (SANCapture pinf s)

sanMoveCol :: Parser SANMove
sanMoveCol = do
  pinf <- sanPieceInfo
  s <- sanSquare
  return (SANMove pinf s)

sanMoveNoCol :: Parser SANMove
sanMoveNoCol = do
  p <- sanPiece
  s <- sanSquare
  return (SANMove (SANPieceInfo p Nothing) s)

sanMove :: Parser SANMove
sanMove = try sanMoveNoCol <|> try sanMoveCol <|> sanCapture <|> sanCastling

sanFullMove :: Parser SANFullMove
sanFullMove = do
  move <- sanMove
  ann <- sanAnnotation
  return (SANFullMove move ann)