module ParseTeam
where
import System.Directory
import System.FilePath
import FRP.Yampa.Geometry
import Control.Monad
import BasicTypes
import Rules
import Data.List
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 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 ('-':'-':xs) = []
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 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 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 = 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 = readFile "team.txt"
p' = do
ps <- t1
print $ grabRule (lines ps) []
p x = do
ps <- t1
print $ parseFile (lines ps) x
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 \
passVector is factGetVector bcSpot recSpot\n \
send msgKick bcId passVector"