tools/protocolParser.hs
branchqmlfrontend
changeset 10902 29519fe63fdd
parent 10900 6a805e822074
child 10904 ce265b038220
equal deleted inserted replaced
10900:6a805e822074 10902:29519fe63fdd
     1 module Main where
     1 module Main where
     2 
     2 
     3 import Text.PrettyPrint.HughesPJ
     3 import Text.PrettyPrint.HughesPJ
     4 import Data.Tree
       
     5 
     4 
     6 data HWProtocol = Command String [CmdParam]
     5 data HWProtocol = Command String [CmdParam]
     7 data CmdParam = Skip
     6 data CmdParam = Skip
     8               | SS
     7               | SS
     9               | LS
     8               | LS
    12 data ClientStates = NotConnected
    11 data ClientStates = NotConnected
    13                   | JustConnected
    12                   | JustConnected
    14                   | ServerAuth
    13                   | ServerAuth
    15                   | Lobby
    14                   | Lobby
    16 
    15 
       
    16 data ParseTree = PTChar Char [ParseTree]
       
    17                | PTCommand HWProtocol
       
    18 
    17 cmd = Command
    19 cmd = Command
    18 cmd1 s p = Command s [p]
    20 cmd1 s p = Command s [p]
    19 cmd2 s p1 p2 = Command s [p1, p2]
    21 cmd2 s p1 p2 = Command s [p1, p2]
       
    22 
       
    23 breakCmd (Command (c:cs) params) = (c, Command cs params)
    20 
    24 
    21 commands = [
    25 commands = [
    22         cmd "CONNECTED" [Skip, IntP]
    26         cmd "CONNECTED" [Skip, IntP]
    23         , cmd1 "NICK" SS
    27         , cmd1 "NICK" SS
    24         , cmd1 "PROTO" IntP
    28         , cmd1 "PROTO" IntP
    25         , cmd1 "ASKPASSWORD" SS
    29         , cmd1 "ASKPASSWORD" SS
    26         , cmd1 "SERVER_AUTH" SS
    30         , cmd1 "SERVER_AUTH" SS
    27         , cmd1 "LOBBY:JOINED" $ Many [SS]
    31         , cmd1 "LOBBY:JOINED" $ Many [SS]
       
    32         , cmd2 "LOBBY:LEFT" $ SS SS
       
    33         , cmd2 "CLIENT_FLAGS" $ SS $ Many [SS]
       
    34         , cmd1 "SERVER_MESSAGE" LS
    28     ]
    35     ]
       
    36 
       
    37 
    29 
    38 
    30 pas = 
    39 pas = 
    31     
    40     
    32 main = putStrLn $ render pas
    41 main = putStrLn $ render pas