<div dir="ltr">Hello haskellers,<br><br>Anyone know the trick for making a Binary instance of a GADT.<br>See sample code below followed by the type error reported by ghc version 6.8.3<br><br>Thanks,<br>
Tony<br><br>----<br>{-# LANGUAGE GADTs #-}<br><br>module GADTTest where<br><br>import Data.Binary<br>import Control.Monad (liftM)<br><br>data Query a where<br>&nbsp;&nbsp;&nbsp; Lookup :: String -&gt; Query (Maybe Int)<br>&nbsp;&nbsp;&nbsp; Fetch :: [String] -&gt; Query [Int]<br>

<br>instance (Binary a) =&gt; Binary (Query a) where<br>&nbsp;&nbsp;&nbsp; put (Lookup x) = putWord8 0 &gt;&gt; put x<br>&nbsp;&nbsp;&nbsp; put (Fetch x) = putWord8 1 &gt;&gt; put x<br>&nbsp;&nbsp;&nbsp; get = getWord8 &gt;&gt;= \tag -&gt; case tag of<br>&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; 0 -&gt; liftM Lookup get<br>

&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; 1 -&gt; liftM Fetch get<br>-----<br><br>GADTTest.hs:12:0:<br>&nbsp;&nbsp;&nbsp; Couldn&#39;t match expected type `Maybe Int&#39;<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; against inferred type `[Int]&#39;<br>&nbsp;&nbsp;&nbsp; When trying to generalise the type inferred for `get&#39;<br>

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Signature type:&nbsp;&nbsp;&nbsp;&nbsp; forall a. (Binary a) =&gt; Get (Query a)<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Type to generalise: Get (Query a)<br>&nbsp;&nbsp;&nbsp; In the instance declaration for `Binary (Query a)&#39;<br></div>