Skip to content
Snippets Groups Projects
Commit a5e12ca0 authored by Jens Nolte's avatar Jens Nolte
Browse files

Move messageInstanceD out of where block

parent e36f2936
No related branches found
No related tags found
No related merge requests found
...@@ -102,23 +102,24 @@ interfaceDec interface = execWriterT do ...@@ -102,23 +102,24 @@ interfaceDec interface = execWriterT do
eConName (EventSpec event) = mkName $ "E_" <> interface.name <> "_" <> event.name eConName (EventSpec event) = mkName $ "E_" <> interface.name <> "_" <> event.name
eCon :: EventSpec -> Q Con eCon :: EventSpec -> Q Con
eCon event = normalC (eConName event) [] eCon event = normalC (eConName event) []
messageInstanceD :: Q Type -> [(MessageSpec, Name)] -> Q Dec
messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD, showMessageD, getMessageD, putMessageD] messageInstanceD :: Q Type -> [(MessageSpec, Name)] -> Q Dec
where messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD, showMessageD, getMessageD, putMessageD]
opcodeNameD :: Q Dec where
opcodeNameD = funD 'opcodeName (opcodeNameClauseD <$> messages) opcodeNameD :: Q Dec
opcodeNameClauseD :: (MessageSpec, Name) -> Q Clause opcodeNameD = funD 'opcodeName (opcodeNameClauseD <$> messages)
opcodeNameClauseD (msg, conName) = clause [litP (integerL (fromIntegral msg.opcode))] (normalB ([|Just $(stringE msg.name)|])) [] opcodeNameClauseD :: (MessageSpec, Name) -> Q Clause
showMessageD :: Q Dec opcodeNameClauseD (msg, conName) = clause [litP (integerL (fromIntegral msg.opcode))] (normalB ([|Just $(stringE msg.name)|])) []
showMessageD = funD 'showMessage (showMessageClauseD <$> messages) showMessageD :: Q Dec
showMessageClauseD :: (MessageSpec, Name) -> Q Clause showMessageD = funD 'showMessage (showMessageClauseD <$> messages)
showMessageClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) [] showMessageClauseD :: (MessageSpec, Name) -> Q Clause
getMessageD :: Q Dec showMessageClauseD (msg, conName) = clause [conP conName []] (normalB (stringE msg.name)) []
getMessageD = funD 'getMessage (getMessageClauseD <$> messages) getMessageD :: Q Dec
getMessageClauseD :: (MessageSpec, Name) -> Q Clause getMessageD = funD 'getMessage (getMessageClauseD <$> messages)
getMessageClauseD (msg, conName) = clause [[p|_object|], litP (integerL (fromIntegral msg.opcode))] (normalB ([|$(conE conName) <$ dropRemaining|])) [] getMessageClauseD :: (MessageSpec, Name) -> Q Clause
putMessageD :: Q Dec getMessageClauseD (msg, conName) = clause [[p|_object|], litP (integerL (fromIntegral msg.opcode))] (normalB ([|$(conE conName) <$ dropRemaining|])) []
putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []] putMessageD :: Q Dec
putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []]
interfaceN :: InterfaceSpec -> Name interfaceN :: InterfaceSpec -> Name
interfaceN interface = mkName $ "I_" <> interface.name interfaceN interface = mkName $ "I_" <> interface.name
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment