在MaybeT（StateT）monadT堆棧中調用純函數以便傳播錯誤的習慣方法是什麼？

Question

具體，讓我們說我有這樣的monadT堆棧：

type MHeap e ret = MaybeT (StateT [e] Identity) ret 

和便於學習一個runMheap功能：

runMheap :: MHeap e ret -> [e] -> (Maybe ret, [e]) 
runMheap m es = runIdentity $ runStateT (runMaybeT m) es 

我想創建一個MHeap一個查找表的第i個元素（注意，我們在這裏可能會出現一個超出界限的錯誤），然後將它追加到列表的末尾（如果元素存在），否則按原樣保留列表。在代碼：

mheapOp' :: Int -> MHeap Int (Maybe Int) 
mheapOp' i = do 
    xs <- lift $ get 
    -- I would like to use the pure function (!!) here 
    let ma = fndAtIdx i xs 
    -- I would also like to get rid these case statements 
    -- Also how do you describe 'no action' on the list? 
    case ma of 
     Nothing -> lift $ modify (++ []) 
     Just a -> lift $ modify (++ [a]) 
    return ma 


-- Since I dont know how to use the pure function above, I'm using this hack below 
fndAtIdx i xs = if length xs > i then Just $ xs !! i else Nothing 

請注意，我把我的問題在上述評論。

此代碼運行如下：

case 1: runMheap(mheapOp' 1) [1..3] // (Just (Just 2),[1,2,3,2]) 
case 2: runMheap(mheapOp' 10) [1..3] // (Just Nothing,[1,2,3]) 

你看，不出所料元組的第一個元素是雙包，但我不知道如何擺脫它，而無需調用加入的結果。換句話說，這將是很好：

(Just 2, [1,2,3,2]) and (Nothing, [1,2,3]) 

因此，要回顧一下，什麼是慣用的方法來調用一個monadT內純函數棧，並確保沒有錯誤寫明確陳述的情況下傳播？

Answer 1

我建議您堅持使用findAtIdx，它將返回Nothing，而不是使用像那樣使用error的部分函數。你真正需要的是以下類型的函數：

hoistMaybe :: (Monad m) => Maybe a -> MaybeT m a 

此功能將讓你正確地嵌入你的findAtIdx命令周圍MaybeT單子中，像這樣：

mheapOp' :: Int -> MHeap Int Int 
mheapOp' i = do 
    xs <- lift get 
    -- if 'findAtIdx' is 'Nothing', it will stop here and not call 'modify' 
    a <- hoistMaybe (findAtIdx i xs) 
    lift $ modify (++ [a]) 
    return a 

我們可以寫這個函數自己：

hoistMaybe ma = MaybeT (return ma) 

或者你可以import it從errors庫（全DISCL關閉：我寫了）。請注意，該庫也會爲safe庫重新導出atMay函數，這與您的findAtIdx函數類似。

但是我們怎麼知道這個函數做對了嗎？那麼，通常當我們得到一個「正確」的函數時，它就會遵守某種類別理論定律，這個函數也不例外。在這種特殊情況下，hoistMaybe是一個「單子射」，這意味着它應滿足下列法律：

-- It preserves empty actions, meaning it doesn't have any accidental complexity 
hoistMaybe (return x) = return x 

-- It distributes over 'do' blocks 
hoistMaybe $ do x <- m = do x <- hoistMaybe m 
       f x   hoistMaybe (f x) 

很容易證明的第一定律：

hoistMaybe (return x) 

-- Definition of 'return' in the 'Maybe' monad: 
= hoistMaybe (Just x) 

-- Definition of 'hoistMaybe' 
= MaybeT (return (Just x)) 

-- Definition of 'return' in the 'MaybeT' monad 
= return x 

我們也可以證明第二定律，太：

hoistMaybe $ do x <- m 
       f x 

-- Definition of (>>=) in the 'Maybe' monad: 
= hoistMaybe $ case m of 
    Nothing -> Nothing 
    Just a -> f a 

-- Definition of 'hoistMaybe' 
= MaybeT $ return $ case m of 
    Nothing -> Nothing 
    Just a -> f a 

-- Distribute the 'return' over both case branches 
= MaybeT $ case m of 
    Nothing -> return Nothing 
    Just a -> return (f a) 

-- Apply first monad law in reverse 
= MaybeT $ do 
    x <- return m 
    case x of 
     Nothing -> return Nothing 
     Just a -> return (f a) 

-- runMaybeT (MaybeT x) = x 
= MaybeT $ do 
    x <- runMaybeT (MaybeT (return m)) 
    case x of 
     Nothing -> return Nothing 
     Just a -> runMaybeT (MaybeT (return (f a))) 

-- Definition of (>>=) for 'MaybeT m' monad in reverse 
= do x <- MaybeT (return m) 
    MaybeT (return (f x)) 

-- Definition of 'hoistMaybe' in reverse 
= do x <- hoistMaybe m 
    hoistMaybe (f x) 

所以這就是我們如何能夠說服自己，我們正確地解除了「不確定」到「MaybeT」。

編輯：在回答你刪除的要求，這是多麼mheapOp內聯：

import Control.Monad 
import Control.Error 
import Control.Monad.Trans.Class 
import Control.Monad.Trans.Maybe 
import Control.Monad.Trans.State 
import Data.Functor.Identity 

-- (State s) is the exact same thing as (StateT s Identity): 
-- type State s = StateT s Identity 
type MHeap e r = MaybeT (State [e]) r 

mheapOp :: Int -> MHeap Int Int 
{- 
mheapOp i = do 
    xs <- lift get 
    a <- hoistMaybe (atMay xs i) 
    lift $ modify (++ [a]) 
    return a 

-- Inline 'return' and 'lift' for 'MaybeT', and also inline 'hoistMaybe' 
mheapOp i = do 
    xs <- MaybeT $ liftM Just get 
    a <- MaybeT $ return $ atMay xs i 
    MaybeT $ liftM Just $ modify (++ [a]) 
    MaybeT $ return $ Just a 

-- Desugar 'do' notation 
mheapOp i = 
    (MaybeT $ liftM Just get)    >>= \xs -> 
    (MaybeT $ return $ atMay xs i)   >>= \a -> 
     (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
     (MaybeT $ return $ Just a) 

-- Inline first '(>>=)' (which uses 'MaybeT' monad) 
mheapOp i = 
    MaybeT $ do 
     mxs <- runMaybeT (MaybeT $ liftM Just get) 
     case mxs of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

-- runMaybeT (MaybeT x) = x 
mheapOp i = 
    MaybeT $ do 
     mxs <- liftM Just get 
     case mxs of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

-- Inline definition of 'liftM' 
mheapOp i = 
    MaybeT $ do 
     mxs <- do xs' <- get 
       return (Just xs') 
     case mxs of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

{- Use third monad law (a.k.a. the "associativity law") to inline the inner do 
    block -} 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     mxs <- return (Just xs) 
     case mxs of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

{- Use first monad law (a.k.a. the "left identity law"), which says that: 

    x <- return y 

    ... is the same thing as: 

    let x = y 
-} 
mheapOp i = 
    MaybeT $ do 
     xs' <- get 
     let mxs = Just xs' 
     case mxs of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

-- Inline definition of 'mxs' 
mheapOp i = 
    MaybeT $ do 
     xs' <- get 
     case (Just xs') of 
      Nothing -> return Nothing 
      Just xs -> runMaybeT $ 
       (MaybeT $ return $ atMay xs i)   >>= \a -> 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

{- The 'case' statement takes the second branch, binding xs' to xs. 

    However, I choose to rename xs' to xs for convenience, rather than rename xs 
    to xs'. -} 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     runMaybeT $ (MaybeT $ return $ atMay xs i)   >>= \a -> 
        (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
         (MaybeT $ return $ Just a) 

-- Inline the next '(>>=)' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     runMaybeT $ MaybeT $ do 
      ma <- runMaybeT $ MaybeT $ return $ atMay xs i 
      case ma of 
       Nothing -> return Nothing 
       Just a -> runMaybeT $ 
        (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

-- runMaybeT (MaybeT x) = x 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     do ma <- return $ atMay xs i 
      case ma of 
       Nothing -> return Nothing 
       Just a -> runMaybeT $ 
        (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
        (MaybeT $ return $ Just a) 

-- You can inline the inner 'do' block because it desugars to the same thing 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     ma <- return $ atMay xs i 
     case ma of 
      Nothing -> return Nothing 
      Just a -> runMaybeT $ 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
       (MaybeT $ return $ Just a) 

-- Use first monad law 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     let ma = atMay xs i 
     case ma of 
      Nothing -> return Nothing 
      Just a -> runMaybeT $ 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
       (MaybeT $ return $ Just a) 

-- Inline definition of 'ma' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> runMaybeT $ 
       (MaybeT $ liftM Just $ modify (++ [a])) >>= \_ -> 
       (MaybeT $ return $ Just a) 

-- Inline the next '(>>=)' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> runMaybeT $ MaybeT $ do 
       mv <- runMaybeT $ MaybeT $ liftM Just $ modify (++ [a]) 
       case mv of 
        Nothing -> return Nothing 
        Just _ -> runMaybeT $ MaybeT $ return $ Just a 

-- runMaybeT (MaybeT x) = x 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       mv <- liftM Just $ modify (++ [a]) 
       case mv of 
        Nothing -> return Nothing 
        Just _ -> return (Just a) 

-- Inline definition of 'liftM' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       mv <- do x <- modify (++ [a]) 
         return (Just x) 
       case mv of 
        Nothing -> return Nothing 
        Just _ -> return (Just a) 

-- Inline inner 'do' block using third monad law 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       x <- modify (++ [a]) 
       mv <- return (Just x) 
       case mv of 
        Nothing -> return Nothing 
        Just _ -> return (Just a) 

-- Use first monad law to turn 'return' into 'let' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       x <- modify (++ [a]) 
       let mv = Just x 
       case mv of 
        Nothing -> return Nothing 
        Just _ -> return (Just a) 

-- Inline definition of 'mv' 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       x <- modify (++ [a]) 
       case (Just x) of 
        Nothing -> return Nothing 
        Just _ -> return (Just a) 

-- case takes the 'Just' branch, binding 'x' to '_', which goes unused 
mheapOp i = 
    MaybeT $ do 
     xs <- get 
     case (atMay xs i) of 
      Nothing -> return Nothing 
      Just a -> do 
       modify (++ [a]) 
       return (Just a) 

{- At this point we've completely inlined the outer 'MaybeT' monad, converting 
    it to a 'StateT' monad internally. Before I inline the 'StateT' monad, I 
    want to point out that if 'atMay' returns 'Nothing', the computation short 
    circuits and doesn't call 'modify'. 

    The next step is to inline the definitions of 'return, 'get', and 'modify': 
-} 
mheapOp i = 
    MaybeT $ do 
     xs <- StateT (\as -> return (as, as)) 
     case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> do 
       StateT (\as -> return ((), as ++ [a])) 
       StateT (\as -> return (Just a , as)) 

-- Now desugar both 'do' blocks: 
mheapOp i = 
    MaybeT $ 
     StateT (\as -> return (as, as)) >>= \xs -> 
     case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
        StateT (\as -> return (Just a , as)) 

-- Inline first '(>>=)', which uses 'StateT' monad instance 
mheapOp i = 
    MaybeT $ StateT $ \as0 -> do 
     (xs, as1) <- runStateT (StateT (\as -> return (as, as))) as0 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) as1 
        --        ^
        -- Play close attention to this s1 | 

-- runStateT (StateT x) = x 
mheapOp i = 
    MaybeT $ StateT $ \as0 -> do 
     (xs, as1) <- (\as -> return (as, as)) as0 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) as1 

-- Apply (\as -> ...) to as0, binding 'as0' to 'as' 
mheapOp i = 
    MaybeT $ StateT $ \as0 -> do 
     (xs, as1) <- return (as0, as0) 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) as1 

-- Use first monad law to convert 'return' to 'let' 
mheapOp i = 
    MaybeT $ StateT $ \as0 -> do 
     let (xs, as1) = (as0, as0) 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) as1 

{- The let binding says that xs = as0 and as1 = as0, so I will rename all of 
    them to 'xs' since they are all equal -} 
mheapOp i = 
    MaybeT $ StateT $ \xs -> do 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) xs 

-- do m = m, so we can just get rid of the 'do' 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     runStateT (case (atMay xs i) of 
      Nothing -> StateT (\as -> return (Nothing, as)) 
      Just a -> 
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) xs 

-- Distribute the 'runStateT ... xs' over both 'case' branches 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> runStateT (StateT (\as -> return (Nothing, as))) xs 
      Just a -> runStateT (
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) xs 

-- runStateT (StateT x) = x 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> (\as -> return (Nothing, as)) xs 
      Just a -> runStateT (
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) xs 

-- Apply (\as -> ...) to 'xs', binding 'xs' to 'as' 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> runStateT (
       StateT (\as -> return ((), as ++ [a])) >>= \_ -> 
       StateT (\as -> return (Just a , as))) xs 

-- Inline the '(>>=)' 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> runStateT (StateT $ \as0 -> do 
       (_, as1) <- runStateT (StateT (\as -> return ((), as ++ [a]))) as0 
       runStateT (StateT (\as -> return (Just a , as))) as1) xs 

-- runStateT (StateT x) = x 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> (\as0 -> do 
       (_, as1) <- (\as -> return ((), as ++ [a])) as0 
       (\as -> return (Just a , as)) as1) xs 

-- Apply all the functions to their arguments 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> (\as0 -> do 
       (_, as1) <- return ((), as0 ++ [a]) 
       return (Just a , as1)) xs 

-- Use first monad law to convert 'return' to 'let' 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> (\as0 -> do 
       let (_, as1) = ((), as0 ++ [a]) 
       return (Just a , as1)) xs 

-- Let binding says that as1 = as0 ++ [a], so we can inline its definition 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> (\as0 -> do 
       return (Just a , as0 ++ [a])) xs 

-- do m = m 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> (\as0 -> return (Just a , as0 ++ [a])) xs 

-- Apply (\as0 -> ...) to 'xs', binding 'xs' to 'as0' 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     case (atMay xs i) of 
      Nothing -> return (Nothing, xs) 
      Just a -> return (Just a , xs ++ [a]) 

-- Factor out the 'return' from the 'case' branches, and tidy up the code 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     return $ case (atMay xs i) of 
      Nothing -> (Nothing, xs) 
      Just a -> (Just a , xs ++ [a]) 
-} 

-- One last step: that last 'return' is for the 'Identity' monad, defined as: 
mheapOp i = 
    MaybeT $ StateT $ \xs -> 
     Identity $ case (atMay xs i) of 
      Nothing -> (Nothing, xs) 
      Just a -> (Just a , xs ++ [a]) 

{- So now we can clearly say what the function does: 

    * It takes an initial state named 'xs' 

    * It calls 'atMay xs i' to try to find the 'i'th value of 'xs' 

    * If 'atMay' returns 'Nothing, then our stateful function returns 'Nothing' 
    and our original state, 'xs' 

    * If 'atMay' return 'Just a', then our stateful function returns 'Just a' 
    and a new state whose value is 'xs ++ [a]' 

    Let's also walk through the types of each layer: 

    layer1 :: [a] -> Identity (Maybe a, [a]) 
    layer1 = \xs -> 
     Identity $ case (atMay xs i) of 
      Nothing -> (Nothing, xs) 
      Just a -> (Just a, xs ++ [a]) 

    layer2 :: StateT [a] Identity (Maybe a) 
    -- i.e. State [a] (Maybe a) 
    layer2 = StateT layer1 

    layer3 :: MaybeT (State [a]) a 
    layer3 = MaybeT layer2 
-}