ParsePTN.hs

module Tak.ParsePTN (parsePtn) where

import Data.List
import Data.Maybe
import Text.Parsec
import Safe

import Tak.Types

parsePtn :: String -> Either ParseError Play
parsePtn str = parse ptn "" str

type Parser a = Parsec String () a

ptn :: Parser Play
ptn = try move <|> place

place :: Parser Play
place = do
    ms <- optionMaybe stone
    (x, y) <- loc
    return $ Place (fromJustDef Flat ms) (x, y)

move :: Parser Play
move = do
    mc <- optionMaybe int
    (x, y) <- loc
    d <- dir
    drops <- many int
    let drops' = case drops of
            [] -> case mc of
                Nothing -> [1]
                Just c -> [c]
            _ -> drops
    optional $ stone >> return ()
    return $ Move (x, y) d drops'

dir :: Parser Dir
dir = posx <|> negx <|> posy <|> negy where
    posx = char '>' >> return PosX
    negx = char '<' >> return NegX
    posy = char '+' >> return PosY
    negy = char '-' >> return NegY

stone :: Parser Stone
stone = flat <|> standing <|> cap where
    flat = char 'F' >> return Flat
    standing = char 'S' >> return Standing
    cap = char 'C' >> return Cap

loc :: Parser (Int, Int)
loc = do
    r <- rank
    f <- file
    return (r, f)

rank :: Parser Int
rank = do
    let chars = "abcdefghijklmnopqrstuvwxyz" 
    c <- oneOf chars
    return $ (fromJust $ elemIndex c chars) + 1

file :: Parser Int
file = int

int :: Parser Int
int = do
    i <- digit
    return $ read [i]