;; shapes.hs — class Area with a default perimeter, two instances
;;             using where-local helpers.
;;
;; Exercises Phase 13: class default method (perimeter), instance
;; methods that use `where`-bindings.

(define
  hk-shapes-source
  "class Shape a where\n  area :: a -> Int\n  perimeter :: a -> Int\n  perimeter x = quadrilateral x\n    where quadrilateral y = 2 * (sideA y + sideB y)\n          sideA z = 1\n          sideB z = 1\n\ndata Square = Square Int\ndata Rect = Rect Int Int\n\ninstance Shape Square where\n  area (Square s) = s * s\n  perimeter (Square s) = 4 * s\n\ninstance Shape Rect where\n  area (Rect w h) = w * h\n  perimeter (Rect w h) = peri\n    where peri = 2 * (w + h)\n")

(hk-test
  "shapes.hs — area of Square 5 = 25"
  (hk-deep-force (hk-run (str hk-shapes-source "main = area (Square 5)\n")))
  25)

(hk-test
  "shapes.hs — perimeter of Square 5 = 20"
  (hk-deep-force
    (hk-run (str hk-shapes-source "main = perimeter (Square 5)\n")))
  20)

(hk-test
  "shapes.hs — area of Rect 3 4 = 12"
  (hk-deep-force (hk-run (str hk-shapes-source "main = area (Rect 3 4)\n")))
  12)

(hk-test
  "shapes.hs — perimeter of Rect 3 4 = 14 (via where-bound)"
  (hk-deep-force
    (hk-run (str hk-shapes-source "main = perimeter (Rect 3 4)\n")))
  14)

(hk-test
  "shapes.hs — Square sums area + perimeter"
  (hk-deep-force
    (hk-run
      (str hk-shapes-source "main = area (Square 4) + perimeter (Square 4)\n")))
  32)

{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}