[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