diff --git a/src/Quasar/Wayland/Protocol/TH.hs b/src/Quasar/Wayland/Protocol/TH.hs index 6e51367c4fb629470579686824ecdda4ff034f32..840ce0554f6a8f76e344f9bc5cfd759754b894d7 100644 --- a/src/Quasar/Wayland/Protocol/TH.hs +++ b/src/Quasar/Wayland/Protocol/TH.hs @@ -182,7 +182,13 @@ isMessageInstanceD t msgs = instanceD (pure []) [t|IsMessage $t|] [opcodeNameD, getMessageE :: Q Exp getMessageE = applyA (conE (msg.msgConName)) ((\argT -> [|getArgument @($argT)|]) . argumentSpecType <$> msg.msgSpec.arguments) putMessageD :: Q Dec - putMessageD = funD 'putMessage [clause [] (normalB [|undefined|]) []] + putMessageD = funD 'putMessage (putMessageClauseD <$> msgs) + putMessageClauseD :: MessageContext -> Q Clause + putMessageClauseD msg = clause [msgConP msg] (normalB (putMessageE msg.msgSpec.arguments)) [] + where + putMessageE :: [ArgumentSpec] -> Q Exp + putMessageE [] = [|pure ()|] + putMessageE args = doE ((\arg -> noBindS [|putArgument @($(argumentSpecType arg)) $(msgArgE msg arg)|]) <$> args) interfaceN :: InterfaceSpec -> Name