Cap'n Freako's Solutions to 20 Intermediate Exercises

This IHaskell notebook contains my solutions to 20 intermediate exercies by Dan Burton.

David Banas capn.freako@gmail.com
Created: December 25, 2015

Instructions (from Dan's page)

Fill in the blanks (which are marked error "todo") with a nontrivial implementation that typechecks. I recommend that you use the run button after implementing each one to make sure that it still typechecks. Let the types guide you! If you have trouble implementing a typeclass method, then try writing out the specialized type that it should have. For example, furry imlpemented for [] should have the type (a -> b) -> [a] -> [b].



In [1]:

    
import Data.Time

putStrLn "Notebook last run:"
getCurrentTime









    





Notebook last run:






    





2015-12-27 17:13:50.11655 UTC



In [2]:

    
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 = fmap

-- Exercise 3
-- Relative Difficulty: 5
instance Fluffy ((->) t) where
  -- furry :: (a -> b) -> (c -> a) -> (c -> b)
  -- furry g h = g . h
  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 :: (t -> u) -> EitherLeft t v -> EitherLeft u v
  furry g (EitherLeft (Left x)) = EitherLeft (Left (g x))
  furry g (EitherLeft (Right y)) = EitherLeft (Right y)

-- Exercise 5
-- Relative Difficulty: 5
instance Fluffy (EitherRight t) where
  furry g (EitherRight (Left x)) = EitherRight (Left x)
  furry g (EitherRight (Right y)) = EitherRight (Right (g y))



In [3]:

    
class Misty m where
  banana :: (a -> m b) -> m a -> m b
  unicorn :: a -> m a

-- Exercise 7
-- Relative Difficulty: 2
instance Misty [] where
  -- banana :: (a -> [b]) -> [a] -> [b]
  -- banana g xs = concat $ map g xs
  -- banana g = concat . (map g)
  banana = \ g -> concat . (map g)
  -- unicorn :: a -> [a]
  -- unicorn x = [x]
  unicorn = (: [])

-- Exercise 8
-- Relative Difficulty: 2
instance Misty Maybe where
  -- banana :: (a -> Maybe b) -> Maybe a -> Maybe b
  banana g Nothing = Nothing
  banana g (Just x) = g x
  -- banana = \ g -> join . (fmap g) ?
  -- unicorn :: a -> Maybe a
  -- unicorn x = Just x
  unicorn = Just

-- Exercise 9
-- Relative Difficulty: 6
instance Misty ((->) t) where
  -- banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b)
  banana g h = \ x -> g (h x) x
  -- unicorn :: a -> (t -> a)
  -- unicorn x = const x
  unicorn = const

newtype EitherLeft b a  = EitherLeft (Either a b)
newtype EitherRight a b = EitherRight (Either a b)

-- Exercise 10
-- Relative Difficulty: 6
instance Misty (EitherLeft t) where
  -- banana :: (a -> EitherLeft t b) -> EitherLeft t a -> EitherLeft t b
  banana g (EitherLeft (Left a))  = g a
  banana _ (EitherLeft (Right t)) = EitherLeft (Right t)
  -- unicorn :: a -> EitherLeft t a
  unicorn x = EitherLeft (Left x)

-- Exercise 11
-- Relative Difficulty: 6
instance Misty (EitherRight t) where
  -- banana :: (a -> EitherRight t b) -> EitherRight t a -> EitherRight t b
  banana g (EitherRight (Right a)) = g a
  banana _ (EitherRight (Left t))  = EitherRight (Left t)
  -- unicorn :: a -> EitherLeft t a
  unicorn x = EitherRight (Right x)



In [4]:

    
-- Exercise 6
-- Relative Difficulty: 3
-- (use banana and/or unicorn)
furry' :: (Misty m) => (a -> b) -> m a -> m b
-- furry' g m = banana (unicorn . g) m
furry' g = banana (unicorn . g)

-- Exercise 12
-- Relative Difficulty: 3
jellybean :: (Misty m) => m (m a) -> m a
-- jellybean mm = banana id mm
jellybean = banana id

-- Exercise 13
-- Relative Difficulty: 6
apple :: (Misty m) => m a -> m (a -> b) -> m b
-- apple mx mf = banana (\x -> banana (\g -> unicorn (g x)) mf) mx
-- apple mx = \mf -> banana (\x -> banana (\g -> unicorn (g x)) mf) mx
apple = flip (\mf -> banana (\x -> banana (\g -> unicorn (g x)) mf))

-- Exercise 14
-- Relative Difficulty: 6
moppy :: (Misty m) => [a] -> (a -> m b) -> m [b]
-- moppy xs g = foldl (\m x -> banana (\ys -> (banana (\y -> unicorn (ys ++ [y])) (g x))) m) (unicorn []) xs
moppy = flip moppy'
 where moppy' g = foldl (\m x -> banana (\ys -> (banana (\y -> unicorn (ys ++ [y])) (g x))) m) (unicorn [])

-- Exercise 15
-- Relative Difficulty: 6
-- (bonus: use moppy)
sausage :: (Misty m) => [m a] -> m [a]
-- sausage ms = moppy ms id
sausage = flip moppy id

-- Exercise 16
-- Relative Difficulty: 6
-- (bonus: use apple + furry')
banana2 :: (Misty m) => (a -> b -> c) -> m a -> m b -> m c
-- banana2 g ma mb = apple mb (furry' g ma)
-- banana2 g ma = flip apple (furry' g ma)
banana2 g = flip apple . furry' g

-- 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 g ma = flip apple . banana2 g ma

-- 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 g ma mb = flip apple . banana3 g ma mb



In [5]:

    
newtype State s a = State {
  state :: (s -> (s, a))
 }

-- Exercise 19
-- Relative Difficulty: 9
instance Fluffy (State s) where
  -- furry :: (a -> b) -> State s a -> State s b
  furry g (State h) = State (second g . h)

second :: (b -> c) -> (a, b) -> (a, c)
second g p = (fst p, g . snd $ p)

-- Exercise 20
-- Relative Difficulty: 10
instance Misty (State s) where
  -- banana :: (a -> State s b) -> State s a -> State s b
  -- state sa :: s -> (s, a)
  -- state . g . snd :: (a2, a1) -> s -> (s, a)
  -- furry (state . g . snd) (state sa) :: a1 -> s -> (s, a)
  -- jellybean (furry (state . g . snd) (state sa)) :: s -> (s, a)
  banana g sa = State (jellybean (furry (state . g . snd) (state sa)))

  -- unicorn :: a -> State s a
  unicorn x = State (\s -> (s, x))