如何在 GHC 7.10 或更新版本中創建 monad

Question

在“Haskell programming from first principles”一書中說：

如果您使用的是 GHC 7.10 或更新版本，您將在 Monad 的定義中看到一個 Applicative 約束，因為它應該是：

 class Applicative m => Monad m where (>>=):: ma -> (a -> mb) -> mb (>>):: ma -> mb -> mb return:: a -> ma

我創建了以下應用函子。

data WhoCares a = ItDoesnt | Matter a | WhatThisIsCalled deriving (Eq, Show)

instance Functor WhoCares where
    fmap _ ItDoesnt = ItDoesnt
    fmap _ WhatThisIsCalled = WhatThisIsCalled
    fmap f (Matter a) = Matter (f a)

instance Applicative WhoCares where
    pure = Matter
    Matter f <*> Matter a = Matter (f a)

main = do

    -- fmap id == id
    let funcx = fmap id "Hi Julie"
    let funcy = id "Hi Julie"
    print(funcx)
    print(funcy)
    print(funcx == funcy)

    -- fmap (f . g) == fmap f . fmap g
    let funcx' = fmap ((+1) . (*2)) [1..5]
    let funcy' = fmap (+1) . fmap (*2) $ [1..5]
    print(funcx')
    print(funcy')
    print(funcx' == funcy')

    -- pure id <*> v = v
    print(pure id <*> (Matter 10))

    -- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
    let appx = pure (.) <*> (Matter (+1)) <*> (Matter (*2)) <*> (Matter 10)
    let appy = (Matter (+1)) <*> ((Matter (*2)) <*> (Matter 10))
    print(appx)
    print(appy)
    print(appx == appy)

    -- pure f <*> pure x = pure (f x)
    let appx' = pure (+1) <*> pure 1 :: WhoCares Int
    let appy' = pure ((+1) 1) :: WhoCares Int
    print(appx')
    print(appy')
    print(appx' == appy')

    -- u <*> pure y = pure ($ y) <*> u
    let appx'' = Matter (+2) <*> pure 2
    let appy'' = pure ($ 2) <*> Matter (+ 2)
    print(appx'')
    print(appy'')
    print(appx'' == appy'')

由於缺少示例，我不了解如何實施>>=和>> 。 到目前為止我想出的代碼是：

instance Monad (WhoCares a) where
    (>>=) :: Matter a -> (a -> Matter b) -> Matter b
    (>>) :: Matter a -> Matter b -> Matter b
    return :: a -> Matter a
    return = pure

所以，我可以做類似的事情：

half x = if even x
            then Matter (x `div` 2)
            else ItDoesnt

incVal :: (Ord a, Num a) => a -> WhoCares a
incVal x
    | x + 1 <= 10 = return (x + 1)
    | otherwise = ItDoesnt

decVal :: (Ord a, Num a) => a -> WhoCares a
decVal x
    | x - 1 >= 0 = return (x - 1)
    | otherwise = ItDoesnt

main = do
    print (Matter 7 >>= incVal >>= incVal >>= incVal)
    print (Matter 7 >>= incVal >>= incVal >>= incVal >>= incVal)
    print (Matter 7 >>= incVal >>= incVal >>= incVal >>= incVal >>= decVal >>= decVal)
    print (Matter 2 >>= decVal >>= decVal >>= decVal)
    print(Matter 20 >>= half >>= half)

使用 Output：

10
ItDoesnt
ItDoesnt
ItDoesnt
5

請幫忙。

Answer 1

如果沒有有關您希望該實例如何行為的具體信息，通常無法回答如何為給定數據類型實現 monad 實例——單個類型可以有多個有效實例。

不過，對於這個例子，我只看到一種方法：讓它表現得像等價形式

data ItIsCalled = ItDoesn't | WhatThisIsCalled
newtype WhoCares a = WhoCares { caresWho :: Either ItIsCalled a }

所以我建議查找Monad (Either c)實例並以此為基礎。 不同之處在於Left案例對應於您的類型的兩個不同構造函數，因此您需要為每個構造函數創建一個子句。

Answer 2

在這里。 我已經刪除了WhatThisIsCalled 。

現在解決方案看起來像：

data WhoCares a = ItDoesnt | Matter a deriving (Eq, Show)

instance Functor WhoCares where
    fmap _ ItDoesnt = ItDoesnt
    fmap f (Matter a) = Matter (f a)

instance Applicative WhoCares where
    pure = Matter
    Matter f <*> Matter a = Matter (f a)
    ItDoesnt <*> _ = ItDoesnt
    _ <*> ItDoesnt = ItDoesnt

instance Monad WhoCares where
    return x = Matter x
    (Matter x) >>= k = k x
    ItDoesnt >>= _ = ItDoesnt

half x = if even x
            then Matter (x `div` 2)
            else ItDoesnt

incVal :: (Ord a, Num a) => a -> WhoCares a
incVal x
    | x + 1 <= 10 = return (x + 1)
    | otherwise = ItDoesnt

decVal :: (Ord a, Num a) => a -> WhoCares a
decVal x
    | x - 1 >= 0 = return (x - 1)
    | otherwise = ItDoesnt

main = do
    -- fmap id == id
    let funcx = fmap id "Hi Julie"
    let funcy = id "Hi Julie"
    print(funcx)
    print(funcy)
    print(funcx == funcy)

    -- fmap (f . g) == fmap f . fmap g
    let funcx' = fmap ((+1) . (*2)) [1..5]
    let funcy' = fmap (+1) . fmap (*2) $ [1..5]
    print(funcx')
    print(funcy')
    print(funcx' == funcy')

    -- pure id <*> v = v
    print(pure id <*> (Matter 10))

    -- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
    let appx = pure (.) <*> (Matter (+1)) <*> (Matter (*2)) <*> (Matter 10)
    let appy = (Matter (+1)) <*> ((Matter (*2)) <*> (Matter 10))
    print(appx)
    print(appy)
    print(appx == appy)

    -- pure f <*> pure x = pure (f x)
    let appx' = pure (+1) <*> pure 1 :: WhoCares Int
    let appy' = pure ((+1) 1) :: WhoCares Int
    print(appx')
    print(appy')
    print(appx' == appy')

    -- u <*> pure y = pure ($ y) <*> u
    let appx'' = Matter (+2) <*> pure 2
    let appy'' = pure ($ 2) <*> Matter (+ 2)
    print(appx'')
    print(appy'')
    print(appx'' == appy'')

    -- m >>= return = m
    let monx = Matter 20 >>= return
    let mony = Matter 20
    print(monx)
    print(mony)
    print(monx == mony)

    -- return x >>= f = f x
    let monx' = return 20 >>= half
    let mony' = half 20
    print(monx')
    print(mony')
    print(monx' == mony')

    -- (m >>= f) >>= g = m >>= (\x -> f x >>= g)
    let monx'' = return 20 >>= half >>= half
    let mony'' = half 20 >>= half
    print(monx'')
    print(mony'')
    print(monx'' == mony'')

    print (Matter 7 >>= incVal >>= incVal >>= incVal)
    print (Matter 7 >>= incVal >>= incVal >>= incVal >>= incVal)
    print (Matter 7 >>= incVal >>= incVal >>= incVal >>= incVal >>= decVal >>= decVal)
    print (Matter 2 >>= decVal >>= decVal >>= decVal)
    print (Matter 20 >>= half >>= half)