[Haskell-cafe] (Feeling that) GHCi is trying to protect me from myself with overlapping instances and existential types
Juan Casanova
juan.casanova at ed.ac.uk
Sun Feb 16 19:37:25 UTC 2020
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE ExistentialQuantification #-}
>
> module Main (main) where
> import Data.Typeable (Typeable, cast)
>
> class Class1 a b where
> foo :: a -> b
> instance {-# INCOHERENT #-} Monoid a => Class1 a (Either b a) where
> foo x = Right (x <> x)
> instance {-# INCOHERENT #-} Monoid a => Class1 a (Either a b) where
> foo x = Left x
>
> data Bar a = Dir a | forall b. (Typeable b, Eq b, Class1 b a) => FromB b
> instance Eq a => Eq (Bar a) where
> (Dir x) == (Dir y) = x == y
> (FromB x) == (FromB y) = case cast x of
> Just x' -> x' == y
> _ -> False
> _ == _ = False
>
> getA :: Bar a -> a
> getA (Dir a) = a
> getA (FromB b) = foo b
>
> createBar :: Eq t => Bar (Either String t)
> createBar = FromB "abc"
>
> createBar2 :: Eq t => Bar (Either t String)
> createBar2 = FromB "abc"
>
> main :: IO ()
> main = do
> let x = createBar :: Bar (Either String String)
> y = createBar2 :: Bar (Either String String)
> print $ map getA [x, y]
> print $ x == y
>
> If your run the above, the output you get is:
>
> [Left "abc",Right "abcabc"]
> True
I'm not that familiar with Typeable. If I understand correctly, what
is going on here is that by pattern-matching on the FromB constructor
and using Typeable, you are bypassing the instance checking and
comparing two things that should not be compared. Is this a more or
less correct understanding?
If so, your conclusion then is that by allowing incoherent instances,
if someone bypasses them under the hood then I might get very
unexpected results that cannot be directly traced back to "using the
wrong instance". Right?
This is quite a bit more convincing. The fact that I had clearly
gotten wrong the design principles of Haskell when it comes to
overlapping instances already got me quite convinced, but this helps
as well. I just hate having to wrap everything in newtypes as the only
solution out of it...
Thanks a lot for taking the time to explain this,
Juan.
--
The University of Edinburgh is a charitable body, registered in
Scotland, with registration number SC005336.
More information about the Haskell-Cafe
mailing list