RWHのCH18

モナド変換子を作ってみるやつのMaybeT、写経してみたけどうまく動かなくて四苦八苦した結果のメモ書き

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}

module MaybeT where

import Control.Monad.Trans
import Control.Monad.State

newtype MaybeT m a = MaybeT {
    runMaybeT :: m (Maybe a)
}

altBindMT :: Monad m => MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
x `altBindMT` f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)

instance (Functor f) => Functor (MaybeT f) where
    fmap = undefined

instance (Applicative a) => Applicative (MaybeT a) where
    pure = undefined
    (<*>) = undefined

instance (Monad m) => Monad (MaybeT m) where
    return a = MaybeT $ return (Just a)
    (>>=) = altBindMT
    fail _ = MaybeT $ return Nothing

instance MonadTrans MaybeT where
    lift = lift

instance (MonadIO m) => MonadIO (MaybeT m) where
    liftIO m = lift (liftIO m)

instance (MonadState s m) => MonadState s (MaybeT m) where
    get = lift get
    put k = lift (put k)

要はアプリカティブとファンクタのインスタンスをundefinedでサボってでもやっとけばコンパイルが通るように。
それぞれちゃんと書いてみたのが以下

liftA2MT :: (Applicative a) => MaybeT a (b -> c) -> MaybeT a b -> MaybeT a c
af `liftA2MT` ax = MaybeT $ fmap (<*>) (runMaybeT af) <*> runMaybeT ax

instance (Functor f) => Functor (MaybeT f) where
    fmap f a = MaybeT $ fmap (fmap f) (runMaybeT a)

instance (Applicative a) => Applicative (MaybeT a) where
    pure a = MaybeT $ pure (Just a)
    (<*>) = liftA2MT

UglyStackの方はどう治せば綺麗に動くのかなぁ？