87 , cmd1 "PING" $ Many [SS] |
87 , cmd1 "PING" $ Many [SS] |
88 , cmd2 "CHAT" SS LS |
88 , cmd2 "CHAT" SS LS |
89 , cmd2 "SERVER_VARS" SS LS |
89 , cmd2 "SERVER_VARS" SS LS |
90 , cmd2 "BYE" SS LS |
90 , cmd2 "BYE" SS LS |
91 , cmd1 "INFO" $ Many [SS] |
91 , cmd1 "INFO" $ Many [SS] |
92 , cmd1 "ROOM" $ Many [SS] |
92 , cmd1 "ROOM~ADD" $ Many [SS] |
|
93 , cmd1 "ROOM~UPD" $ Many [SS] |
|
94 , cmd1 "ROOM~DEL" SS |
93 , cmd1 "ROOMS" $ Many [SS] |
95 , cmd1 "ROOMS" $ Many [SS] |
94 , cmd "KICKED" [] |
96 , cmd "KICKED" [] |
95 , cmd "RUN_GAME" [] |
97 , cmd "RUN_GAME" [] |
96 , cmd "ROUND_FINISHED" [] |
98 , cmd "ROUND_FINISHED" [] |
97 ] |
99 ] |
125 maybeMerge c cmd@[PTCommand {}] = PTPrefix [c] cmd |
127 maybeMerge c cmd@[PTCommand {}] = PTPrefix [c] cmd |
126 maybeMerge c cmd@[PTPrefix s ss] = PTPrefix (c:s) ss |
128 maybeMerge c cmd@[PTPrefix s ss] = PTPrefix (c:s) ss |
127 maybeMerge c [] = PTPrefix [c] [] |
129 maybeMerge c [] = PTPrefix [c] [] |
128 cmdLeaf ([(c, hwc:assocs1)], assocs2) |
130 cmdLeaf ([(c, hwc:assocs1)], assocs2) |
129 | null assocs1 = PTPrefix [c] [hwc] : map buildsub assocs2 |
131 | null assocs1 = PTPrefix [c] [hwc] : map buildsub assocs2 |
130 | otherwise = [buildsub (c, assocs1)] ++ [PTPrefix [] [hwc]] ++ map buildsub assocs2 |
132 | otherwise = error "not supported" --[buildsub (c, assocs1)] ++ [PTPrefix [] [hwc]] ++ map buildsub assocs2 |
131 |
133 |
132 dumpTree = vcat . map dt |
134 dumpTree = vcat . map dt |
133 where |
135 where |
134 dt (PTPrefix s st) = text s $$ (nest 1 $ vcat $ map dt st) |
136 dt (PTPrefix s st) = text s $$ (nest 1 $ vcat $ map dt st) |
135 dt _ = empty |
137 dt _ = empty |
136 |
138 |
137 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray] |
139 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [grr, cmds, l, s, c, bodies, structs, realHandlers, realHandlersArray] |
138 where |
140 where |
139 maybeQuotes "$" = text "#0" |
141 maybeQuotes "$" = text "#0" |
|
142 maybeQuotes "~" = text "#10" |
140 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
143 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
141 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
144 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
142 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
145 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
143 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
146 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
144 <> parens (hsep . punctuate comma $ map text commands) <> semi |
147 <> parens (hsep . punctuate comma $ map text commands) <> semi |