[Haskell-cafe] Explicitly calling syntactic equality on datatypes
Sylvain Henry
sylvain at haskus.fr
Wed Sep 18 14:46:47 UTC 2019
Nice! Moreover the "real implementation" can use standalone deriving:
```
{-# LANGUAGE DataKinds #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE
StandaloneDeriving #-}{-# LANGUAGE FlexibleInstances #-}import
Data.Functiondata IsNormalized = Normalized | NotNormalizeddata Sum (e
:: IsNormalized) = Value Int | Sum (Sum e) (Sum e) deriving
(Show)normalize :: Sum a -> Sum Normalizednormalize (Value
i) = Value inormalize (Sum (Value i) b) = Sum
(Value i) (normalize b)normalize (Sum (Sum x y) b) = normalize
(Sum x (Sum y b))instance Eq (Sum NotNormalized) where (==) = (==)
`on` normalizederiving instance Eq (Sum Normalized)sample1 :: Sum
NotNormalizedsample1 = Value 10 `Sum` (Value 11 `Sum` Value 12)sample2
:: Sum NotNormalizedsample2 = (Value 10 `Sum` Value 11) `Sum` Value
12test = sample1 == sample2-- True
```
On 18/09/2019 14:53, MarLinn wrote:
>
> What about phantom types?
>
> {-# LANGUAGE KindSignatures, DataKinds #-}
> data IsNormalized = Normalized | NotNormalized
> data Sum (n :: IsNormalized) = Value Int | Sum (Sum n) (Sum n)
>
> You could still say
>
> instance MyClass (Sum n) where…
>
> but you could also write
>
> 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
>
> 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?
>
> Cheers,
> MarLinn
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190918/0f5179a8/attachment.html>
More information about the Haskell-Cafe
mailing list