In the book "Haskell programming from first principles" it is said that:

If you are using GHC 7.10 or newer, you’ll see an Applicative constraint in the definition of Monad, as it should be:

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

I have created the following applicative functor.

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

Due to lack of examples, I am not understanding how to implement >>= and >>. The code I came up with so far is:

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

So, that I can do stuff like:

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)

With Output:

10
ItDoesnt
ItDoesnt
ItDoesnt
5

Please help.

CodePudding user response：

How to implement a monad instance for a given data type is in general not answerable without concrete information for how you want that instance to behave – there can be multiple valid instances for a single type.

For this example though, I see only one way: make it behave like the equivalent form

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

So I suggest looking up the Monad (Either c) instance and basing yours on that. The difference is that the Left case corresponds to two different constructors of your type, so you need a clause for each of them.

CodePudding user response：

OP Here. I have removed WhatThisIsCalled.

Now the solution looks like:

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)