[Haskell-cafe] How to define a common return and bind?

Bas van Dijk v.dijk.bas at gmail.com
Fri Apr 10 07:32:53 EDT 2009


On Fri, Apr 10, 2009 at 11:15 AM, Yusaku Hashimoto <nonowarn at gmail.com> wrote:
> Hi, I changed a line, It type checks.
> But I can't explain why your version does not type check.

Thanks, I can't explain it either because I don't completely
understand functional dependencies.

So I rewrote it using type families which I find much easier to understand:

----------------------------------------
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Iso where

class Iso m where
    type Inner m :: * -> *

    close :: forall a. Inner m a -> m a
    open  :: forall a. m a       -> Inner m a

deriveReturn :: (Monad (Inner m), Iso m) => a -> m a
deriveReturn = close . return

deriveBind :: (Monad (Inner m), Iso m) => m a -> (a -> m b) -> m b
deriveBind m k = close $ open m >>= open . k

----------------------------------------

newtype T1 m a = T1 { unT1 :: A1 m a }
type A1 m a = m a

instance Iso (T1 m) where
    type Inner (T1 m) = m

    close = T1
    open  = unT1

instance Monad m => Monad (T1 m) where
    return = deriveReturn
    (>>=)  = deriveBind

----------------------------------------

You can also get a Monad instance "for free" if you aren't afraid of
UndecidableInstances:

----------------------------------------

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

instance (Monad (Inner m), Iso m) => Monad m where
    return = deriveReturn
    (>>=)  = deriveBind

----------------------------------------

This seems useful. Does this exists somewhere on hackage?

regards,

Bas


More information about the Haskell-Cafe mailing list