20-intermediate-haskell-exercises.hs

{-# LANGUAGE TupleSections #-}

module Exe where

class Fluffy f where
  furry :: (a -> b) -> f a -> f b

                                -- Exercise 1
                                -- Relative Difficulty: 1
instance Fluffy [] where
  furry _ [] = []
  furry f (x:xs) = f x:furry f xs

                                -- 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
  -- (a -> b) -> (t -> a) -> (t -> b)
  furry f g = f . g

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
  -- (a -> b) -> (EitherLeft t a) -> (EitherLeft t b)
  -- (a -> b) -> (EitherLeft (Either a t)) -> (EitherLeft (Either b t))
  furry f (EitherLeft (Left x)) = EitherLeft $ Left $ f x
  furry _ (EitherLeft (Right x)) = EitherLeft $ Right x

                               -- Exercise 5
                               -- Relative Difficulty: 5
instance Fluffy (EitherRight t) where
  furry f (EitherRight e) = EitherRight $ fmap f e

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' f = banana (unicorn . f)

       -- Exercise 7
       -- Relative Difficulty: 2
instance Misty [] where
  banana = concatMap

  unicorn x = [x]

       -- Exercise 8
       -- Relative Difficulty: 2
instance Misty Maybe where
  banana _ Nothing = Nothing
  banana f (Just x) = f x

  unicorn = Just

       -- Exercise 9
       -- Relative Difficulty: 6
instance Misty ((->) t) where
  -- (a -> t -> b) -> (t -> a) -> (t -> b)
  banana f g t = f (g t) t

  -- a -> (t -> a)
  unicorn a _ = a

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

  -- a -> EitherLeft t a
  unicorn x = EitherLeft $ Left x

       -- 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 x = EitherRight $ Right x

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

-- look m (a -> b) as m t
-- then banana (a -> b -> mb) mt = mb
-- apple ma mf = ma >>= \a -> mf >>= \f -> unicorn $ f a
apple ma mf = banana (\a -> banana (\f -> unicorn $ f a) mf) ma

-- Exercise 14
-- Relative Difficulty: 6
moppy :: (Misty m) => [a] -> (a -> m b) -> m [b]
moppy as f = foldr k (unicorn []) as
  where
    k a accu = banana (\b -> banana (\bs -> unicorn $ b:bs) accu) $ f a

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

-- 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 = apple mb $ furry' f ma

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

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

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

       -- Exercise 19
       -- Relative Difficulty: 9
instance Fluffy (State s) where
  furry f st = State $ (\(s, a) -> (s, f a)) . state st

-- Exercise 20
-- Relative Difficulty: 10
instance Misty (State s) where
  -- (a -> State s b) -> (State s a) -> State s b
  banana f st = State
    $ \s -> let (s', a) = state st s
            in state (f a) s'

  unicorn a = State (, a)