rose-ash/lib/haskell/tests/program-runlength-str.sx

;; runlength-str.hs — run-length encoding on a String.
;; Source: https://rosettacode.org/wiki/Run-length_encoding#Haskell (adapted).
;;
;; Exercises String pattern matching `(x:xs)`, `span` over a string view,
;; tuple construction `(Int, Char)`, character equality, and tuple-in-cons
;; patterns `((n, c) : rest)` — all enabled by Phase 7 string=[Char].

(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-rle-source
  "encodeRL []     = []\nencodeRL (x:xs) = let (same, rest) = span eqX xs\n                      eqX y         = y == x\n                  in (1 + length same, x) : encodeRL rest\n\nreplicateRL 0 _ = []\nreplicateRL n c = c : replicateRL (n - 1) c\n\ndecodeRL []                = []\ndecodeRL ((n, c) : rest)   = replicateRL n c ++ decodeRL rest\n")

(hk-test
  "rle.hs — encodeRL [] = []"
  (hk-as-list (hk-prog-val (str hk-rle-source "r = encodeRL \"\"\n") "r"))
  (list))

(hk-test
  "rle.hs — length (encodeRL \"aabbbcc\") = 3"
  (hk-prog-val (str hk-rle-source "r = length (encodeRL \"aabbbcc\")\n") "r")
  3)

(hk-test
  "rle.hs — map fst (encodeRL \"aabbbcc\") = [2,3,2]"
  (hk-as-list
    (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"aabbbcc\")\n") "r"))
  (list 2 3 2))

(hk-test
  "rle.hs — map snd (encodeRL \"aabbbcc\") = [97,98,99]"
  (hk-as-list
    (hk-prog-val (str hk-rle-source "r = map snd (encodeRL \"aabbbcc\")\n") "r"))
  (list 97 98 99))

(hk-test
  "rle.hs — counts of encodeRL \"aabbbccddddee\" = [2,3,2,4,2]"
  (hk-as-list
    (hk-prog-val
      (str hk-rle-source "r = map fst (encodeRL \"aabbbccddddee\")\n")
      "r"))
  (list 2 3 2 4 2))

(hk-test
  "rle.hs — chars of encodeRL \"aabbbccddddee\" = [97,98,99,100,101]"
  (hk-as-list
    (hk-prog-val
      (str hk-rle-source "r = map snd (encodeRL \"aabbbccddddee\")\n")
      "r"))
  (list 97 98 99 100 101))

(hk-test
  "rle.hs — singleton encodeRL \"x\""
  (hk-as-list
    (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"x\")\n") "r"))
  (list 1))

(hk-test
  "rle.hs — decodeRL round-trip preserves \"aabbbcc\""
  (hk-as-list
    (hk-prog-val (str hk-rle-source "r = decodeRL (encodeRL \"aabbbcc\")\n") "r"))
  (list 97 97 98 98 98 99 99))

(hk-test
  "rle.hs — replicateRL 4 65 = [65,65,65,65]"
  (hk-as-list (hk-prog-val (str hk-rle-source "r = replicateRL 4 65\n") "r"))
  (list 65 65 65 65))

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