Add some Contravariant exercises

README.markdown

@@ -265,6 +265,7 @@ After this, the following progression of modules is recommended:
 * `Course.StateT`
 * `Course.Extend`
 * `Course.Comonad`
+* `Course.Contravariant`
 * `Course.Compose`
 * `Course.Traversable`
 * `Course.ListZipper`

course.cabal

@@ -55,6 +55,7 @@ library
                       Course.Cheque
                       Course.Comonad
                       Course.Compose
+                      Course.Contravariant
                       Course.Core
                       Course.ExactlyOne
                       Course.Extend

src/Course/Compose.hs

@@ -7,6 +7,7 @@ import Course.Core
 import Course.Functor
 import Course.Applicative
 import Course.Monad
+import Course.Contravariant
 
 -- Exactly one of these exercises will not be possible to achieve. Determine which.
 
@@ -32,4 +33,13 @@ instance (Monad f, Monad g) =>
   Monad (Compose f g) where
 -- Implement the (=<<) function for a Monad instance for Compose
   (=<<) =
-    error "todo: Course.Compose (<<=)#instance (Compose f g)"
+    error "todo: Course.Compose (=<<)#instance (Compose f g)"
+
+-- Note that the inner g is Contravariant but the outer f is
+-- Functor. We would not be able to write an instance if both were
+-- Contravariant; why not?
+instance (Functor f, Contravariant g) =>
+  Contravariant (Compose f g) where
+-- Implement the (>$<) function for a Contravariant instance for Compose
+  (>$<) =
+    error "todo: Course.Compose (>$<)#instance (Compose f g)"

src/Course/Contravariant.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module Course.Contravariant where
+
+import Course.Core
+
+-- | A 'Predicate' is usually some kind of test about a
+-- thing. Example: a 'Predicate Integer' says "give me an 'Integer'"
+-- and I'll answer 'True' or 'False'.
+data Predicate a = Predicate (a -> Bool)
+
+runPredicate ::
+  Predicate a
+  -> a
+  -> Bool
+runPredicate (Predicate f) =
+  f
+
+-- | A 'Comparison' looks at two things and says whether the first is
+-- smaller, equal to, or larger than the second. 'Ordering' is a
+-- three-valued type used as the result of a comparison, with
+-- constructors 'LT', 'EQ', and 'GT'.
+data Comparison a = Comparison (a -> a -> Ordering)
+
+runComparison ::
+  Comparison a
+  -> a
+  -> a
+  -> Ordering
+runComparison (Comparison f) =
+  f
+
+-- | All this type does is swap the arguments around. We'll see why we
+-- want it when we look at its 'Contravariant' instance.
+data SwappedArrow a b = SwappedArrow (b -> a)
+
+runSwappedArrow ::
+  SwappedArrow a b
+  -> b
+  -> a
+runSwappedArrow (SwappedArrow f) = f
+
+-- | All instances of the `Contravariant` type-class must satisfy two
+-- laws. These laws are not checked by the compiler. These laws are
+-- given as:
+--
+-- * The law of identity
+--   `∀x. (id >$< x) ≅ x`
+--
+-- * The law of composition
+--   `∀f g x. (g . f >$< x) ≅ (f >$< (g >$< x))`
+--
+-- If you think of a 'Functor' as "having" an @a@ that you map over,
+-- you can think of a 'Contravariant' as "accepting" an @a@. So if you
+-- can turn @b@ into @a@ (i.e., with the first argument to (>$<)')
+-- then you can make your 'Contravariant' accept @b@ instead.
+class Contravariant f where
+  -- Pronounced, contramap.
+  (>$<) ::
+    (b -> a)
+    -> f a
+    -> f b
+
+infixl 4 >$<
+
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> import Course.Core
+-- >>> import Prelude (length)
+
+-- | Maps a function before a Predicate.
+--
+-- >>> runPredicate ((+1) >$< Predicate even) 2
+-- False
+instance Contravariant Predicate where
+  (>$<) ::
+    (b -> a)
+    -> Predicate a
+    -> Predicate b
+  (>$<) =
+    error "todo: Course.Contravariant (>$<)#instance Predicate"
+
+-- | Use the function before comparing.
+--
+-- >>> runComparison (show >$< Comparison compare) 2 12
+-- GT
+instance Contravariant Comparison where
+  (>$<) ::
+    (b -> a)
+    -> Comparison a
+    -> Comparison b
+  (>$<) =
+    error "todo: Course.Contravariant (>$<)#instance Comparison"
+
+-- | The kind of the argument to 'Contravariant' is @Type -> Type@, so
+-- our '(>$<)' only works on the final type argument. The
+-- 'SwappedArrow' type reverses the arguments, which gives us the
+-- right shape.
+--
+-- >>> runSwappedArrow (length >$< SwappedArrow (+10)) "hello"
+-- 15
+instance Contravariant (SwappedArrow t) where
+  (>$<) ::
+    (b -> a)
+    -> SwappedArrow x a
+    -> SwappedArrow x b
+  (>$<) =
+    error "todo: Course.Contravariant (>$<)#instance SwappedArrow"
+
+
+-- | If we give our 'Contravariant' an @a@, then we can "accept" any
+-- @b@ by ignoring it.
+--
+-- prop> \x -> runPredicate (3 >$ Predicate odd) x == True
+(>$) ::
+  Contravariant f =>
+  a
+  -> f a
+  -> f b
+(>$) =
+  error "todo: Course.Contravariant#(>$)"

src/Course/Core.hs

@@ -12,6 +12,7 @@ module Course.Core(
 , Fractional(..)
 , Bool(..)
 , Either(..)
+, Ordering(..)
 , Int
 , Integer
 , IO
@@ -57,6 +58,7 @@ import Prelude(
   , Fractional(..)
   , Bool(..)
   , Either(..)
+  , Ordering(..)
   , Char
   , Int
   , Integer
@@ -118,4 +120,3 @@ bool f _ False =
   f
 bool _ t True =
   t
-