-- | parser for Chu Shogi Game (.csg) files
--
-- Only format 3 even games are currently supported.
-- Copyright 2009 Colin Adams
--
-- This file is part of chu-shogi.
--
--  Chu-shogi is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.

--  Chu-shogi is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.

--  You should have received a copy of the GNU General Public License
--  along with chu-shogi.  If not, see <http://www.gnu.org/licenses/>.

module Move_parser (
                    -- * Parsing
                    parse_moves
                   ) where

import Char (ord)
import Control.Monad (liftM)
import Data.Maybe
import Text.Parsec                    
import Game_state
import Coordinate
import Piece
import Move
import Board (piece_at)


import System.IO

-- | Parse game notated in file_name, and update game state accordingly.
parse_moves :: FilePath                                                          -- ^ Name of .csg file
            -> (Non_interactive_state, Maybe Move_stack)                        -- ^ Initial game state
            -> IO (Either ParseError (Non_interactive_state, Maybe Move_stack)) -- ^ Updated game state
parse_moves file_name (ni_state, stack) = do
    handle <- openFile file_name ReadMode
    text <- hGetContents handle
    return (runParser move_parser (ni_state, stack) file_name text)
 
-- Implementation

move_parser :: Parsec String (Non_interactive_state, Maybe Move_stack) (Non_interactive_state, Maybe Move_stack)
move_parser = parse_header >> endBy1 line eol >> getState >>= return

parse_header :: Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_header = do
  format <- parse_integer
  eol
  case format of
    3 -> parse_format_3_header
    _ -> fail "unrecognised file format"

parse_format_3_header :: Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_format_3_header = do
  setup_file_name <- many1 (letter <|> (char '.'))
  eol
  case setup_file_name == "board.data" of
    False -> fail "Bad setup file name - only board.data is recognised at present (file BUG report)"
    _ -> do
      handicap <- many $ noneOf "\n\r"
      eol
      case handicap == "EVEN" of
        False -> fail "Bad handicap - only EVEN is recognised at present (file BUG report)"
        True -> do
           _black_player <- many $ noneOf "\n\r"
           eol
           _white_player <- many $ noneOf "\n\r"
           eol
           _comment1 <- many $ noneOf "\n\r"
           eol
           _comment2 <- many $ noneOf "\n\r"
           eol
           _comment3 <- many $ noneOf "\n\r"
           eol
           _comment4 <- many $ noneOf "\n\r"
           eol
           _comment5 <- many $ noneOf "\n\r"
           eol
           zero <- parse_integer
           case zero of
             0 -> do
                  _dummy <- many $ noneOf "\n\r"
                  eol
                  return ()
             _ -> fail "Couldn't fine dummy move 0 P 1a - 1a - bad file format"

line :: Parsec String (Non_interactive_state, Maybe Move_stack) ()
line = do 
  (ni_state, _) <- getState
  let old_line = last_move_western ni_state
  line_number <- parse_integer
  skipMany1 (char ' ')
  abbrev <- parse_abbreviation
  skipMany1 (char ' ')
  source_coord <- parse_coordinate
  skipMany1 (char ' ')
  case line_number of
    n | n == old_line || n == old_line + 1 -> do
                     action <- try (string "x!") <|> (string "!") <|> (string "x") <|> (string "-") <?> fail "expected one of x!, !, x or -"
                     case action of
                       "x!" -> skipMany1 (char ' ') >> parse_igui abbrev source_coord
                       "!" -> parse_pass abbrev source_coord
                       "x" -> skipMany1 (char ' ') >> parse_move abbrev source_coord True
                       "-" -> skipMany1 (char ' ') >> parse_move abbrev source_coord False
      | otherwise -> fail "bad sequence numbering"

parse_move :: Piece_type -> Coordinate -> Bool -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_move abbrev source_coord capturing = do
  target_coord <- parse_coordinate
  skipMany (char ' ')
  (ni_state, _) <- getState
  let colour = case is_black_to_play ni_state of
                 True -> Black
                 False -> White
      target = piece_at (board ni_state) (rank target_coord) (file target_coord)
  case (target, capturing) of
    (Nothing, True) -> fail ("no target piece at " ++ (print_coordinate target_coord))
    (Just (p, _), False) -> fail ("target piece "++ (show p) ++ " at " ++ (print_coordinate target_coord) ++ " where no capture was indicated")
    (Just (p, _), True) | piece_colour p == colour -> fail "(first) capture target is same colour as source"
    _ -> do
      (char 'x' >> skipMany1 (char ' ') >> parse_double_move abbrev source_coord target_coord target True) 
      <|> (char '-' >> skipMany1 (char ' ') >> parse_double_move abbrev source_coord target_coord target False) 
              <|> (oneOf  "+=" >>= parse_single_promotion abbrev source_coord target_coord target)
              <|> parse_single_move abbrev source_coord target_coord target

parse_single_move :: Piece_type -> Coordinate -> Coordinate -> Maybe (Piece, Promotion_status) -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_single_move abbrev source_coord target_coord target =
    parse_single abbrev  source_coord target_coord target False False

{-# contract parse_single_promotion :: Ok -> Ok -> Ok -> Ok -> {indicator | indicator `elem` "+="} -> Ok #-}
parse_single_promotion :: Piece_type -> Coordinate -> Coordinate -> Maybe (Piece, Promotion_status) -> Char -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_single_promotion abbrev source_coord target_coord target indicator =
    let (promoting, declining) = case indicator of
                                   '+' -> (True, False)
                                   '=' -> (False, True)
    in parse_single abbrev source_coord target_coord target promoting declining

parse_single :: Piece_type -> Coordinate -> Coordinate -> Maybe (Piece, Promotion_status) -> Bool -> Bool -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_single abbrev source_coord target_coord target promoting declining = do
  gs@(ni_state, _) <- getState
  let colour = case is_black_to_play ni_state of
                 True -> Black
                 False -> White 
      move = case target of
                 Just (p, _) -> Capture (Piece abbrev colour) source_coord p target_coord promoting declining
                 Nothing -> Move (Piece abbrev colour) source_coord target_coord promoting declining
      new_state = update_from_move gs move
  case isJust new_state of
    True -> putState (fromJust new_state)
    False -> fail $ "Move from " ++ (print_coordinate source_coord) ++ " is repetititious"

parse_double_move :: Piece_type -> Coordinate -> Coordinate -> Maybe (Piece, Promotion_status) -> Bool -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_double_move abbrev source_coord target_coord target capturing_second = do
    second_target_coord <- parse_coordinate
    (ni_state, _) <- getState
    let colour = case is_black_to_play ni_state of
                 True -> Black
                 False -> White
        second_target = piece_at (board ni_state) (rank second_target_coord) (file second_target_coord)
    case (second_target, capturing_second) of
      (Nothing, True) -> fail ("no target piece at " ++ (print_coordinate second_target_coord))
      (Just (p, _), False) -> fail ("target piece "++ (show p) ++ " at "  ++ (print_coordinate second_target_coord) ++ " where no capture was indicated")
      (Just (p, _), True) | piece_colour p == colour -> fail "second capture target is same colour as source"
      _ -> parse_double abbrev colour source_coord target_coord target second_target_coord second_target

parse_double :: Piece_type -> Piece_colour -> Coordinate -> Coordinate -> Maybe (Piece, Promotion_status) -> Coordinate -> Maybe (Piece, Promotion_status) -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_double abbrev colour source_coord target_coord target second_target_coord second_target = do
  let t = case target of
            Nothing -> Nothing
            Just (p, _) -> Just p
      t2 = case second_target of
            Nothing -> Nothing
            Just (p2, _) -> Just p2
      move = Double_move (Piece abbrev colour) source_coord target_coord t second_target_coord t2
  gs <- getState
  let new_state = update_from_move gs move
  case isJust new_state of
    True -> putState (fromJust new_state)
    False -> fail $ "Double move from " ++ (print_coordinate source_coord) ++ " is repetititious"

parse_igui :: Piece_type -> Coordinate -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_igui abbrev source_coord = do
  target_coord <- parse_coordinate
  gs@(ni_state, _) <- getState
  let colour = case is_black_to_play ni_state of
                 True -> Black
                 False -> White
      target = piece_at (board ni_state) (rank target_coord) (file target_coord)
  case target of
    Nothing -> fail ("no target piece at " ++ (print_coordinate target_coord))
    Just (t, _) | piece_colour t == colour -> fail "target is same colour as source"
                | otherwise -> do
                    let move = Igui (Piece abbrev colour) source_coord t target_coord
                        new_state = update_from_move gs move
                    case isJust new_state of
                      True -> putState (fromJust new_state)
                      False -> fail $ "Igui at " ++ (print_coordinate source_coord) ++ " is repetititious"

parse_pass :: Piece_type -> Coordinate -> Parsec String (Non_interactive_state, Maybe Move_stack) ()
parse_pass abbrev source_coord = do
  gs@(ni_state, _) <- getState
  let colour = case is_black_to_play ni_state of
                 True -> Black
                 False -> White
      move = Pass (Piece abbrev colour) source_coord
      new_state = update_from_move gs move
  case isJust new_state of
    True -> putState (fromJust new_state)
    False -> fail $ "Pass at " ++ (print_coordinate source_coord) ++ " is repetititious"

parse_integer :: Parsec String (Non_interactive_state, Maybe Move_stack) Int
parse_integer = read `liftM` many1 digit

parse_abbreviation :: Parsec String (Non_interactive_state, Maybe Move_stack) Piece_type
parse_abbreviation = do
  pr <- optionMaybe  (char '+')
  abbrev <- many1 letter
  let abbrev' = case pr of
                  Nothing -> abbrev
                  Just p -> p:abbrev
  case piece_from_abbreviation abbrev' of
    Nothing -> fail "not a valid piece abbreviation"
    Just p -> return p

parse_coordinate :: Parsec String (Non_interactive_state, Maybe Move_stack) Coordinate
parse_coordinate = do
  file' <- many1 digit
  rank' <- letter
  let rank_number = (ord rank') - (ord 'a')
      file_value = read file'
  case file_value - 1 of
    f | f >= 0 && f <= 11 ->
          case rank_number of
            r | r >= 0 && r <= 11 -> return (new_coordinate r f)
              | otherwise -> fail "bad rank"
      | otherwise -> fail "bad file number"
   
eol :: Parsec String (Non_interactive_state, Maybe Move_stack) String
eol = try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"