rose-ash/lib/haskell/tests/program-caesar.sx

;; caesar.hs — Caesar cipher.
;; Source: https://rosettacode.org/wiki/Caesar_cipher#Haskell (adapted).
;;
;; Exercises chr, ord, isUpper, isLower, mod, string pattern matching
;; (x:xs) over a String (which is now a [Char] string view), and map
;; from the Phase 7 string=[Char] foundation.

(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-caesar-source
  "shift n c = if isUpper c\n              then chr (mod ((ord c) - 65 + n) 26 + 65)\n              else if isLower c\n                     then chr (mod ((ord c) - 97 + n) 26 + 97)\n                     else chr c\n\ncaesarRec n []     = []\ncaesarRec n (x:xs) = shift n x : caesarRec n xs\n\ncaesarMap n s = map (shift n) s\n")

(hk-test
  "caesar.hs — caesarRec 3 \"ABC\" = DEF"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 3 \"ABC\"\n") "r"))
  (list "D" "E" "F"))

(hk-test
  "caesar.hs — caesarRec 13 \"Hello\" = Uryyb"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 13 \"Hello\"\n") "r"))
  (list "U" "r" "y" "y" "b"))

(hk-test
  "caesar.hs — caesarRec 1 \"AZ\" wraps to BA"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 1 \"AZ\"\n") "r"))
  (list "B" "A"))

(hk-test
  "caesar.hs — caesarRec 0 \"World\" identity"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 0 \"World\"\n") "r"))
  (list "W" "o" "r" "l" "d"))

(hk-test
  "caesar.hs — caesarRec preserves punctuation"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 3 \"Hi!\"\n") "r"))
  (list "K" "l" "!"))

(hk-test
  "caesar.hs — caesarMap 3 \"abc\" via map"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarMap 3 \"abc\"\n") "r"))
  (list "d" "e" "f"))

(hk-test
  "caesar.hs — caesarMap 13 round-trips with caesarMap 13"
  (hk-as-list
    (hk-prog-val
      (str
        hk-caesar-source
        "r = caesarMap 13 (foldr (\\c acc -> c : acc) [] (caesarMap 13 \"Hello\"))\n")
      "r"))
  (list "H" "e" "l" "l" "o"))

(hk-test
  "caesar.hs — caesarRec 25 \"AB\" = ZA"
  (hk-as-list
    (hk-prog-val (str hk-caesar-source "r = caesarRec 25 \"AB\"\n") "r"))
  (list "Z" "A"))

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