[Haskell-cafe] Missing feature of Coercible, or necessary caution?

Tom Ellis tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk
Tue Jan 25 14:16:30 UTC 2022


Consider the following program.

    {-# LANGUAGE TypeApplications #-}
    
    import Data.IntMap (IntMap, mapKeysMonotonic, Key)
    import Data.Coerce (coerce)
    
    newtype MyMap = MyMap (IntMap Bool)
    
    doesn'tWork :: (Key -> Key) -> MyMap -> MyMap
    doesn'tWork = coerce mapKeysMonotonic
    
    works :: (Key -> Key) -> MyMap -> MyMap
    works = coerce (mapKeysMonotonic @Bool)
    
mapKeysmonotonic has type

    (Key -> Key) -> IntMap a -> IntMap a

and we attempt to  coerce  it to type

    (Key -> Key) -> MyMap -> MyMap

since  MyMap  is a  newtype  around  IntMap Bool  this ends up
generating the constraint

    Coercible a Bool

and there is no way to specify that constraint given that  a  doesn't
otherwise appear in the top-level type. Hence  doesn'tWork  will not
type check.  If I force the type of  a  to be  Bool  using a
TypeApplication  then it does type check (works).

But is this a missing feature of GHC's  Coercible  system?  Since  a  is
not otherwise constrained is it not valid for GHC to choose it to be
Bool ?  Coercible  instances contain now observable content so no
observable behaviour could depend on the particular choice of  Coercible a Bool
instance, and choosing  a ~ Bool  is the natural one.

Is there some violation of type safety or otherwise broken behaviour
that could arise from choosing arbitrary  Coercible  instances on type
variables that are not otherwise constrained?

Tom


More information about the Haskell-Cafe mailing list