haskell: Phase 13 conformance — shapes.hs (5/5), Phase 13 complete
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
40
lib/haskell/tests/program-shapes.sx
Normal file
40
lib/haskell/tests/program-shapes.sx
Normal file
@@ -0,0 +1,40 @@
|
||||
;; 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}
|
||||
Reference in New Issue
Block a user