diff -r 29519fe63fdd -r ce265b038220 tools/protocolParser.hs --- a/tools/protocolParser.hs Tue Apr 28 11:49:48 2015 +0300 +++ b/tools/protocolParser.hs Tue Apr 28 23:26:12 2015 +0300 @@ -1,6 +1,9 @@ module Main where import Text.PrettyPrint.HughesPJ +import qualified Data.MultiMap as MM +import Data.Maybe +import Data.List data HWProtocol = Command String [CmdParam] data CmdParam = Skip @@ -28,14 +31,36 @@ , cmd1 "PROTO" IntP , cmd1 "ASKPASSWORD" SS , cmd1 "SERVER_AUTH" SS + , cmd1 "JOINING" SS + , cmd1 "BANLIST" $ Many [SS] + , cmd1 "JOINED" $ Many [SS] , cmd1 "LOBBY:JOINED" $ Many [SS] - , cmd2 "LOBBY:LEFT" $ SS SS - , cmd2 "CLIENT_FLAGS" $ SS $ Many [SS] + , cmd2 "LOBBY:LEFT" SS LS + , cmd2 "CLIENT_FLAGS" SS $ Many [SS] + , cmd2 "LEFT" SS $ Many [SS] , cmd1 "SERVER_MESSAGE" LS + , cmd1 "EM" $ Many [LS] + , cmd1 "PING" $ Many [SS] + , cmd2 "CHAT" SS LS + , cmd2 "SERVER_VARS" SS LS + , cmd2 "BYE" SS LS + , cmd "INFO" [SS, SS, SS, SS] + , cmd "KICKED" [] ] - +groupByFirstChar :: [HWProtocol] -> [(Char, [HWProtocol])] +groupByFirstChar = MM.assocs . MM.fromList . map breakCmd -pas = +buildParseTree cmds = if isJust emptyNamed then cmdLeaf $ fromJust emptyNamed else subtree + where + emptyNamed = find (\(_, (Command n _:_)) -> null n) assocs + assocs = groupByFirstChar cmds + subtree = map (\(c, cmds) -> PTChar c $ buildParseTree cmds) assocs + cmdLeaf (c, (hwc:_)) = [PTChar c [PTCommand hwc]] + +dumpTree (PTChar c st) = char c $$ (nest 2 $ vcat $ map dumpTree st) +dumpTree _ = empty + +pas = vcat . map dumpTree $ buildParseTree commands main = putStrLn $ render pas