From f6d333ef67fa2c9c199d4c401322fc31d90867da Mon Sep 17 00:00:00 2001
From: bd <bdunahu@operationnull.com>
Date: Sat, 18 May 2024 19:12:47 -0600
Subject: Adapt palindrome into a ttd approach

---
 palindrome/palindrome-test.scm | 33 +++++++++++++++++++++++++++++++++
 palindrome/palindrome.scm      | 21 +++++++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 palindrome/palindrome-test.scm
 create mode 100755 palindrome/palindrome.scm

(limited to 'palindrome')

diff --git a/palindrome/palindrome-test.scm b/palindrome/palindrome-test.scm
new file mode 100644
index 0000000..4109154
--- /dev/null
+++ b/palindrome/palindrome-test.scm
@@ -0,0 +1,33 @@
+(use-modules (srfi srfi-64)
+             (palindrome))
+
+(test-begin "harness")
+
+
+(test-equal "test-not-palindrome"
+  #f
+  (palindrome? "palindrome"))
+
+(test-equal "test-is-palindrome"
+  #t
+  (palindrome? "racecar"))
+
+(test-equal "test-not-palindrome-bad-casing"
+  #f
+  (palindrome? "paLINDROMe"))
+
+(test-equal "test-palindrome-bad-casing"
+  #t
+  (palindrome? "raCECAr"))
+
+(test-equal "test-pp-not-palindrome"
+  "String paLINDROMe is not a palindrome!\n"
+  (pp "paLINDROMe"))
+
+
+(test-equal "test-pp-palindrome"
+  "String raCECAr is a palindrome!\n"
+  (pp "raCECAr"))
+
+
+(test-end "harness")
diff --git a/palindrome/palindrome.scm b/palindrome/palindrome.scm
new file mode 100755
index 0000000..276e628
--- /dev/null
+++ b/palindrome/palindrome.scm
@@ -0,0 +1,21 @@
+(define-module (palindrome))
+
+
+(define-public (pp str)
+  "Pretty-printer wrapper for
+palindrome?"
+  (format #f "String ~a is ~aa palindrome!\n"
+          str
+          (if (palindrome? str)
+              "" "not ")))
+
+(define-public (palindrome? str)
+  "Returns #t if STR is a palindrome, false
+otherwise. Ignores casing and non-alphabetic
+characters."
+  (let ((clean (cleanup str)))
+    (equal? clean (string-reverse clean))))
+
+(define (cleanup str)
+  (string-downcase (string-filter
+                    char-set:letter str)))
-- 
cgit v1.2.3