<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
</head>
<body>
<p>Nice! Moreover the "real implementation" can use standalone
deriving:</p>
<pre><tt>```</tt></pre>
<pre><tt>{-# LANGUAGE DataKinds #-}</tt><tt>
</tt><tt>{-# LANGUAGE KindSignatures #-}</tt><tt>
</tt><tt>{-# LANGUAGE StandaloneDeriving #-}</tt><tt>
</tt><tt>{-# LANGUAGE FlexibleInstances #-}</tt><tt>
</tt><tt>
</tt><tt>import Data.Function</tt><tt>
</tt><tt>
</tt><tt>data IsNormalized = Normalized | NotNormalized</tt><tt>
</tt><tt>
</tt><tt>data Sum (e :: IsNormalized)</tt><tt>
</tt><tt> = Value Int</tt><tt>
</tt><tt> | Sum (Sum e) (Sum e)</tt><tt>
</tt><tt> deriving (Show)</tt><tt>
</tt><tt>
</tt><tt>normalize :: Sum a -> Sum Normalized</tt><tt>
</tt><tt>normalize (Value i) = Value i</tt><tt>
</tt><tt>normalize (Sum (Value i) b) = Sum (Value i) (normalize b)</tt><tt>
</tt><tt>normalize (Sum (Sum x y) b) = normalize (Sum x (Sum y b))</tt><tt>
</tt><tt>
</tt><tt>instance Eq (Sum NotNormalized) where</tt><tt>
</tt><tt> (==) = (==) `on` normalize</tt><tt>
</tt><tt>
</tt><tt>deriving instance Eq (Sum Normalized)</tt><tt>
</tt><tt>
</tt><tt>sample1 :: Sum NotNormalized</tt><tt>
</tt><tt>sample1 = Value 10 `Sum` (Value 11 `Sum` Value 12)</tt><tt>
</tt><tt>
</tt><tt>sample2 :: Sum NotNormalized</tt><tt>
</tt><tt>sample2 = (Value 10 `Sum` Value 11) `Sum` Value 12</tt><tt>
</tt><tt>
</tt><tt>test = sample1 == sample2</tt><tt>
</tt><tt>-- True</tt><tt>
</tt></pre>
<pre><tt>```</tt>
</pre>
<p><br>
</p>
<div class="moz-cite-prefix">On 18/09/2019 14:53, MarLinn wrote:<br>
</div>
<blockquote type="cite"
cite="mid:1f53dd21-36c6-1bc5-acfd-952ed44ae9a0@gmail.com">
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<p>What about phantom types?</p>
<pre> {-# LANGUAGE KindSignatures, DataKinds #-}
data IsNormalized = Normalized | NotNormalized
data Sum (n :: IsNormalized) = Value Int | Sum (Sum n) (Sum n)
</pre>
<p>You could still say</p>
<pre> instance MyClass (Sum n) where…</pre>
<p>but you could also write</p>
<pre> normalizeSum :: Sum NotNormalized -> Sum Normalized -- or even create a class with two inhabitants for this
instance Eq (Sum NotNormalized) where (==) = (==) `on` normalizeSum
instance Eq (Sum Normalized) where … -- real implementation</pre>
<p>It's not ideal. For example if you want to sort a list, it
would still be better to normalize the whole list before
sorting, but at least you could still use the other operators
afterwards without a "denormalization" step. So maybe it would
help reduce some boilerplate?<br>
</p>
<p>Cheers,<br>
MarLinn<br>
</p>
<br>
<fieldset class="mimeAttachmentHeader"></fieldset>
<pre class="moz-quote-pre" wrap="">_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
<a class="moz-txt-link-freetext" href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a>
Only members subscribed via the mailman list are allowed to post.</pre>
</blockquote>
</body>
</html>