26 cmd "CONNECTED" [Skip, IntP] |
29 cmd "CONNECTED" [Skip, IntP] |
27 , cmd1 "NICK" SS |
30 , cmd1 "NICK" SS |
28 , cmd1 "PROTO" IntP |
31 , cmd1 "PROTO" IntP |
29 , cmd1 "ASKPASSWORD" SS |
32 , cmd1 "ASKPASSWORD" SS |
30 , cmd1 "SERVER_AUTH" SS |
33 , cmd1 "SERVER_AUTH" SS |
|
34 , cmd1 "JOINING" SS |
|
35 , cmd1 "BANLIST" $ Many [SS] |
|
36 , cmd1 "JOINED" $ Many [SS] |
31 , cmd1 "LOBBY:JOINED" $ Many [SS] |
37 , cmd1 "LOBBY:JOINED" $ Many [SS] |
32 , cmd2 "LOBBY:LEFT" $ SS SS |
38 , cmd2 "LOBBY:LEFT" SS LS |
33 , cmd2 "CLIENT_FLAGS" $ SS $ Many [SS] |
39 , cmd2 "CLIENT_FLAGS" SS $ Many [SS] |
|
40 , cmd2 "LEFT" SS $ Many [SS] |
34 , cmd1 "SERVER_MESSAGE" LS |
41 , cmd1 "SERVER_MESSAGE" LS |
|
42 , cmd1 "EM" $ Many [LS] |
|
43 , cmd1 "PING" $ Many [SS] |
|
44 , cmd2 "CHAT" SS LS |
|
45 , cmd2 "SERVER_VARS" SS LS |
|
46 , cmd2 "BYE" SS LS |
|
47 , cmd "INFO" [SS, SS, SS, SS] |
|
48 , cmd "KICKED" [] |
35 ] |
49 ] |
36 |
50 |
|
51 groupByFirstChar :: [HWProtocol] -> [(Char, [HWProtocol])] |
|
52 groupByFirstChar = MM.assocs . MM.fromList . map breakCmd |
37 |
53 |
|
54 buildParseTree cmds = if isJust emptyNamed then cmdLeaf $ fromJust emptyNamed else subtree |
|
55 where |
|
56 emptyNamed = find (\(_, (Command n _:_)) -> null n) assocs |
|
57 assocs = groupByFirstChar cmds |
|
58 subtree = map (\(c, cmds) -> PTChar c $ buildParseTree cmds) assocs |
|
59 cmdLeaf (c, (hwc:_)) = [PTChar c [PTCommand hwc]] |
38 |
60 |
39 pas = |
61 dumpTree (PTChar c st) = char c $$ (nest 2 $ vcat $ map dumpTree st) |
|
62 dumpTree _ = empty |
|
63 |
|
64 pas = vcat . map dumpTree $ buildParseTree commands |
40 |
65 |
41 main = putStrLn $ render pas |
66 main = putStrLn $ render pas |