# HG changeset patch
# User unc0rr
# Date 1439644980 -10800
# Node ID 9b7c8c5a94e04cd818b862d7e8b2fda9497ccf10
# Parent  2edb24ed5ee0c39b23ade9035c834d4b37d12e37
Some fixes

diff -r 2edb24ed5ee0 -r 9b7c8c5a94e0 tools/protocolParser.hs
--- a/tools/protocolParser.hs	Fri Aug 14 17:07:36 2015 +0300
+++ b/tools/protocolParser.hs	Sat Aug 15 16:23:00 2015 +0300
@@ -31,8 +31,6 @@
 cmd1 s p = Command s [p]
 cmd2 s p1 p2 = Command s [p1, p2]
 
-breakCmd (PTCommand (c:cs) params) = (c, PTCommand cs params)
-
 cmdParams2str (Command _ p) = "TCmdParam" ++ concatMap f p
     where
     f Skip = ""
@@ -48,7 +46,7 @@
     f LS = "L"
     f IntP = "i"
     f (Many p) = 'M' : concatMap f p
-    
+
 cmdParams2record cmd@(Command _ p) = renderStyle style{lineLength = 80} $ 
     text "type " <> text (cmdParams2str cmd)
     <> text " = record" $+$ nest 4 (
@@ -82,10 +80,9 @@
         , cmd2 "CLIENT_FLAGS" SS $ Many [SS]
         , cmd2 "LEFT" SS $ Many [SS]
         , cmd1 "SERVER_MESSAGE" LS
-        , cmd1 "ERROR" LS -- not rendered? wth
+        , cmd1 "ERROR" LS
         , cmd1 "NOTICE" LS
         , cmd1 "WARNING" LS
-        , cmd1 "JOINING" SS
         , cmd1 "EM" $ Many [LS]
         , cmd1 "PING" $ Many [SS]
         , cmd2 "CHAT" SS LS
@@ -102,19 +99,21 @@
 
 groupByFirstChar :: [ParseTree] -> [(Char, [ParseTree])]
 groupByFirstChar = MM.assocs . MM.fromList . map breakCmd
+    where
+    breakCmd (PTCommand (c:cs) params) = (c, PTCommand cs params)
 
 makePT cmd@(Command n p) = PTCommand n cmd
 
 buildParseTree cmds = [PTPrefix "!" $ (bpt $ map makePT cmds) ++ [unknowncmd]]
-bpt cmds = if isJust emptyNamed then cmdLeaf $ fromJust emptyNamed else subtree
+bpt cmds = if not . null $ fst emptyNamed then cmdLeaf emptyNamed else subtree
     where
-        emptyNamed = find (\(_, (PTCommand n _:_)) -> null n) assocs
+        emptyNamed = partition (\(_, (PTCommand n _:_)) -> null n) assocs
         assocs = groupByFirstChar cmds
         subtree = map buildsub assocs
         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:_)) = [PTPrefix [c] [hwc]]
+        cmdLeaf ([(c, (hwc:_))], assocs2) = (PTPrefix [c] [hwc]) : map buildsub assocs2
 
 dumpTree = vcat . map dt
     where
@@ -163,4 +162,6 @@
         lvldown (lc, s1:s2:sh, pc, tbl1, t:tbl2, t31:t32:tbl3) = (lc, s1+s2:sh, pc, tbl1, (if null t32 then "0" else show s1):tbl2, (t31 ++ t32):tbl3)
         fpf c (lc, s:sh, pc, tbl1, tbl2, tbl3) = (lc + 1, s+1:sh, pc, [c]:tbl1, "0":tbl2, tbl3)
 
-main = putStrLn $ renderStyle style{lineLength = 80} pas
+main =
+    putStrLn $ renderStyle style{lineLength = 80} $ pas
+    --putStrLn $ renderStyle style{lineLength = 80} $ dumpTree $ buildParseTree commandsDescription