IntermediateHaskellExercises.hs

module IntermediateHaskellExercises where

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

-- Exercise 1
instance Fluffy [] where
  furry :: (a -> b) -> [a] -> [b]
  furry _ []     = []
  furry f (x:xs) = f x : furry f xs

-- Exercise 2
instance Fluffy Maybe where
  furry :: (a -> b) -> Maybe a -> Maybe b
  furry _ Nothing  = Nothing
  furry f (Just a) = Just (f a)

-- Exercise 3
instance Fluffy ((->) t) where
  furry :: (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
instance Fluffy (EitherLeft t) where
  furry :: (a -> b) -> EitherLeft t a -> EitherLeft t b
  furry f (EitherLeft (Left a))  = EitherLeft (Left (f a))
  furry _ (EitherLeft (Right b)) = EitherLeft (Right b)

-- Exercise 5
instance Fluffy (EitherRight t) where
  furry :: (a -> b) -> EitherRight t a -> EitherRight t b
  furry f (EitherRight (Right a)) = EitherRight (Right (f a))
  furry _ (EitherRight (Left b))  = EitherRight (Left b)

class Misty m where
  banana :: (a -> m b) -> m a -> m b
  unicorn :: a -> m a
  -- Exercise 6
  furry' :: (a -> b) -> m a -> m b
  furry' f = banana (unicorn . f)

-- Exercise 7
instance Misty [] where
  banana :: (a -> [b]) -> [a] -> [b]
  banana = concatMap
  unicorn :: a -> [a]
  unicorn a = [a]

-- Exercise 8
instance Misty Maybe where
  banana :: (a -> Maybe b) -> Maybe a -> Maybe b
  banana f (Just a) = f a
  banana f Nothing  = Nothing
  unicorn :: a -> Maybe a
  unicorn = Just

-- Exercise 9
instance Misty ((->) t) where
  banana :: (a -> (t -> b)) -> (t -> a) -> (t -> b)
  banana f fa = \t -> f (fa t) t
  unicorn :: a -> (t -> a)
  unicorn = const

-- Exercise 10
instance Misty (EitherLeft t) where
  banana :: (a -> EitherLeft t b) -> EitherLeft t a -> EitherLeft t b
  banana f (EitherLeft (Left a))  = f a
  banana _ (EitherLeft (Right b)) = EitherLeft (Right b)
  unicorn :: a -> EitherLeft t a
  unicorn = EitherLeft . Left

-- Exercise 11
instance Misty (EitherRight t) where
  banana :: (a -> EitherRight t b) -> EitherRight t a -> EitherRight t b
  banana f (EitherRight (Right a)) = f a
  banana _ (EitherRight (Left b))  = EitherRight (Left b)
  unicorn :: a -> EitherRight t a
  unicorn = EitherRight . Right

-- Exercise 12
jellybean :: (Misty m) => m (m a) -> m a
jellybean = banana id

-- Exercise 13
apple :: (Misty m) => m a -> m (a -> b) -> m b
apple fa fab = banana (\x -> furry' (\f -> f x) fab) fa

-- Exercise 14
moppy :: (Misty m) => [a] -> (a -> m b) -> m [b]
moppy xs f =
  foldr
    (\x acc -> banana (\b -> furry' (\bs -> b : bs) acc) (f x))
    (unicorn [])
    xs

-- Exercise 15
sausage :: (Misty m) => [m a] -> m [a]
sausage xs = moppy xs id

-- Exercise 16
banana2 :: (Misty m) => (a -> b -> c) -> m a -> m b -> m c
banana2 f ma mb = apple mb (furry' f ma)

-- Exercise 17
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
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
instance Fluffy (State s) where
  furry :: (a -> b) -> State s a -> State s b
  furry f sa =
    State $ \s ->
      let (s', a) = state sa s
      in (s', f a)

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