# HG changeset patch # User unC0Rr # Date 1439561256 -10800 # Node ID 2edb24ed5ee0c39b23ade9035c834d4b37d12e37 # Parent 46482475af2b106f16258931952aa97140a00f28 Break it even more during refactoring diff -r 46482475af2b -r 2edb24ed5ee0 tools/protocolParser.hs --- a/tools/protocolParser.hs Wed Aug 12 17:30:14 2015 +0300 +++ b/tools/protocolParser.hs Fri Aug 14 17:07:36 2015 +0300 @@ -8,6 +8,12 @@ import qualified Data.Set as Set data HWProtocol = Command String [CmdParam] + +instance Ord HWProtocol where + (Command a _) `compare` (Command b _) = a `compare` b +instance Eq HWProtocol where + (Command a _) == (Command b _) = a == b + data CmdParam = Skip | SS | LS @@ -34,6 +40,14 @@ f LS = "L" f IntP = "i" f (Many p) = "" + +cmdParams2handlerType (Command _ p) = "handler_" ++ concatMap f p + where + f Skip = "_" + f SS = "S" + 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) @@ -68,7 +82,7 @@ , cmd2 "CLIENT_FLAGS" SS $ Many [SS] , cmd2 "LEFT" SS $ Many [SS] , cmd1 "SERVER_MESSAGE" LS - , cmd1 "ERROR" LS + , cmd1 "ERROR" LS -- not rendered? wth , cmd1 "NOTICE" LS , cmd1 "WARNING" LS , cmd1 "JOINING" SS @@ -119,13 +133,15 @@ renderArrays (letters, commands, handlers) = vcat $ punctuate (char '\n') [cmds, l, s, bodies, c, structs] where + maybeQuotes "$" = text "#0" maybeQuotes s = if null $ tail s then quotes $ text s else text s l = text "const letters: array[0.." <> (int $ length letters - 1) <> text "] of char = " <> parens (hsep . punctuate comma $ map maybeQuotes letters) <> semi s = text "const commands: array[0.." <> (int $ length commands - 1) <> text "] of integer = " <> parens (hsep . punctuate comma $ map text commands) <> semi c = text "const handlers: array[0.." <> (int $ length fixedNames - 1) <> text "] of PHandler = " - <> parens (hsep . punctuate comma $ map (text . (++) "@handler_") $ reverse fixedNames) <> semi + <> parens (hsep . punctuate comma $ map (text . (:) '@') handlerTypes) <> semi + handlerTypes = map cmdParams2handlerType . reverse $ sort commandsDescription fixedNames = map fixName handlers fixName = map fixChar fixChar c | isLetter c = c