[Haskell-cafe] monad constraint + record update
Miguel Mitrofanov
miguelimo38 at yandex.ru
Mon Dec 22 14:16:01 EST 2008
You can use a continuation trick I describe below.
First of all, I would like to work in a more general situation. So,
instead of working with Set, I'd like to declare two classes:
> class Returnable m a where ret :: a -> m a
and
> class Bindable m a b where bind :: m a -> (a -> m b) -> m b
I'm sure you're able to define instances like "instance Ord a =>
Returnable Set a" by yourself. You'll need MultiParamTypeClasses and
FlexibleInstances for that to work.
Now, the trick:
> newtype Restricted r m a = Restricted ((a -> m r) -> m r)
> instance Monad (Restricted r m) where
> return x = Restricted $ \h -> h x
> Restricted g >>= f = Restricted $ \h -> g $ \x -> let
Restricted g' = f x in g' h
Quite simple, and doesn't mention pseudo-monadic structure of "m" at
all.
Now, the fun part:
> embed :: Bindable m a r => m a -> Restricted r m a
> embed mx = Restricted (bind mx)
> unembed :: Returnable m r => Restricted r m r -> m r
> unembed (Restricted g) = g ret
You may also want another class
> class Summable m a where
> zero :: m a
> plus :: m a -> m a -> m a
and now you can have
> instance Summable m r => MonadPlus (Restricted r m) where
> mzero = Restricted $ const zero
> Restricted g1 `mplus` Restricted g2 = Restricted $ \h -> g1 h
`plus` g2 h
From now on, you can do something like that:
> unembed $ do x <- embed $ Set.fromList [6,2,3]
> (do y <- return x
> z <- embed $ Set.fromList [1..2]
> guard $ y < 5
> return $ y + z)
> `mplus` return 10
and have "fromList [3,4,5,10]", as expected
On 22 Dec 2008, at 20:19, Peter Padawitz wrote:
> I'd like to define a monad Set for types in the class Eq. But how
> can the arguments of Set be constrained when Set is defined as an
> instance of Monad? instance Eq a => Monad Set where ... obviously
> cannot work.
>
> Is there a standard update function for fields in data types,
> something that OO programmers do with assignments like obj.attr :=
> value ?
>
> Peter
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list