# HG changeset patch
# User unc0rr
# Date 1430252772 -10800
# Node ID ce265b038220240c760df1ca45649e414df49026
# Parent  29519fe63fdd0c016bff21c2757894765b3d22c9
Some more work on network client implementation

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