module PlayTak.Parser (parsePlayTak, PlayTakMsg(..)) where

import qualified Data.ByteString as BS
import Data.List
import Data.Maybe
import Text.Parsec hiding (char, string, space)
import qualified Text.Parsec as Parsec

import Tak

import PlayTak.Types

type Parser a = Parsec BS.ByteString () a

parsePlayTak :: BS.ByteString -> Either ParseError PlayTakMsg
parsePlayTak str = parse playtak "" str

playtak :: Parser PlayTakMsg
playtak = welcome
    <|> loginOrRegister
    <|> loggedIn
    <|> seek
    <|> online
    <|> shout
    <|> gameStart
    <|> game
    <|> gamelist
    <|> message
    <|> errorMsg
    <|> nok
    <|> ok

welcome :: Parser PlayTakMsg
welcome = try (string "Welcome!") >> return Welcome

loginOrRegister :: Parser PlayTakMsg
loginOrRegister = string "Login or Register" >> return PleaseLogin

loggedIn :: Parser PlayTakMsg
loggedIn = do
    try $ string "Welcome"
    space
    name <- username
    char '!'
    return $ LoggedIn name

seek :: Parser PlayTakMsg
seek = do
    try $ string "Seek"
    space
    s <- (string "new" >> return SeekNew)
        <|> (string "remove" >> return SeekRemove)
    space
    no <- int
    space
    name <- username
    space
    boardsize <- int
    space
    gameTime <- int
    return $ s no name boardsize gameTime

online :: Parser PlayTakMsg
online = do
    try $ string "Online"
    space
    name <- username
    return $ Online name

shout :: Parser PlayTakMsg
shout = do
    try $ string "Shout"
    space
    char '<'
    name <- username
    char '>'
    space
    msg <- many1 anyChar
    return $ Shout name msg
    
--Game Start no size player_white vs player_black your color
gameStart :: Parser PlayTakMsg
gameStart = do
    try $ string "Game Start"
    space
    gameno <- int
    space
    size <- int
    space
    p1 <- username
    space
    string "vs"
    space
    p2 <- username
    space
    c <- colour
    return $ GameStart gameno size p1 p2 c

game :: Parser PlayTakMsg
game = do
    try $ string "Game#"
    n <- int
    space
    place n <|> move n <|> time n <|> over n <|> offerDraw n <|> removeDraw n
        <|> resign n <|> requestUndo n <|> removeUndo n <|> undo n <|> abandon n

--Game#no P Sq C|W
place :: Int -> Parser PlayTakMsg
place gameno = do
    char 'P'
    space
    sq <- square
    stone <- option Flat $ space >> (cap <|> wall)
    return $ PlayMsg gameno $ Place stone sq
    where
        cap = char 'C' >> return Cap
        wall = char 'W' >> return Standing
    
--Game#no M Sq1 Sq2 no1 no2...
move :: Int -> Parser PlayTakMsg
move gameno = do
    char 'M'
    space
    sq1 <- square
    space
    sq2 <- square
    space
    drops <- int `sepBy1` space
    return $ PlayMsg gameno $ Move sq1 (dir sq2 sq1) drops
    where
        dir (i1, j1) (i2, j2) = dir' (signum $ i1 - i2) (signum $ j1 - j2)
        dir' 1 0 = PosX
        dir' (-1) 0 = NegX
        dir' 0 1 = PosY
        dir' 0 (-1) = NegY
        dir' _ _ = error "Not a legal direction"

--Game#no Time whitetime blacktime
time :: Int -> Parser PlayTakMsg
time gameno = do
    try $ string "Time"
    space
    whitetime <- int
    space
    blacktime <- int
    return $ Time gameno whitetime blacktime

--Game#no Over result
over :: Int -> Parser PlayTakMsg
over gameno = do
    try $ string "Over"
    space
    p1 <- score
    char '-'
    p2 <- score
    return $ Over gameno p1 p2
    where
        score = roadScore <|> flatScore <|> drawScore <|> zeroScore <|> abandonScore
        zeroScore = char '0' >> return ZeroScore
        roadScore = char 'R' >> return RoadScore
        flatScore = char 'F' >> return FlatScore
        drawScore = try (string "1/2") >> return DrawScore
        abandonScore = char '1' >> return AbandonScore

--Game#no OfferDraw
offerDraw :: Int -> Parser PlayTakMsg
offerDraw gameno = string "OfferDraw" >> return (OfferDraw gameno)

removeDraw :: Int -> Parser PlayTakMsg
removeDraw gameno = try (string "RemoveDraw") >> return (RemoveDraw gameno)

resign :: Int -> Parser PlayTakMsg
resign gameno = try (string "Resign") >> return (Resign gameno)

requestUndo :: Int -> Parser PlayTakMsg
requestUndo gameno = try (string "RequestUndo") >> return (RequestUndo gameno)

removeUndo :: Int -> Parser PlayTakMsg
removeUndo gameno = try (string "RemoveUndo") >> return (RemoveUndo gameno)

undo :: Int -> Parser PlayTakMsg
undo gameno = string "Undo" >> return (Undo gameno)

abandon :: Int -> Parser PlayTakMsg
abandon gameno = string "Abandoned" >> return (Abandon gameno)

message :: Parser PlayTakMsg
message = do
    string "Message"
    space
    text <- many anyChar
    return $ Message text

errorMsg :: Parser PlayTakMsg
errorMsg = do
    string "Error"
    space
    text <- many anyChar
    return $ ErrorMsg text

nok :: Parser PlayTakMsg
nok = string "NOK" >> return NOK

ok :: Parser PlayTakMsg
ok = try (string "OK") >> return OK

--GameList Add Game#no player_white vs player_black, sizexsize, original_time, moves half-moves played, player_name to move
gamelist :: Parser PlayTakMsg
gamelist = do
    try $ string "GameList"
    space
    proc <- (string "Add" >> return GameListAdd) <|>
        (string "Remove" >> return GameListRemove)
    space
    string "Game#"
    gameno <- int
    space
    p1 <- username
    space
    string "vs"
    space
    p2 <- username
    comma
    space
    size1 <- int
    char 'x'
    size2 <- int
    if size1 /= size2
        then error "Board is not square!"
        else return ()
    comma
    space
    gameTime <- int
    comma
    space
    seconds <- int
    comma
    space
    moves <- int
    space
    string "half-moves played"
    comma
    space
    nextPlayer <- username
    space
    string "to move"
    return $ proc gameno p1 p2 size1 gameTime seconds moves nextPlayer

username :: Parser String
username = many1 $ noneOf " <>!,"

comma :: Parser ()
comma = char ','

int :: Parser Int
int = do
    n <- many1 digit
    return $ read n

colour :: Parser Colour
colour = white <|> black where
    white = string "white" >> return White
    black = string "black" >> return Black

square :: Parser (Int, Int)
square = do
    rank <- oneOf letters
    file <- int
    return ((fromJust $ elemIndex rank letters) + 1, file)

letters :: String
letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

-- Versions of Parsec parsers that don't return a value.
char :: Char -> Parser ()
char c = Parsec.char c >> return ()

space :: Parser ()
space = Parsec.space >> return ()

string :: String -> Parser ()
string str = Parsec.string str >> return ()