;; fizzbuzz.hs — classic FizzBuzz with guards.

(define
  hk-prog-val
  (fn
    (src name)
    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))

(define
  hk-as-list
  (fn
    (xs)
    (cond
      ((and (list? xs) (= (first xs) "[]")) (list))
      ((and (list? xs) (= (first xs) ":"))
        (cons (nth xs 1) (hk-as-list (nth xs 2))))
      (:else xs))))

(define
  hk-fb-src
  "fizzbuzz n\n  | n `mod` 15 == 0 = \"FizzBuzz\"\n  | n `mod` 3  == 0 = \"Fizz\"\n  | n `mod` 5  == 0 = \"Buzz\"\n  | otherwise       = \"Other\"\n")

(hk-test
  "fizzbuzz 1 = Other"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 1\n") "r")
  "Other")

(hk-test
  "fizzbuzz 3 = Fizz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 3\n") "r")
  "Fizz")

(hk-test
  "fizzbuzz 5 = Buzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 5\n") "r")
  "Buzz")

(hk-test
  "fizzbuzz 15 = FizzBuzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 15\n") "r")
  "FizzBuzz")

(hk-test
  "fizzbuzz 30 = FizzBuzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 30\n") "r")
  "FizzBuzz")

(hk-test
  "fizzbuzz 6 = Fizz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 6\n") "r")
  "Fizz")

(hk-test
  "fizzbuzz 10 = Buzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 10\n") "r")
  "Buzz")

(hk-test
  "fizzbuzz 7 = Other"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 7\n") "r")
  "Other")

(hk-test
  "fizzbuzz 9 = Fizz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 9\n") "r")
  "Fizz")

(hk-test
  "fizzbuzz 25 = Buzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 25\n") "r")
  "Buzz")

(hk-test
  "map fizzbuzz [1..5] starts Other"
  (hk-as-list
    (hk-prog-val (str hk-fb-src "r = map fizzbuzz [1,2,3,4,5]\n") "r"))
  (list "Other" "Other" "Fizz" "Other" "Buzz"))

(hk-test
  "fizzbuzz 45 = FizzBuzz"
  (hk-prog-val (str hk-fb-src "r = fizzbuzz 45\n") "r")
  "FizzBuzz")

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