简短且不正确的答案是将MonadDict m
参数从第二个参数的返回类型中删除到(>>=)
:
(>>=) :: (MonadDict m -> m a) -> (a -> m b) -> (MonadDict m -> m b)
但这并不能真正解决您所有的语法问题。如果某人有一个带有 type 的现有箭头Monad m => a -> m b
,并且显式传递字典,它将具有 type a -> (MonadDict m -> m b)
,并且不能用作 的第二个参数(>>=)
。如果有一个函数drop :: (MonadDict m -> m b) -> m b
可以使它与第二个参数兼容,那么就没有理由传递MonadDict
s 了。
您正在重新发明ReaderT
变压器以读取MonadDict m
.
newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }
每次使用const
它都相当于lift
ing an m a
into ReaderT (MonadDict m) m a
。如果您使用lift
而不是const
.
usage = let
monadicCode = do
ln <- lift getLine
lift . putStrLn $ ln
in monadicCode monadDictIO
这是一个完整的例子,使用ReaderT
; ReaderT (MonadDict m) m
为lift
. _ and的实现(>>=)
与sreturn
相同ReaderT
,只是它使用的bind
or ret
。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
如果你给它自己的类型,你可以为它配备一个Monad
独立于底层的实例m
,并且省去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