forked from janernsting/maexchen
-
Notifications
You must be signed in to change notification settings - Fork 0
/
MessageParser.hs
53 lines (36 loc) · 1.1 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
module MessageParser ( parseCommand ) where
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as T
import Text.ParserCombinators.Parsec.Language
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Command
parseCommand :: BS.ByteString -> Command
parseCommand = runParser commandParser
runParser :: Parser a -> BS.ByteString -> a
runParser p str = case parse p "" (BSC.unpack str) of
Left err -> error $ "parse error at " ++ (show err)
Right val -> val
commandParser :: Parser Command
commandParser = roundStartingP
<|> yourTurnP
<|> unknownP
<?> "Parse error"
roundStartingP = do
try $ symbolP "ROUND STARTING"
semiP
token <- tokenP
return $ RoundStarting token
yourTurnP = do
try $ symbolP "YOUR TURN"
semiP
token <- tokenP
return $ YourTurn token
unknownP = do
unknownCommand <- lineP
return $ Unknown unknownCommand
lexer = T.makeTokenParser emptyDef
lineP = many $ noneOf "\n"
semiP = T.semi lexer
tokenP = many $ noneOf ";"
symbolP = T.symbol lexer