創建一個Reader和Maybe Monad的組合（Applicative Functor）

Question

我想做的是從Reader monad中制作一個Applicative Functor，它做了這樣的事情：

data MyData = Int Int

get2Sum :: Reader [Int] Int
get2Sum = do
    myData <- ask
    let fst2 = take 2 myData
    case length fst2 of
        2 -> return $ sum fst2
        _ -> return 0

myDataFromApplicative = MyData <$> get2Sum <*> get2Sum

main = print $ runReader myDataFromApplicative [1,2]

但是，如果運行類似的東西

runReader myDataFromApplicative [1]

而不是給我MyData 0 0

我希望它給我Error

我正在玩創建自己的Reader Monad來實現這一目標，但無法弄明白。

我想象的是這樣的事情（顯然這只是一個大綱

data SuccessReader r a = Interm {runSuccessReader :: r -> SuccessReader a} | Success a | Error
throwError :: SuccessReader ()


get2Sum :: Reader [Int] Int
get2Sum = do
    myData <- ask
    let fst2 = take 2 myData
    case length fst2 of
        2 -> return $ sum fst2
        _ -> throwError

myDataFromApplicative = MyData <$> get2Sum <*> get2Sum

main = do
    print $ runSuccessReader myDataFromApplicative [1,2]
    print $ runSuccessReader myDataFromApplicative [1]

哪個會輸出

Success MyData 3 3
Error

Answer 1

你不需要編寫自己的monad，因為這正是monad變換器和monad堆棧解決的問題。 由於您需要Reader和Maybe的組合，因此您可以將ReaderT轉換器與Maybe monad一起使用。 例如

get2Sum :: ReaderT [Int] Maybe Int
get2Sum = do
    myData <- ask
    let fst2 = take 2 myData
    case length fst2 of
        2 -> return $ sum fst2
        _ -> lift Nothing

get2Sum的類型意味着我們有外部monad Reader [Int] ，它包含內部monad Maybe 。 在get2Sum的實現中， lift用於在內部monad中運行操作（在這種情況下，簡單地用Nothing發出錯誤信號）。 現在運行時（注意runReaderT的T ）

main = do
    print $ runReaderT myDataFromApplicative [1,2]
    print $ runReaderT myDataFromApplicative [1]

你得到

Just (MyData 3 3)
Nothing

您也可以隱藏自定義里面的單子堆棧newtype

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Applicative
import Control.Monad.Reader

data MyData = MyData Int Int deriving Show

newtype MyMonad a = MyMonad (ReaderT [Int] Maybe a)
    deriving (Functor, Applicative, Monad, MonadReader [Int])

runMyMonad :: MyMonad a -> [Int] -> Maybe a
runMyMonad (MyMonad m) = runReaderT m

myError :: MyMonad a
myError = MyMonad $ lift Nothing

get2Sum :: MyMonad Int
get2Sum = do
    myData <- ask
    let fst2 = take 2 myData
    case length fst2 of
        2 -> return $ sum fst2
        _ -> myError

myDataFromApplicative = MyData <$> get2Sum <*> get2Sum

main = do
    print $ runMyMonad myDataFromApplicative [1,2]
    print $ runMyMonad myDataFromApplicative [1]