# HG changeset patch
# User unc0rr
# Date 1448049949 -10800
# Node ID 4815e406a7607c106c6243d57040c1f569b15748
# Parent  78d6b99ddcb0ce87118504c4aed37be249d738a7
Fix losing commands

diff -r 78d6b99ddcb0 -r 4815e406a760 tools/protocolParser.hs
--- a/tools/protocolParser.hs	Thu Nov 19 23:32:28 2015 +0300
+++ b/tools/protocolParser.hs	Fri Nov 20 23:05:49 2015 +0300
@@ -8,6 +8,7 @@
 import qualified Data.Set as Set
 
 data HWProtocol = Command String [CmdParam]
+    deriving Show
 
 instance Ord HWProtocol where
     (Command a _) `compare` (Command b _) = a `compare` b    
@@ -19,13 +20,11 @@
               | LS
               | IntP
               | Many [CmdParam]
-data ClientStates = NotConnected
-                  | JustConnected
-                  | ServerAuth
-                  | Lobby
+    deriving Show
 
 data ParseTree = PTPrefix String [ParseTree]
                | PTCommand String HWProtocol
+    deriving Show
 
 cmd = Command
 cmd1 s p = Command s [p]
@@ -90,6 +89,7 @@
         , cmd2 "SERVER_VARS" SS LS
         , cmd2 "BYE" SS LS
         , cmd1 "INFO" $ Many [SS]
+        , cmd1 "ROOM" $ Many [SS]
         , cmd1 "ROOMS" $ Many [SS]
         , cmd "KICKED" []
         , cmd "RUN_GAME" []
@@ -123,23 +123,13 @@
         buildsub (c, cmds) = let st = bpt cmds in if null $ drop 1 st then maybeMerge c st else PTPrefix [c] st
         maybeMerge c cmd@[PTCommand {}] = PTPrefix [c] cmd
         maybeMerge c cmd@[PTPrefix s ss] = PTPrefix (c:s) ss
-        cmdLeaf ([(c, (hwc:_))], assocs2) = (PTPrefix [c] [hwc]) : map buildsub assocs2
+        cmdLeaf ([(c, (hwc:assocs1))], assocs2) = (PTPrefix [c] [hwc]) : (bpt assocs1 ++ map buildsub assocs2)
 
 dumpTree = vcat . map dt
     where
     dt (PTPrefix s st) = text s $$ (nest 1 $ vcat $ map dt st)
     dt _ = empty
 
-pas2 = buildSwitch $ buildParseTree commandsDescription
-    where
-        buildSwitch cmds = text "case getNextChar of" $$ (nest 4 . vcat $ map buildCase cmds) $$ elsePart
-        buildCase (PTCommand {}) = text "#10: <call cmd handler>;"
-        buildCase (PTPrefix (s:ss) cmds) = quotes (char s) <> text ": " <> consumePrefix ss (buildSwitch cmds)
-        consumePrefix "" = id
-        consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$)
-        zeroChar = text "#0: state:= pstDisconnected;"
-        elsePart = text "else <unknown cmd> end;"
-
 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray]
     where
         maybeQuotes "$" = text "#0"