14 data ClientStates = NotConnected |
14 data ClientStates = NotConnected |
15 | JustConnected |
15 | JustConnected |
16 | ServerAuth |
16 | ServerAuth |
17 | Lobby |
17 | Lobby |
18 |
18 |
19 data ParseTree = PTChar Char [ParseTree] |
19 data ParseTree = PTPrefix String [ParseTree] |
20 | PTCommand HWProtocol |
20 | PTCommand HWProtocol |
21 |
21 |
22 cmd = Command |
22 cmd = Command |
23 cmd1 s p = Command s [p] |
23 cmd1 s p = Command s [p] |
24 cmd2 s p1 p2 = Command s [p1, p2] |
24 cmd2 s p1 p2 = Command s [p1, p2] |
53 |
53 |
54 buildParseTree cmds = if isJust emptyNamed then cmdLeaf $ fromJust emptyNamed else subtree |
54 buildParseTree cmds = if isJust emptyNamed then cmdLeaf $ fromJust emptyNamed else subtree |
55 where |
55 where |
56 emptyNamed = find (\(_, (Command n _:_)) -> null n) assocs |
56 emptyNamed = find (\(_, (Command n _:_)) -> null n) assocs |
57 assocs = groupByFirstChar cmds |
57 assocs = groupByFirstChar cmds |
58 subtree = map (\(c, cmds) -> PTChar c $ buildParseTree cmds) assocs |
58 subtree = map buildsub assocs |
59 cmdLeaf (c, (hwc:_)) = [PTChar c [PTCommand hwc]] |
59 buildsub (c, cmds) = let st = buildParseTree cmds in if null $ drop 1 st then maybeMerge c st else PTPrefix [c] st |
|
60 maybeMerge c cmd@[PTCommand _] = PTPrefix [c] cmd |
|
61 maybeMerge c cmd@[PTPrefix s ss] = PTPrefix (c:s) ss |
|
62 cmdLeaf (c, (hwc:_)) = [PTPrefix [c] [PTCommand hwc]] |
60 |
63 |
61 dumpTree (PTChar c st) = char c $$ (nest 2 $ vcat $ map dumpTree st) |
64 dumpTree = vcat . map dt |
62 dumpTree _ = empty |
65 where |
|
66 dt (PTPrefix s st) = text s $$ (nest 1 $ vcat $ map dt st) |
|
67 dt _ = empty |
63 |
68 |
64 pas = vcat . map dumpTree $ buildParseTree commands |
69 pas = buildSwitch $ buildParseTree commands |
65 |
70 where |
|
71 buildSwitch cmds = text "case getNextChar of" $$ (nest 4 . vcat $ map buildCase cmds) $$ elsePart |
|
72 buildCase (PTCommand _ ) = text "#10: <call cmd handler>;" |
|
73 buildCase (PTPrefix (s:ss) cmds) = quotes (char s) <> text ": " <> consumePrefix ss (buildSwitch cmds) |
|
74 consumePrefix "" = id |
|
75 consumePrefix str = (text "consume" <> (parens . quotes $ text str) <> semi $$) |
|
76 zeroChar = text "#0: state:= pstDisconnected;" |
|
77 elsePart = text "else <unknown cmd> end;" |
|
78 |
66 main = putStrLn $ render pas |
79 main = putStrLn $ render pas |