rpc backend: unwrap attr get response to just the attr val

src/Gidl/Backend/Rpc.hs

@@ -14,7 +14,7 @@ import Gidl.Interface
            ,interfaceMethods)
 import Gidl.Schema
            (Schema(..),producerSchema,consumerSchema,Message(..)
-           ,consumerMessages,interfaceTypes)
+           ,consumerMessages,interfaceTypes,getResponseMessage)
 import Gidl.Types (Type(..))
 
 import Data.Char (isSpace)
@@ -273,13 +273,14 @@ mkRoute ifacePfx consSuffix state method@(name,mty) =
       [ readStream state name ]
 
   handlersFor (AttrMethod Read _) =
-      [ readAttr  consSuffix m | m <- consumerMessages method ]
+      [ readAttr method consSuffix m | m <- consumerMessages method ]
 
   handlersFor (AttrMethod Write _) =
       [ writeAttr consSuffix m | m <- consumerMessages method ]
 
   handlersFor (AttrMethod ReadWrite ty) =
-      [ readAttr  consSuffix m | m <- consumerMessages (name,AttrMethod Read  ty) ] ++
+      [ readAttr method consSuffix m
+      | m <- consumerMessages (name,AttrMethod Read ty) ] ++
       [ writeAttr consSuffix m | m <- consumerMessages (name,AttrMethod Write ty) ]
 
 
@@ -295,14 +296,24 @@ readStream state name = nest 2 $ text "Snap.method Snap.GET $"
 constrName :: String -> Message -> String
 constrName suffix (Message n _) = userTypeModuleName n ++ suffix
 
-readAttr :: String -> Message -> Doc
-readAttr suffix msg = text "Snap.method Snap.GET $" <+> doStmts
-  [ text "resp <- liftIO $ sendRequest conn $"
-                   <+> text (constrName suffix msg)
-                   <+> dot <+> text "SequenceNum.SequenceNum"
+readAttr :: (MethodName,Method) -> String -> Message -> Doc
+readAttr (attrname, (AttrMethod _ t)) suffix msg =
+  text "Snap.method Snap.GET $" <+> doStmts
+    [ parens (text responseConstructor
+             <+> parens (responseSNumed <> dot <> responseSNumed
+                        <+> text "_ resp"))
+      <+> text "<- liftIO $ sendRequest conn $"
+                     <+> text (constrName suffix msg)
+                     <+> dot <+> text "SequenceNum.SequenceNum"
+
+    , text "Snap.writeLBS (encode resp)"
+    ]
+  where
+  resp@(Message _ (StructType resp_tyname _)) = getResponseMessage attrname t
+  responseConstructor = constrName "Producer" resp
+  responseSNumed = text $ userTypeModuleName resp_tyname
 
-  , text "Snap.writeLBS (encode resp)"
-  ]
+readAttr _ _ _ = error "impossible readAttr"
 
 writeAttr :: String -> Message -> Doc
 writeAttr suffix msg = text "Snap.method Snap.POST $" <+> doStmts

src/Gidl/Schema.hs

@@ -74,7 +74,6 @@ sequenceNumStruct t = StructType ("sequence_numbered_" ++ (typeName t))
                           [ ("seqnum", sequence_num_t)
                           , ("val", t) ]
 
-
 mkMsgId :: Message -> MsgId
 mkMsgId = fromIntegral . hash . show