<div dir="ltr"><div><div>Hi Matt. I don't know how bad is this, but here's what I came up with.<br><br></div>In order to be able to ask types to make sure something about values (their equality), you might want to create a type, which contains a value in its type-parameter, and then ask that types are equal if you want some equality property in datatype. Here's an example:<br><br>{-# LANGUAGE DataKinds #-}<br>{-# LANGUAGE KindSignatures #-}<br>{-# LANGUAGE ExistentialQuantification #-}<br>{-# LANGUAGE PolyKinds #-}<br>{-# LANGUAGE StandaloneDeriving #-}<br><br>module Main where<br><br>import GHC.TypeLits<br><br>newtype TypeValInt (n::Nat) = TypeValInt Int<br>    deriving (Show)<br><br>one :: TypeValInt 1<br>one = TypeValInt 1<br><br>two :: TypeValInt 2<br>two = TypeValInt 2<br><br>data MyP a b = MyP (TypeValInt a, TypeValInt b) (TypeValInt b, TypeValInt a)<br>    deriving (Show)<br><br>main :: IO ()<br>main = do<br>    putStrLn "Hello!"<br>    print (MyP (one, two) (two, one))<br>    -- | this will error:<br>    -- print (MyP (one, two) (one, one))<br>    print (MyPGen (one, two) (two, one))<br>    -- | this will error:<br>    -- print (MyPGen (one, two) (one, one))<br><br>class TypeVal (g :: a -> *)<br>instance TypeVal TypeValInt<br><br>data MyPGen a b = forall g. (TypeVal g, Show (g a), Show (g b))<br>               => MyPGen (g a, g b) (g b, g a)<br>deriving instance Show (MyPGen a b)<br><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Jun 22, 2015 at 1:29 PM, Matt Williams <span dir="ltr"><<a href="mailto:matt.williams45.mw@gmail.com" target="_blank">matt.williams45.mw@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><p dir="ltr">Dear All,</p>
<p dir="ltr">I wonder if/ how this is possible?</p>
<p dir="ltr">I have a constructor which takes 2 pairs of type t).</p>
<p dir="ltr">However, I want to ensure that the pairs are matched:</p>
<p dir="ltr">MyP = MyP (t, t) (t, t)</p>
<p dir="ltr">But where the first pair contains the same elements as the second, but reversed in order.</p>
<p dir="ltr">Any help much appreciated.</p>
<p dir="ltr">BW,<br>
Matt</p>
<br>_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners</a><br>
<br></blockquote></div><br></div>