Qual è il modo idiomatico di chiamare le funzioni pure all'interno di uno stack monadT di MaybeT (StateT) in modo tale che l'errore si propaga?

Question

Concretamente, diciamo che ho questo monadT stack:

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

e una funzione runMheap per convenienza:

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

Voglio creare un MHeap che trova l'esimo elemento di una lista (notare che potrebbe avere un errore fuori limite qui), e quindi aggiungerlo alla fine della lista se l'elemento esiste, altrimenti lasciare la lista così com'è. Nel codice:

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 

Si prega di notare che ho posto le mie domande nei commenti sopra.

Questo codice viene eseguito come segue:

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]) 

Vedete, non sorprende che il primo elemento della tupla è confezionamento doppio, ma non ho idea di come sbarazzarsi di esso senza chiamare unirsi sul risultato. In altre parole, questo sarebbe bello:

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

Quindi, per ricapitolare, qual è il modo idiomatico per richiamare le funzioni pure all'interno di una pila monadT e garantire che l'errore si propaga senza scrivere esplicitamente dichiarazioni caso?

Answer 1

Si consiglia di attenersi a findAtIdx, che restituisce un Nothing, anziché utilizzare una funzione parziale come (!!) che utilizza error. Che cosa hai veramente bisogno è una funzione del seguente tipo:

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

Questa funzione avrebbe permesso di incorporare il vostro comando findAtIdx correttamente all'interno del circostante MaybeT monade, in questo modo:

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 

Possiamo scrivere questa funzione noi stessi :

hoistMaybe ma = MaybeT (return ma) 

Oppure si può import it dalla libreria errors (DISCL completa osizione: l'ho scritto). Nota che questa libreria ri-esporta anche la funzione atMay dalla libreria safe, che è proprio come la tua funzione findAtIdx.

Ma come facciamo a sapere che questa funzione fa la cosa giusta? Beh, di solito quando otteniamo una funzione "giusta" capita di obbedire a qualche tipo di legge della teoria delle categorie, e questa funzione non fa eccezione. In questo caso particolare, hoistMaybe è una "monade morfismo", il che significa che dovrebbe soddisfare le seguenti leggi:

-- 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) 

E 'facile dimostrare la prima legge:

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 

Ci può anche rivelarsi il seconda legge, anche:

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) 

Quindi è così che possiamo convincerci che abbiamo alzato il 'Forse' al 'MaybeT' correttamente.

Edit: In risposta alla vostra richiesta cancellati, questo è il modo mheapOp inline:

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 
-}