Haskell logo CIS 5520: Advanced Programming

Fall 2023

  • Home
  • Schedule
  • Homework
  • Resources
  • Software
  • Style guide
Note: this is the completed version of lecture GenericMonads.

In class exercise: General Monadic Functions

> module GenericMonads where
> import Prelude hiding (mapM, sequence)
> import Test.HUnit
> import qualified Data.Char as Char 

Generic Monad Operations

This problem asks you to recreate some of the operations in the Control.Monad library. You should not use any of the functions defined in that library to solve this problem. (These functions also appear in more general forms elsewhere, so other libraries that are off limits for this problem include Control.Applicative, Data.Traversable and Data.Foldable.)

NOTE: because these operations are so generic, the types will really help you figure out the implementation, even if you don't quite know what the function should do.

For that reason you should also test each of these functions with at least two unit test cases, one using the Maybe monad, and one using the List monad. After you you have tried the function out, try to describe in words what each operation does for that specific monad.

Here is the first one as an example.

> -- (a)

Given the type signature:

> mapM :: Monad m => (a -> m b) -> [a] -> m [b]

We implement it by recursion on the list argument.

> mapM _ []     = return []
> mapM f (x:xs) = do
>    b <- f x
>    bs <- mapM f xs
>    return (b:bs)

Then define the following test cases, which make use of the following helper functions.

> maybeUpper :: Char -> Maybe Char
> maybeUpper x = if Char.isAlpha x then Just (Char.toUpper x) else Nothing
> onlyUpper :: [Char] -> [Char]
> onlyUpper = filter Char.isUpper
> -- >>> mapM maybeUpper "sjkdhf"   
> -- Just "SJKDHF"
> -- >>> mapM maybeUpper "sa2ljsd"
> -- Nothing
> -- >>> mapM onlyUpper ["QuickCheck", "Haskell"]
> -- ["QH","CH"]
> -- >>> mapM onlyUpper ["QuickCheck", ""]
> -- []

Finally, we observe that this function is a generalization of List.map, where the mapped function can return its value in some monad m.

> -- (b)
>  --Define a monadic generalization of foldl 
> foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
> 
> foldM _ a [] = return a
> foldM f a (b:bs) = do
>     a' <- f a b
>     foldM f a' bs
> 
> testFoldM :: Test
> testFoldM = TestList [ addIfEven [1,2,3]  ~=? Nothing,
>                        addIfEven [2,4]    ~=? Just 6,
>                        foldM safeDiv 16 [2,2] ~=? Just 4,
>                        foldM (flip replicate) 'a' [3,2] ~=? "aaaaaa"
>                      ]
> addIfEven :: [Int] -> Maybe Int
> addIfEven = foldM f 0 where
>                f x y | even x    = Just (x + y)
>                      | otherwise = Nothing
> safeDiv :: Int -> Int -> Maybe Int
> safeDiv x y = if y == 0 then Nothing else Just (x `div` y)
> -- >>> foldM (flip replicate) 'a' [1,2,3,4]
> -- "aaaaaaaaaaaaaaaaaaaaaaaa"
> -- >>> crazy [1,2,3,4,5]
> -- [0,5,4,5,4,5,2,5,4,5,4,5,2,5,4,5,4,5]
> crazy :: [Int] -> [Int]
> crazy = foldM f 0 where
>     f x y | even x    = [ x , y ]
>           | otherwise = [ y ]
> -- (c)
>  -- a generalization of monadic sequencing that evaluates
> -- each action in a list from left to right, collecting the results
> -- in a list. 
> sequence :: Monad m => [m a] -> m [a]
> 
> sequence = foldr k (return [])
>            where
>              k m m' = do { x <- m; xs <- m'; return (x:xs) }
> 
> testSequence :: Test
> testSequence = TestList [
>      sequence [Just (3::Int), Nothing, Just 4] ~=? Nothing
>    , sequence [[1::Int,2],[3],[4,5]] ~=? [[1,3,4],[1,3,5],[2,3,4],[2,3,5]]
>    , sequence (map maybeUpper "abcd") ~=? Just "ABCD"
>    , sequence (map maybeUpper "abcd2") ~=? Nothing
>    ]
> -- (d) This one is the Kleisli "fish operator"
> --  a variant of composition 
> (>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
> 
> f >=> g     = \x -> f x >>= g
> 
> testKleisli :: Test
> testKleisli = TestList [ (maybeUpper >=> earlyOrd) 'a' ~=? Just 65
>                        , (maybeUpper >=> earlyOrd) '2' ~=? Nothing
>                        , (mDup >=> mDup) 1 ~=? [1,1,1,1]
>                        , (replicate 2 >=> replicate 3) 'l' ~=? "llllll"
>                        ]
> 
> mDup :: Int -> [Int]
> mDup x = [x,x]
> 
> earlyOrd :: Char -> Maybe Int
> earlyOrd c = if c < 'm' then Just (Char.ord c) else Nothing
> 
> -- For more information about this operator, see the explanation at the bottom of
> -- [this page](http://www.haskell.org/haskellwiki/Monad_laws).
> 
> -- (e)
>  -- Define the 'join' operator, which removes one level of
> -- monadic structure. 
> join :: (Monad m) => m (m a) -> m a
> 
> join x            =  x >>= id
> 
> testJoin :: Test
> testJoin = TestList [ join [[1::Int,2],[3,4]] ~=? [1,2,3,4],
>                       join [[1::Int,2],[3,4],[]] ~=? [1,2,3,4],
>                       join (Just (Just (3::Int))) ~=? Just 3
>                     ]
> -- (f) Define the 'liftM' function
>  -- promotes functions `a -> b` to functions over
> -- actions in a monad `m a -> m b`. 
> liftM   :: (Monad m) => (a -> b) -> m a -> m b
> 
> liftM f m1 = do { x1 <- m1; return (f x1) }
> 
> testLiftM :: Test
> testLiftM = TestList [ liftM not (Just True) ~=? Just False,
>                        liftM not [True,False] ~=? [False,True] ]
> -- Thought question: Is the type of `liftM` similar to that of another
> -- function we've discussed recently?
>  -- ANSWER: `liftM` is the same function as `fmap`. 
> -- (g) And its two-argument version ...
> liftM2  :: (Monad m) => (a -> b -> r) -> m a -> m b -> m r
> 
> liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
> 
> testLiftM2 :: Test
> testLiftM2 = TestList [liftM2 (+) (Just (1::Int)) (Just 2) ~=? Just 3,
>                        liftM2 (+) [1,2] [3,4::Int] ~=? [4,5,5,6] ]

General Applicative Functions

Which of these functions above can you equivalently rewrite using Applicative? i.e. for which of the definitions below, can you replace undefined with a definition that only uses members of the Applicative (and Functor) type class. (Again, do not use functions from Control.Applicative, Data.Foldable or Data.Traversable in your solution.)

If you provide a definition, you should write test cases that demonstrate that it has the same behavior on List and Maybe as the monadic versions above.

> -- NOTE: you will not be able to define all of these, but be sure to test the
> -- ones that you do
> mapA :: Applicative f => (a -> f b) -> [a] -> f [b]
>  
> mapA f [] = pure []
> mapA f (x : xs) = (:) <$> f x <*> mapA f xs
> foldA :: forall f a b. Applicative f => (a -> b -> f a) -> a -> [b] -> f a
> foldA = undefined
> sequenceA :: Applicative f => [f a] -> f [a]
> sequenceA =  foldr (liftA2 (:)) (pure [])
> kleisliA :: Applicative f => (a -> f b) -> (b -> f c) -> a -> f c
> kleisliA = undefined
> joinA :: (Applicative f) => f (f a) -> f a
> joinA = undefined 
> liftA   :: (Applicative f) => (a -> b) -> f a -> f b
> liftA f x = f <$> x
> liftA2  :: (Applicative f) => (a -> b -> r) -> f a -> f b -> f r
> liftA2 f x y = f <$> x <*> y
Design adapted from Minimalistic Design | Powered by Pandoc and Hakyll