32 f Skip = "" |
38 f Skip = "" |
33 f SS = "S" |
39 f SS = "S" |
34 f LS = "L" |
40 f LS = "L" |
35 f IntP = "i" |
41 f IntP = "i" |
36 f (Many p) = "" |
42 f (Many p) = "" |
|
43 |
|
44 cmdParams2handlerType (Command _ p) = "handler_" ++ concatMap f p |
|
45 where |
|
46 f Skip = "_" |
|
47 f SS = "S" |
|
48 f LS = "L" |
|
49 f IntP = "i" |
|
50 f (Many p) = 'M' : concatMap f p |
37 |
51 |
38 cmdParams2record cmd@(Command _ p) = renderStyle style{lineLength = 80} $ |
52 cmdParams2record cmd@(Command _ p) = renderStyle style{lineLength = 80} $ |
39 text "type " <> text (cmdParams2str cmd) |
53 text "type " <> text (cmdParams2str cmd) |
40 <> text " = record" $+$ nest 4 ( |
54 <> text " = record" $+$ nest 4 ( |
41 vcat (map (uncurry f) $ zip [1..] $ filter isRendered p) |
55 vcat (map (uncurry f) $ zip [1..] $ filter isRendered p) |
66 , cmd1 "LOBBY:JOINED" $ Many [SS] |
80 , cmd1 "LOBBY:JOINED" $ Many [SS] |
67 , cmd2 "LOBBY:LEFT" SS LS |
81 , cmd2 "LOBBY:LEFT" SS LS |
68 , cmd2 "CLIENT_FLAGS" SS $ Many [SS] |
82 , cmd2 "CLIENT_FLAGS" SS $ Many [SS] |
69 , cmd2 "LEFT" SS $ Many [SS] |
83 , cmd2 "LEFT" SS $ Many [SS] |
70 , cmd1 "SERVER_MESSAGE" LS |
84 , cmd1 "SERVER_MESSAGE" LS |
71 , cmd1 "ERROR" LS |
85 , cmd1 "ERROR" LS -- not rendered? wth |
72 , cmd1 "NOTICE" LS |
86 , cmd1 "NOTICE" LS |
73 , cmd1 "WARNING" LS |
87 , cmd1 "WARNING" LS |
74 , cmd1 "JOINING" SS |
88 , cmd1 "JOINING" SS |
75 , cmd1 "EM" $ Many [LS] |
89 , cmd1 "EM" $ Many [LS] |
76 , cmd1 "PING" $ Many [SS] |
90 , cmd1 "PING" $ Many [SS] |
117 zeroChar = text "#0: state:= pstDisconnected;" |
131 zeroChar = text "#0: state:= pstDisconnected;" |
118 elsePart = text "else <unknown cmd> end;" |
132 elsePart = text "else <unknown cmd> end;" |
119 |
133 |
120 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, bodies, c, structs] |
134 renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, bodies, c, structs] |
121 where |
135 where |
|
136 maybeQuotes "$" = text "#0" |
122 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
137 maybeQuotes s = if null $ tail s then quotes $ text s else text s |
123 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
138 l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " |
124 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
139 <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi |
125 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
140 s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " |
126 <> parens (hsep . punctuate comma $ map text commands) <> semi |
141 <> parens (hsep . punctuate comma $ map text commands) <> semi |
127 c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " |
142 c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " |
128 <> parens (hsep . punctuate comma $ map (text . (++) "@handler_") $ reverse fixedNames) <> semi |
143 <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi |
|
144 handlerTypes = map cmdParams2handlerType . reverse $ sort commandsDescription |
129 fixedNames = map fixName handlers |
145 fixedNames = map fixName handlers |
130 fixName = map fixChar |
146 fixName = map fixChar |
131 fixChar c | isLetter c = c |
147 fixChar c | isLetter c = c |
132 | otherwise = '_' |
148 | otherwise = '_' |
133 bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames |
149 bodies = vcat $ punctuate (char '\n') $ map handlerBody fixedNames |