<div dir="ltr"><div><div>Hello! I'm having a lot of trouble writing a 
Data.GADT.Compare.GEq instance - can anyone help me fill in the blank? 
For context - I'm generating Tag types automatically for using with 
DSum, and I need a GEq instance. That's part of an attempt to add 
efficient rendering of sum types to Reflex/Reflex-Dom (<a href="https://github.com/anderspapitto/reflex-sumtype-render/blob/master/src/ReflexHelpers.hs" target="_blank">https://github.com/<wbr>anderspapitto/reflex-sumtype-<wbr>render/blob/master/src/<wbr>ReflexHelpers.hs</a>).<br><br></div><div>I put this question on stackoverflow as well a day ago (<a href="http://stackoverflow.com/questions/40698207/how-can-i-write-this-geq-instance" target="_blank">http://stackoverflow.com/<wbr>questions/40698207/how-can-i-<wbr>write-this-geq-instance</a>).<br></div><div><br></div>Here's
 the code (it's a full, standalone file - you can copy it into Foo.hs 
and run ghc to see the full error I'm facing). The error I get is that 
when I try to recursively call geq on the unwrapped x and y, I can't 
because ghc considers them to have different types - Quux a and Quux b. 
However, the whole point of why I'm trying to call geq is to see if a 
and b are the same, so I'm pretty confused.<br><br></div>Note that I'm making use of the generics-sop library, which is where NP and NS and I come from.<br><br><span style="font-family:monospace,monospace">{-# LANGUAGE GADTs #-}<br>{-# LANGUAGE DataKinds #-}<br>{-# LANGUAGE TypeOperators #-}<br>{-# LANGUAGE KindSignatures #-}<br>{-# LANGUAGE RankNTypes #-}<br><br>module Foo where<br><br>import Data.GADT.Compare<br>import Generics.SOP<br>import qualified GHC.Generics as GHC<br><br>data Quux i xs where Quux :: Quux (NP I xs) xs<br><br>newtype GTag t i = GTag { unTag :: NS (Quux i) (Code t) }<br><br>instance GEq (GTag t) where<br>  -- I don't know how to do this<br>  geq (GTag (S x)) (GTag (S y)) =<br>    let _ = x `geq` y<br>    in undefined</span></div>