module ParseTeam

where

import System.Directory
import System.FilePath

import FRP.Yampa.Geometry

import Control.Monad
import BasicTypes
import Rules

setupBasicFiles :: IO ()
setupBasicFiles = do
   dir <- getAppUserDataDirectory "Rasenschach"
   createDirectoryIfMissing False dir
   homeExists <- doesFileExist $ dir </> "home.team"
   when (not homeExists) $
    writeFile (dir </> "home.team") basicSetup
   awayExists <- doesFileExist $ dir </> "away.team"
   when (not awayExists) $
    writeFile (dir </> "away.team") basicSetup

getTeam :: FilePath -> IO (Either (ParseErrorId, ParseErrorMsg) ([PlayerInfo], [Rule]))
getTeam fn = do
    input <- readFile fn
    case parseFile (map removeComment $ lines input) 1 of
      err@(Left _) -> return err
      Right (players, rules) -> return $ Right (players, basicRules ++ rules)

-- comments start Haskell-like with --
removeComment :: String -> String
removeComment [] = []
removeComment [x] = [x]
removeComment ('-':'-':_) = []
removeComment (x:xs) = x:(removeComment xs)

parseFile :: [String] -> Int -> Either (ParseErrorId, ParseErrorMsg)
                                       ([PlayerInfo], [Rule])
parseFile [] _ = Right ([], [])
parseFile ls counter =
    if null tokens then parseFile (tail ls) counter
    else if head tokens == "player" then do
            pi' <- parsePlayer (head ls)
            (pis, rs) <- parseFile (tail ls) counter
            return (pi':pis, rs)
    else if head tokens == "rule" then do
            (ruleLines, rest) <- grabRule ls []
            (name, prio, clauses, msg) <- parseRule ruleLines
            let ruleFunction = runner clauses msg
            let rule = Rule (RuleId counter) name (Priority prio) ruleFunction
            (pis, rs) <- parseFile rest (counter + 1)
            return (pis, rule:rs)
    else Left (93,"parser error")
    where tokens = words . head $ ls

grabRule :: [String] -> [String] -> Either (ParseErrorId, ParseErrorMsg)
                                           ([String], [String])
grabRule [] _ = Left (91, "unexpected end of rule")
grabRule ls acc =
    if (head $ words $ head ls) == "send" then
        return (reverse (head ls : acc), tail ls)
    else
        grabRule (tail ls) (head ls : acc)


-- let x = grabRule ["hallo", "hier fehlt", "das", "Ende"]

parsePlayer :: String ->
                 Either (ParseErrorId, ParseErrorMsg)
                 PlayerInfo
parsePlayer pString = do
    let tokens = words pString
    checkPlayerStructure tokens
    numberOnJersey <- parseInt (tokens !! 1)
    role <- checkRole (tokens !! 2)
    (defX, defY) <- checkDefense (tokens !! 4) (tokens !! 5)
    (offX, offY) <- checkOffense (tokens !! 7) (tokens !! 8)
    speed <- parseDouble (tokens !! 10)
    acc <- parseDouble (tokens !! 12)
    cover <- parseDouble (tokens !! 14)
    return $ PlayerInfo numberOnJersey role (Point2 defX defY) (Point2 offX offY) speed acc cover

checkPlayerStructure :: Num t => [String] -> Either (t, String) ()
checkPlayerStructure tokens =
    if length tokens /= 15 ||
       tokens !! 0 /= "player" ||
       tokens !! 3 /= "defense" ||
       tokens !! 6 /= "offense" ||
       tokens !! 9 /= "speed" ||
       tokens !! 11 /= "acc" ||
       tokens !! 13 /= "cover"
    then Left (100, "player clause must be of form 'player <x> <position> offense <x> <x> defense <x> <x> speed <x> acc <x> cover <x>', was: " ++
                    concat (zipWith (++) tokens (repeat " ")))
    else Right ()

checkRole :: Num t => String -> Either (t, String) PlayerRole
checkRole pos
    | pos == "goalie" = Right Goalie
    | pos == "defender" = Right Defender
    | pos == "midfielder" = Right Midfielder
    | pos == "forward" = Right Forward
    | otherwise = Left (101, "position must be goalie, defender, midfielder or forward, was: " ++ pos)

checkOffense :: String -> String -> Either (ParseErrorId, ParseErrorMsg) (Double, Double)
checkOffense x y = do
    x' <- parseDouble x
    y' <- parseDouble y
    return (x',y')

checkDefense :: String -> String -> Either (ParseErrorId, ParseErrorMsg) (Double, Double)
checkDefense = checkOffense

parseDouble :: String -> Either (ParseErrorId, ParseErrorMsg) Double
parseDouble x =
    if null (reads x :: [(Double, String)]) then
        Left (99, "not a float: " ++ x)
    else Right $ fst $ head (reads x)

parseInt :: String -> Either (ParseErrorId, ParseErrorMsg) Int
parseInt x =
    if null (reads x :: [(Int, String)]) then
        Left (99, "not an integer: " ++ x)
    else Right $ fst $ head (reads x)

-- player 17 goalie  offense 17 18 defense 18 29 speed 17.1 acc 17.3 cover 0.2
-- ...
--
-- rule ...
-- send ...
--
-- rule ...
-- send ...
--
--
t1 :: IO String
t1 = readFile "team.txt"

p' :: IO ()
p' = do
   ps <- t1
   print $ grabRule (lines ps) []

p :: Int -> IO ()
p x = do
   ps <- t1
   print $ parseFile (lines ps) x



basicSetup :: String
basicSetup = "player 10 forward defense 42 55 offense 60 15 speed 10.0 acc 15.0 cover 0.1\n \
player 11 forward defense 20 70 offense 30 15 speed 10.0 acc 15.0 cover 0.1\n \
player 9 forward defense 30 60 offense 35 50 speed 10.0 acc 15.0 cover 0.1\n \
player 8 forward defense 42 70 offense 10 30 speed 10.0 acc 15.0 cover 0.1\n \
player 7 forward defense 52 60 offense 35 30 speed 10.0 acc 15.0 cover 0.1\n \
player 6 forward defense 62 70 offense 45 30 speed 10.0 acc 15.0 cover 0.1\n \
player 5 forward defense 10 90 offense 70 30 speed 10.0 acc 15.0 cover 0.1\n \
player 4 forward defense 30 90 offense 10 55 speed 10.0 acc 15.0 cover 0.1\n \
player 3 forward defense 51 90 offense 35 55 speed 10.0 acc 15.0 cover 0.1\n \
player 2 forward defense 73 90 offense 45 55 speed 10.0 acc 15.0 cover 0.1\n \
player 1 goalie  defense 40 90 offense 40 90 speed 10.0 acc 15.0 cover 0.1\n \
\n \
rule shoot priority 5\n \
   att is factAttacking\n \
   me is factWhoAmI\n \
   check factEq att me\n \
   ballCarrier is factBallCarrier\n \
   goalVector is factBestShootingVector\n \
send msgKick ballCarrier goalVector\n \
\n \
rule pass priority 5\n \
   att is factAttacking\n \
   me is factWhoAmI\n \
   check factEq att me\n \
   ballCarrier is factBallCarrier\n \
   passVector is factBestPassingVector\n \
send msgKick ballCarrier passVector\n \
\n \
rule get_ball priority 5\n \
   me is factWhoAmI\n \
   ballSpot is factBallIsFree\n \
   np is factNearestAIPlayer me ballSpot\n \
send msgIntercept np ballSpot\n \
\n \
rule pass_to_free priority 5\n \
    att is factAttacking\n \
    me is factWhoAmI\n \
    check factEq att me\n \
    bcId is factBallCarrier\n \
    bcSpot is factPlayerSpot bcId\n \
    bcValue is factSpotValue bcSpot\n \
    recId is factBestFreePlayer\n \
    recSpot is factPlayerSpot recId\n \
    recValue is factSpotValue recSpot\n \
    check factGT recValue bcValue\n \
send msgPassTo bcId recId"