Ch6 - Add deriving exercises (#240)

* Ch6 - Add deriving exercises

* Refine Semiring Complex solution with Newtype

Author: milesfrain

exercises/chapter6/test/Main.purs

@@ -19,27 +19,72 @@ main =
     runChapterExamples
     {-  Move this block comment starting point to enable more tests
 Note to reader: Delete this line to expand comment block -}
-    test "Exercise Group - Show Me" do
-      -- Tests for the first exercise in this chapter (Show Shape)
-      -- can be found at the end of the previous chapter (chapter 5).
-      Assert.equal true true
+    suite "Exercise Group - Show Me" do
+      test "Exercise - Show Point" do
+        Assert.equal "(1.0, 2.0)"
+          $ show
+          $ Point {x: 1.0, y: 2.0}
     suite "Exercise Group - Common Type Classes" do
-      suite "Exercise - Show and Eq for Complex" do
-        test "Show Complex" do
+      let cpx real imaginary = Complex {real, imaginary}
+      suite "Exercise - Show Complex" do
+        test "Show" do
           Assert.equal "1.0+2.0i"
             $ show
-            $ Complex { real: 1.0, imaginary: 2.0 }
-        test "Show Negative Complex" do
+            $ cpx 1.0 2.0
+        test "Show Negative" do
           Assert.equal "1.0-2.0i"
             $ show
-            $ Complex { real: 1.0, imaginary: -2.0 }
-        test "Eq Complex" do
-          Assert.equal (Complex { real: 1.0, imaginary: 2.0 })
-            $ Complex { real: 1.0, imaginary: 2.0 }
-        test "Eq Complex - not equal" do
+            $ cpx 1.0 (-2.0)
+      suite "Exercise - Eq Complex" do
+        test "equal" do
+          Assert.equal (cpx 1.0 2.0)
+            $ cpx 1.0 2.0
+        test "not equal" do
           Assert.expectFailure "should not be equal"
-            $ Assert.equal (Complex { real: 5.0, imaginary: 2.0 })
-            $ Complex { real: 1.0, imaginary: 2.0 }
+            $ Assert.equal (cpx 5.0 2.0)
+              $ cpx 1.0 2.0
+      suite "Exercise - Semiring Complex" do
+        test "add" do
+          Assert.equal (cpx 4.0 6.0)
+            $ add (cpx 1.0 2.0) (cpx 3.0 4.0)
+        test "multiply" do
+          Assert.equal (cpx (-5.0) 10.0)
+            $ mul (cpx 1.0 2.0) (cpx 3.0 4.0)
+      suite "Exercise - Ring Complex" do
+        test "subtract" do
+          Assert.equal (cpx 2.0 3.0)
+            $ sub (cpx 3.0 5.0) (cpx 1.0 2.0)
+      suite "Exercise - Show Shape" do
+        test "circle" do
+          Assert.equal "(Circle (1.0, 2.0) 3.0)"
+            $ show $ Circle (Point {x: 1.0, y: 2.0}) 3.0
+        test "rectangle" do
+          Assert.equal "(Rectangle (1.0, 2.0) 3.0 4.0)"
+            $ show $ Rectangle (Point {x: 1.0, y: 2.0}) 3.0 4.0
+        test "line" do
+          Assert.equal "(Line (1.0, 2.0) (3.0, 4.0))"
+            $ show $ Line (Point {x: 1.0, y: 2.0}) (Point {x: 3.0, y: 4.0})
+        test "text" do
+          Assert.equal "(Text (1.0, 2.0) \"Hello\")"
+            $ show $ Text (Point {x: 1.0, y: 2.0}) "Hello"
+      let
+        withDups =
+          [ Circle (Point {x: 1.0, y: 2.0}) 3.0
+          , Circle (Point {x: 3.0, y: 2.0}) 3.0
+          , Circle (Point {x: 1.0, y: 2.0}) 3.0
+          , Circle (Point {x: 2.0, y: 2.0}) 3.0
+          ]
+        noDups =
+          [ Circle (Point {x: 1.0, y: 2.0}) 3.0
+          , Circle (Point {x: 3.0, y: 2.0}) 3.0
+          , Circle (Point {x: 2.0, y: 2.0}) 3.0
+          ]
+      test "Exercise - dedupShapes" do
+        Assert.equal noDups
+          $ dedupShapes withDups
+      test "Exercise - dedupShapesFast" do
+        Assert.equal noDups
+          $ dedupShapesFast withDups
     suite "Exercise Group - Constraints and Dependencies" do
       suite "Exercise - Eq for NonEmpty" do
         test "NonEmpty equals" do

exercises/chapter6/test/no-peeking/Solutions.purs

@@ -1,11 +1,25 @@
 module Test.NoPeeking.Solutions where
 
 import Prelude
-import Data.Array (length, nubByEq)
+
+import Data.Array (length, nub, nubByEq, nubEq)
 import Data.Foldable (class Foldable, foldMap, foldl, foldr, maximum)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
 import Data.Hashable (class Hashable, hash, hashEqual)
 import Data.Maybe (Maybe(..))
 import Data.Monoid (power)
+import Data.Newtype (class Newtype, over2, wrap)
+
+data Point
+  = Point
+  { x :: Number
+  , y :: Number
+  }
+
+instance showPoint :: Show Point where
+  show (Point p) =
+    "(" <> show p.x <> ", " <> show p.y <> ")"
 
 newtype Complex
   = Complex
@@ -22,38 +36,120 @@ instance showComplex :: Show Complex where
     in
       show c.real <> optional_plus <> show c.imaginary <> "i"
 
+derive instance eqComplex :: Eq Complex
+{-
+-- Manual solution
 instance eqComplex :: Eq Complex where
-  eq (Complex a) (Complex b) = a.real == b.real && a.imaginary == b.imaginary
+  eq (Complex a) (Complex b) = a == b
+  -- or
+  -- eq (Complex a) (Complex b) = a.real == b.real && a.imaginary == b.imaginary
+-}
+
+derive instance newtypeComplex :: Newtype Complex _
+
+instance semiringComplex :: Semiring Complex where
+  add = over2 Complex add
+  mul = over2 Complex
+          \ { real: r1, imaginary: i1 }
+            { real: r2, imaginary: i2 }
+          ->
+            { real:      r1 * r2 - i1 * i2
+            , imaginary: r1 * i2 + r2 * i1
+            }
+  zero = wrap zero
+  one = wrap one
+{-
+-- Without Newtype
+instance semiringComplex :: Semiring Complex where
+  add (Complex c1) (Complex c2) = Complex $ c1 + c2
+  mul
+    (Complex { real: r1, imaginary: i1 })
+    (Complex { real: r2, imaginary: i2 })
+      = Complex
+          { real:      r1 * r2 - i1 * i2
+          , imaginary: r1 * i2 + r2 * i1
+          }
+  zero = Complex zero
+  one = Complex one
+  -- Could instead write `zero` and `one` more explicitly
+  --zero = Complex {real: 0.0, imaginary: 0.0}
+  --one = Complex {real: 1.0, imaginary: 1.0}
+-}
+
+derive newtype instance ringComplex :: Ring Complex
+{-
+-- Manual solution
+instance ringComplex :: Ring Complex where
+  sub (Complex a) (Complex b) = Complex $ a - b
+-}
+
+data Shape
+  = Circle Point Number
+  | Rectangle Point Number Number
+  | Line Point Point
+  | Text Point String
+
+derive instance genericShape :: Generic Shape _
+
+instance showShape :: Show Shape where
+  show = genericShow
+{-
+-- Manual solution
+instance showShape :: Show Shape where
+  show (Circle p r) = "(Circle " <> show p <> " " <> show r <> ")"
+  show (Rectangle p l w) = "(Rectangle " <> show p <> " " <> show l <> " " <> show w <> ")"
+  show (Line p1 p2) = "(Line " <> show p1 <> " " <> show p2 <> ")"
+  show (Text p s) = "(Text " <> show p <> " " <> show s <> ")"
+-}
 
 data NonEmpty a
   = NonEmpty a (Array a)
 
 instance eqNonEmpty :: Eq a => Eq (NonEmpty a) where
   eq (NonEmpty e1 a1) (NonEmpty e2 a2) = e1 == e2 && a1 == a2
+{-
+-- Derived solution
+derive instance eqNonEmpty :: Eq a => Eq (NonEmpty a)
+-}
 
 instance semigroupNonEmpty :: Semigroup (NonEmpty a) where
   append (NonEmpty e1 a1) (NonEmpty e2 a2) = NonEmpty e1 (a1 <> [ e2 ] <> a2)
 
 instance showNonEmpty :: Show a => Show (NonEmpty a) where
   show (NonEmpty e1 a1) = show e1 <> " " <> show a1
 
+derive instance functorNonEmpty :: Functor NonEmpty
+{-
+-- Manual solution
 instance functorNonEmpty :: Functor NonEmpty where
   map func (NonEmpty e1 a1) = NonEmpty (func e1) (map func a1)
+-}
 
 data Extended a
-  = Finite a
-  | Infinite
+  = Infinite
+  | Finite a
 
+derive instance eqExtended :: Eq a => Eq (Extended a)
+{-
+-- Manual Eq
 instance eqExtended :: Eq a => Eq (Extended a) where
   eq Infinite Infinite = true
   eq (Finite e1) (Finite e2) = e1 == e2
   eq _ _ = false
+-}
 
 instance ordExtended :: Ord a => Ord (Extended a) where
   compare Infinite Infinite = EQ
   compare Infinite (Finite _) = GT
   compare (Finite _) Infinite = LT
   compare (Finite v1) (Finite v2) = compare v1 v2
+{-
+-- Note that it would have been possible to derive Ord if
+-- the constructor order was reversed, although using implicit
+-- ordering may make our intentions less clear if we care about
+-- how things are ordered.
+derive instance ordExtended :: Ord a => Ord (Extended a)
+-}
 
 instance foldableNonEmpty :: Foldable NonEmpty where
   foldr func st (NonEmpty val arr) = foldr func st ([ val ] <> arr)
@@ -72,6 +168,18 @@ instance foldableOneMore :: Foldable f => Foldable (OneMore f) where
     firstB = (func st val)
   foldMap func (OneMore val more) = (func val) <> (foldMap func more)
 
+derive instance eqPoint :: Eq Point
+derive instance eqShape :: Eq Shape
+
+dedupShapes :: Array Shape -> Array Shape
+dedupShapes = nubEq
+
+derive instance ordPoint :: Ord Point
+derive instance ordShape :: Ord Shape
+
+dedupShapesFast :: Array Shape -> Array Shape
+dedupShapesFast = nub
+
 unsafeMaximum :: Partial => Array Int -> Int
 unsafeMaximum arr = case maximum arr of
   Just m -> m

text/chapter6.md

@@ -125,7 +125,15 @@ No type class instance was found for
 
  ## Exercises
 
- 1. (Easy) Use the `showShape` function from the previous chapter to define a `Show` instance for the `Shape` type.
+1. (Easy) Define a `Show` instance for `Point`. Match the same output as the `showPoint` function from the previous chapter.
+
+    ```haskell
+    data Point
+      = Point
+      { x :: Number
+      , y :: Number
+      }
+    ```
 
 ## Common Type Classes
 
@@ -304,18 +312,41 @@ Whatever "lifting" means in the general sense, it should be true that any reason
 
 Many standard type classes come with their own set of similar laws. The laws given to a type class give structure to the functions of that type class and allow us to study its instances in generality. The interested reader can research the laws ascribed to the standard type classes that we have seen already.
 
- ## Exercises
+### Deriving Instances
 
- 1. (Easy) The following newtype represents a complex number:
+Rather than writing instances manually, you can let the compiler to most of the work for you. Take a look at this [Type Class Deriving guide](https://github.com/purescript/documentation/blob/master/guides/Type-Class-Deriving.md). That information will help you solve the following exercises.
 
-     ```haskell
-     newtype Complex = Complex
-       { real :: Number
-       , imaginary :: Number
-       }
-     ```
+## Exercises
+
+The following newtype represents a complex number:
+
+```haskell
+newtype Complex
+  = Complex
+  { real :: Number
+  , imaginary :: Number
+  }
+```
+
+1. (Easy) Define a `Show` instance for `Complex`. Match the output format expected by the tests (e.g. `1.2+3.4i`, `5.6-7.8i`, etc.).
+
+2. (Easy) Derive an `Eq` instance for `Complex`. _Note_: You may instead write this instance manually, but why do more work if you don't have to?
+
+3. (Medium) Define a `Semiring` instance for `Complex`. _Note_: You can use `wrap` and `over2` from [`Data.Newtype`](https://pursuit.purescript.org/packages/purescript-newtype/docs/Data.Newtype) to create a more concise solution.
+
+4. (Easy) Derive (via `newtype`) a `Ring` instance for `Complex`. _Note_: You may instead write this instance manually, but that's not as convenient.
+
+Here's the `Shape` ADT from the previous chapter:
+
+```haskell
+data Shape
+  = Circle Point Number
+  | Rectangle Point Number Number
+  | Line Point Point
+  | Text Point String
+```
 
-     Define `Show` and `Eq` instances for `Complex`.
+5. (Medium) Derive (via `Generic`) a `Show` instance for `Shape`. How does the amount of code written and `String` output compare to `showShape` from the previous chapter? _Note_: You may instead write this instance manually, but you'll need to pay close attention to the output format expected by the tests.
 
 ## Type Class Constraints
 
@@ -454,35 +485,45 @@ When the program is compiled, the correct type class instance for `Show` is chos
 
 
 ## Exercises
- 1. (Easy) The following declaration defines a type of non-empty arrays of elements of type `a`:
+
+1. (Easy) The following declaration defines a type of non-empty arrays of elements of type `a`:
+
+   ```haskell
+   data NonEmpty a = NonEmpty a (Array a)
+   ```
+
+   Write an `Eq` instance for the type `NonEmpty a` which reuses the instances for `Eq a` and `Eq (Array a)`. _Note:_ you may instead derive the `Eq` instance.
+
+1. (Medium) Write a `Semigroup` instance for `NonEmpty a` by reusing the `Semigroup` instance for `Array`.
+
+1. (Medium) Write a `Functor` instance for `NonEmpty`.
+
+1. (Medium) Given any type `a` with an instance of `Ord`, we can add a new "infinite" value which is greater than any other value:
 
     ```haskell
-    data NonEmpty a = NonEmpty a (Array a)
+    data Extended a = Infinite | Finite a
     ```
 
-    Write an `Eq` instance for the type `NonEmpty a` which reuses the instances for `Eq a` and `Eq (Array a)`.
- 1. (Medium) Write a `Semigroup` instance for `NonEmpty a` by reusing the `Semigroup` instance for `Array`.
- 1. (Medium) Write a `Functor` instance for `NonEmpty`.
- 1. (Medium) Given any type `a` with an instance of `Ord`, we can add a new "infinite" value which is greater than any other value:
+   Write an `Ord` instance for `Extended a` which reuses the `Ord` instance for `a`.
 
-     ```haskell
-     data Extended a = Finite a | Infinite
-     ```
+1. (Difficult) Write a `Foldable` instance for `NonEmpty`. _Hint_: reuse the `Foldable` instance for arrays.
 
-    Write an `Ord` instance for `Extended a` which reuses the `Ord` instance for `a`.
- 1. (Difficult) Write a `Foldable` instance for `NonEmpty`. _Hint_: reuse the `Foldable` instance for arrays.
- 1. (Difficult) Given a type constructor `f` which defines an ordered container (and so has a `Foldable` instance), we can create a new container type which includes an extra element at the front:
+1. (Difficult) Given a type constructor `f` which defines an ordered container (and so has a `Foldable` instance), we can create a new container type which includes an extra element at the front:
 
-     ```haskell
-     data OneMore f a = OneMore a (f a)
-     ```
+    ```haskell
+    data OneMore f a = OneMore a (f a)
+    ```
 
-     The container `OneMore f` also has an ordering, where the new element comes before any element of `f`. Write a `Foldable` instance for `OneMore f`:
+    The container `OneMore f` also has an ordering, where the new element comes before any element of `f`. Write a `Foldable` instance for `OneMore f`:
 
-     ```haskell
-     instance foldableOneMore :: Foldable f => Foldable (OneMore f) where
-     ...
-     ```
+    ```haskell
+    instance foldableOneMore :: Foldable f => Foldable (OneMore f) where
+    ...
+    ```
+
+1. (Medium) Write a `dedupShapes :: Array Shape -> Array Shape` function which removes duplicate `Shape`s from an array using the `nubEq` function.
+
+1. (Medium) Write a `dedupShapesFast` function which is the same as `dudupShapes`, but uses the more efficient `nub` function.
 
 ## Multi Parameter Type Classes