-
Notifications
You must be signed in to change notification settings - Fork 2
/
MessageParser.hs
143 lines (117 loc) · 3.37 KB
/
MessageParser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
module MessageParser where
import Text.ParserCombinators.Parsec
import qualified Types as T
match c p = char c >> spaces >> return p
parseMessage s = fromRight $ parse message "" s
message = initialization <|> telemetry <|> bounce <|> craterKill <|> martianKill <|> successMessage <|> endMessage
-- Note: These are wrong because we don't consume all the input for each of
-- these messages, but because we only parse what we can and throw the rest
-- away, we never get burned.
bounce = match 'B' T.Bounce
craterKill = match 'C' T.CraterKill
martianKill = match 'K' T.MartianKill
successMessage = match 'S' T.Success
endMessage = match 'E' T.End
initialization = do
match 'I' ()
dx <- double
dy <- double
timeLimit <- int
minSensor <- double
maxSensor <- double
maxSpeed <- double
maxTurn <- double
maxHardTurn <- double
return $ T.Init (T.I {
T.dx = dx,
T.dy = dy,
T.timeLimit = timeLimit,
T.minSensor = minSensor,
T.maxSensor = maxSensor,
T.maxSpeed = maxSpeed,
T.maxTurn = maxTurn,
T.maxHardTurn = maxHardTurn})
telemetry
= do
match 'T' ()
timeStamp <- int
vehicleSt <- vehicleState
things <- many objOrMartian
let martians = [fromLeft x | x <- things, isLeft x]
let objects = [fromRight x | x <- things, isRight x]
return $ T.Telem (T.T {
T.timeStamp = timeStamp,
T.vehicleState = vehicleSt,
T.objects = objects,
T.martians = martians})
vehicleState = do
vehicleCtl <- vehicleControl
vehicleX <- double
vehicleY <- double
vehicleDir <- double
vehicleSpeed <- double
return $ T.VS {
T.vehicleCtl = vehicleCtl,
T.vehicleX = vehicleX,
T.vehicleY = vehicleY,
T.vehicleDir = vehicleDir,
T.vehicleSpeed = vehicleSpeed}
vehicleControl
= do
vcAcc <- acceleration
vcDir <- direction
return $ T.VC {
T.vcAcc = vcAcc,
T.vcDir = vcDir}
acceleration = match 'a' T.Accelerate
<|> match 'b' T.Brake
<|> match '-' T.Roll
direction = match 'L' T.HardLeft
<|> match 'l' T.Left
<|> match '-' T.Straight
<|> match 'r' T.Right
<|> match 'R' T.HardRight
objOrMartian = martian <+> object
object
= do
kind <- objectKind
objectX <- double
objectY <- double
objectR <- double
return $ T.Object {
T.objectKind = kind,
T.objectX = objectX,
T.objectY = objectY,
T.objectR = objectR}
objectKind = match 'b' T.Boulder
<|> match 'c' T.Crater
<|> match 'h' T.Home
martian = do
match 'm' ()
martianX <- double
martianY <- double
martianDir <- double
martianSpeed <- double
return $ T.Martian {
T.martianX = martianX,
T.martianY = martianY,
T.martianDir = martianDir,
T.martianSpeed = martianSpeed}
double = do
sign <- option "" (string "-")
ds1 <- many1 digit
char '.'
ds2 <- many1 digit
spaces
return $ (read (sign ++ ds1 ++ "." ++ ds2)::Double)
int = do
sign <- option "" (string "-")
ds <- many1 digit
spaces
return $ (read (sign ++ ds)::Int)
p1 <+> p2 = (p1 >>= (return . Left)) <|> (p2 >>= (return . Right))
fromLeft (Left x) = x
fromRight (Right x) = x
isLeft (Left _) = True
isLeft (Right _) = False
isRight = not . isLeft