Hi Dmitry,

Perhaps you just want monad transformers [1, 2]. If you're not familiar with them, you should probably read [3].

With transformers you'd be able to do this (and more):

$ return 2 :: IO Int
$ return 2 :: ListT Maybe Int   -- this works like Maybe [Int]
$ return 2 :: MaybeT [] Int     -- this works like [Maybe Int]

$ runListT $ return 2 :: Maybe [Int]
Just [2]

[1] http://hackage.haskell.org/package/transformers
[2] http://hackage.haskell.org/package/mtl
[3] http://web.cecs.pdx.edu/~mpj/pubs/springschool.html


2013/11/23 Dmitry Bogatov <KAction@gnu.org>

Hi, list!

I want to write function, that will stack `return` as much times, as
necessery. In code, I want
<$> magicLift 2 :: IO Int
<$> magicLift 2 :: Maybe [Int]
both be valid.

My best approach is following (not work)

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

    class Monad m => MonadS m where
        liftS :: a -> m a

    instance (Monad m) => MonadS m where
        liftS = return

but
<$> :t liftS 2
liftS 2 :: (Monad m, Num a) => m a

What would you suggest?

--
Best regards, Dmitry Bogatov <KAction@gnu.org>,
Free Software supporter and netiquette guardian.
        git clone git://kaction.name/rc-files.git --depth 1
        GPG: 54B7F00D
Html mail and proprietary format attachments are forwarded to /dev/null.

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe