CODEWITHSUNDEEP
haskellmonadstypeclassdo-notation
ryskajakub
ryskajakub

Reputation: 6431

Rebind do notation with typeclass-free monad

It is possible to rebind the (>>=) and return for a monad using explicit dictionary passing like this:

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}

module Lib where

import Prelude hiding ((>>=), return)

data MonadDict m = MonadDict {
  bind :: forall a b. m a -> (a -> m b) -> m b ,
  ret :: forall a. a -> m a }

(>>=) :: (MonadDict m -> m a) -> (a -> (MonadDict m -> m b)) -> (MonadDict m -> m b)
return :: a -> (MonadDict m -> m a)

monadDictIO :: MonadDict IO

usage = let
  monadicCode = do
    ln <- const getLine 
    const . putStrLn $ ln
  in monadicCode monadDictIO

Is there a better way, how to represent the monad so one can avoid ignoring the MonadDict monad instance argument (using const) in every usage of the monadic action?

Upvotes: 2

Views: 156

Answers (2)

freestyle
freestyle

Reputation: 3790

You can do like this:

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE RecordWildCards #-}

module Lib where
import Prelude hiding(return, fail, (>>=), (>>))

data MonadDict m = MonadDict
    { (>>=)  :: forall a b. m a -> (a -> m b) -> m b
    , (>>)   :: forall a b. m a -> m b -> m b
    , return :: forall a. a -> m a
    , fail   :: forall a. String -> m a
    }

monadDictIO :: MonadDict IO
monadDictIO = ...

foo :: MonadDict m -> String -> m ()
foo = ...

usage = let
    monadicCode m@MonadDict{..} = do
        ln <- getLine
        putStrLn ln
        foo m ln
    in monadicCode monadDictIO

Upvotes: 6

Cirdec
Cirdec

Reputation: 24156

The short and incorrect answer is drop the MonadDict m argument from the return type of the second argument to (>>=):

(>>=) :: (MonadDict m -> m a) -> (a -> m b) -> (MonadDict m -> m b)

But that doesn't really solve all of your syntax problems. If someone has an existing arrow with the type Monad m => a -> m b, with explicit dictionary passing it'll have the type a -> (MonadDict m -> m b), and won't be usable as the second argument to (>>=). If there were a function drop :: (MonadDict m -> m b) -> m b to make it compatible with the second argument then there'd be no reason to pass MonadDicts around.

You're reinventing the ReaderT transformer to read a MonadDict m.

newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }

Every time you're using const it's the equivalent of lift ing an m a into ReaderT (MonadDict m) m a. Your example wouldn't look so unfamiliar if you wrote it with lift instead of const.

usage = let
  monadicCode = do
    ln <- lift getLine 
    lift . putStrLn $ ln
  in monadicCode monadDictIO

Here's a complete example using ReaderT; it'd probably be better to make a new type for ReaderT (MonadDict m) m and a different name for lift. The implementation of (>>=) and return is identical to ReaderTs, except it uses the bind or ret from the MonadDict.

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}

module Lib
    ( usage
    ) where

import Prelude hiding ((>>=), return)
import qualified Prelude as P ((>>=), return)
import Control.Monad.Trans.Reader

data MonadDict m = MonadDict {
  bind :: forall a b. m a -> (a -> m b) -> m b ,
  ret :: forall a. a -> m a }

type ReadM m a = ReaderT (MonadDict m) m a

(>>=) :: ReadM m a -> (a -> ReadM m b) -> ReadM m b
m >>= k = ReaderT $ \d@MonadDict { bind = bind } -> bind (runReaderT m d) (\a -> runReaderT (k a) d)

return :: a -> ReadM m a
return a = ReaderT $ \d@MonadDict { ret = ret } -> ret a

lift :: m a -> ReadM m a
lift m = ReaderT $ \_ -> m

monadDict :: Monad m => MonadDict m
monadDict = MonadDict {
  bind = (P.>>=),
  ret  = P.return
}

example1 :: String -> ReadM IO ()
example1 a = do
    lift . putStrLn $ a
    lift . putStrLn $ a

example2 :: ReadM IO ()
example2 = do
    example1 "Hello"
    ln <- lift getLine 
    lift . putStrLn $ ln

usage :: IO ()
usage = runReaderT example2 monadDict

If you give it its own type you can equip it with a Monad instance independently of the underlying m, and dispense with RebindableSyntax.

newtype ReadMD m a = ReadMD {runReadMD :: MonadDict m -> m a}

instance Functor (ReadMD f) where
    fmap = liftM

instance Applicative (ReadMD f) where
    pure = return
    (<*>) = ap

instance Monad (ReadMD m) where
    m >>= k = ReadMD $ \d@MonadDict { bind = bind } -> bind (runReadMD m d) (\a -> runReadMD (k a) d)
    return a = ReadMD $ \d@MonadDict { ret = ret } -> ret a

Upvotes: 1

Related Questions