[Haskell-cafe] How to define a common return and bind?
Yusaku Hashimoto
nonowarn at gmail.com
Fri Apr 10 05:15:17 EDT 2009
> Now I'm wondering if the derive_* functions can be overloaded using
> something like this. Note that the following doesn't typecheck:
>
> ----------------------------------------
>
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE RankNTypes #-}
> {-# LANGUAGE FunctionalDependencies #-}
> {-# LANGUAGE FlexibleInstances #-}
>
> ----------------------------------------
>
> class Iso m n | m -> n, n -> m where
> close :: forall a. m a -> n a
> open :: forall a. n a -> m a
>
> deriveReturn :: (Monad m, Monad n, Iso m n) => a -> n a
> deriveReturn = close . return
>
> deriveBind :: (Monad m, Iso m n) => n a -> (a -> n b) -> n 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 m (T1 m) where
> close = T1
> open = unT1
>
> instance Monad m => Monad (T1 m) where
> return = deriveReturn
> (>>=) = deriveBind
>
> ----------------------------------------
Hi, I changed a line, It type checks.
But I can't explain why your version does not type check.
--- iso_orig.hs 2009-04-10 17:56:12.000000000 +0900
+++ iso.hs 2009-04-10 17:56:36.000000000 +0900
@@ -5,7 +5,7 @@
----------------------------------------
-class Iso m n | m -> n, n -> m where
+class Iso m n | n -> m where
close :: forall a. m a -> n a
open :: forall a. n a -> m a
Thanks,
Hashimoto
More information about the Haskell-Cafe
mailing list