The solutions to the '20 intermediate haskell exercises'. (http://blog.tmorris.net/posts/20-intermediate-haskell-exercises/)

20-intermediate-haskell-exercises.hs

import Control.Monad
import Control.Arrow
 
 
class Fluffy f where
    furry :: (a -> b) -> f a -> f b
 
-- Exercise 1
-- Relative Difficulty: 1
instance Fluffy [] where
    furry = map
 
-- Exercise 2
-- Relative Difficulty: 1
instance Fluffy Maybe where
    furry _ Nothing  = Nothing
    furry f (Just x) = Just (f x)
 
-- Exercise 3
-- Relative Difficulty: 5
instance Fluffy ((->) t) where
    furry = (.)
 
newtype EitherLeft b a = EitherLeft (Either a b)
newtype EitherRight a b = EitherRight (Either a b)
 
-- Exercise 4
-- Relative Difficulty: 5
instance Fluffy (EitherLeft t) where
    furry f (EitherLeft (Left a)) = EitherLeft $ Left $ f a
    furry f (EitherLeft (Right x)) = EitherLeft $ Right x
 
-- Exercise 5
-- Relative Difficulty: 5
instance Fluffy (EitherRight t) where
    furry f (EitherRight (Left a)) = EitherRight $ Left a
    furry f (EitherRight (Right x)) = EitherRight $ Right $ f x
 
class Misty m where
  banana :: (a -> m b) -> m a -> m b
  unicorn :: a -> m a
  -- Exercise 6
  -- Relative Difficulty: 3
  -- (use banana and/or unicorn)
  furry' :: (a -> b) -> m a -> m b
  furry' = (banana . (unicorn .))
  -- furry' f = (banana (unicorn . f))
 
-- Exercise 7
-- Relative Difficulty: 2
instance Misty [] where
  banana = (join .) . fmap
  unicorn = (:[])
 
-- Exercise 8
-- Relative Difficulty: 2
instance Misty Maybe where
    banana f (Just v) = f v
    banana f Nothing  = Nothing
    unicorn = Just
 
-- Exercise 9
-- Relative Difficulty: 6
instance Misty ((->) t) where
  -- banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b)
  banana f g = \x -> f (g x) x
  -- unicorn :: (a -> (t -> a))
  unicorn = const
 
-- Exercise 10
-- Relative Difficulty: 6
instance Misty (EitherLeft t) where
    banana f (EitherLeft (Left x)) = f x
    banana _ (EitherLeft (Right x)) = EitherLeft $ Right x
    unicorn = EitherLeft . Left
 
-- Exercise 11
-- Relative Difficulty: 6
instance Misty (EitherRight t) where
    banana f (EitherRight (Right x)) = f x
    banana _ (EitherRight (Left x)) = EitherRight $ Left x
    unicorn = EitherRight . Right
 
                -- Exercise 12
-- Relative Difficulty: 3
jellybean :: (Misty m) => m (m a) -> m a
jellybean = banana id
 
-- Exercise 13
-- Relative Difficulty: 6
apple :: (Misty m) => m a -> m (a -> b) -> m b
apple ma mf = banana (\f -> banana (unicorn . f) ma) mf
 
-- Exercise 14
-- Relative Difficulty: 6
moppy :: (Misty m) => [a] -> (a -> m b) -> m [b]
moppy xs f = foldr (banana2 (:) . f) (unicorn []) xs
-- moppy xs f = foldr (\x -> (banana2 (:)) (f x)) (unicorn []) xs
-- liftX2 :: (Misty m) => (a -> b -> c) -> m a -> m b -> m c
-- moppy xs f = foldl (\mxs x -> banana (\b -> banana
--                                            (\xs' -> unicorn $ b : xs') mxs)
--                               (f x)) (unicorn []) xs
 
-- Exercise 15
-- Relative Difficulty: 6
-- (bonus: use moppy)
sausage :: (Misty m) => [m a] -> m [a]
sausage = flip moppy id
-- sausage xms = moppy xms id
-- sausage xs = foldr (banana2 (:) . id) (unicorn []) xs
 
-- Exercise 16
-- Relative Difficulty: 6
-- (bonus: use apple + furry')
banana2 :: (Misty m) => (a -> b -> c) -> m a -> m b -> m c
-- banana2 f ma mb = banana (\a -> (banana (\b -> unicorn $ f a b) mb)) ma
-- banana2 f ma mb = apple mb $ apple ma (unicorn f)
-- banana2 f ma mb = apple mb $ furry' f ma
banana2 = (flip apple .) . furry'
 
-- Exercise 17
-- Relative Difficulty: 6
-- (bonus: use apple + banana2)
banana3 :: (Misty m) => (a -> b -> c -> d) -> m a -> m b -> m c -> m d
-- banana3 f ma mb mc = apple mc $ banana2 f ma mb
banana3 = ((flip apple .) .) . banana2
 
-- Exercise 18
-- Relative Difficulty: 6
-- (bonus: use apple + banana3)
banana4 :: (Misty m) => (a -> b -> c -> d -> e) -> m a -> m b -> m c -> m d -> m e
-- banana4 f ma mb mc md = apple md $ banana3 f ma mb mc
banana4 = (((flip apple .) .) .) . banana3
 
newtype State s a = State {
    state :: (s -> (s, a))
    }
 
-- Exercise 19
-- Relative Difficulty: 9
instance Fluffy (State s) where
    furry f (State a) = State (\x -> let (s,a') = a x in (s,f a'))
 
-- Exercise 20
-- Relative Difficulty: 10
instance Misty (State s) where
    banana f ma = State (\s -> let (s', a) = (state ma s) in state (f a) s')
    unicorn a = State (\x -> (x, a))