[Haskell-cafe] Short circuiting and the Maybe monad
David Menendez
dave at zednenem.com
Sat May 17 02:38:16 EDT 2008
On Sat, May 17, 2008 at 1:24 AM, Kim-Ee Yeoh <a.biurvOir4 at asuhan.com> wrote:
>
>
> Dan Piponi-2 wrote:
>>
>> In fact, you can use the Reader monad as a fixed size container monad.
>>
>
> Interesting that you say that. Reader seems to me more as an anti-container
> monad.
You just have to think of the environment as an address into an
implicit structure. For example, Bool -> a is isomorphic to (a,a).
Thus,
data Diag a = D { p1 :: a, p2 :: a }
to :: Diag a -> (Bool -> a)
to (D a b) p = if p then a else b
from :: (Bool -> a) -> Diag a
from f = D (f True) (f False)
Some transformations applied to the monad instance for ((->) Bool) gets you:
instance Monad Diag where
return x = D x x
D a b >>= f = D (p1 (f a), p2 (f b))
This works for any enumeration.
Here's a more complex example,
data Stream a = a :< Stream a
type Nat = Integer
-- we'll pretend this can't ever be negative
to :: Stream a -> (Nat -> a)
to (a :< as) 0 = a
to (a :< as) n = to as n
from :: (Nat -> a) -> Stream a
from f = go 0 where go n = f n :< go (n + 1)
shead (a :< as) = a
stail (a :< as) = as
instance Monad Stream where
return x = x :< return x
(a :< as) >>= f = shead (f a) :< (as >>= stail . f)
Assuming I haven't mistyped anything,
to (m >>= f) n = to (f (to m n)) n
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list