From 5d5a4d507612e3e1ade1b926c1c9ed7d9feafdc3 Mon Sep 17 00:00:00 2001
From: Markus Bertheau <mbertheau@gmail.com>
Date: Thu, 21 May 2015 23:21:36 +0200
Subject: [PATCH] Add meetup exercise

---
 config.json            |  3 ++-
 meetup/example.rkt     | 47 ++++++++++++++++++++++++++++++++++++++++++
 meetup/meetup-test.rkt | 23 +++++++++++++++++++++
 3 files changed, 72 insertions(+), 1 deletion(-)
 create mode 100644 meetup/example.rkt
 create mode 100644 meetup/meetup-test.rkt

diff --git a/config.json b/config.json
index 6dc26b3..cccb0b1 100644
--- a/config.json
+++ b/config.json
@@ -4,6 +4,7 @@
   "repository": "https://github.com/exercism/xracket",
   "active": false,
   "problems": [
-    "bob"
+    "bob",
+    "meetup"
   ]
 }
diff --git a/meetup/example.rkt b/meetup/example.rkt
new file mode 100644
index 0000000..218f38a
--- /dev/null
+++ b/meetup/example.rkt
@@ -0,0 +1,47 @@
+#lang racket
+
+(require math/number-theory
+         racket/date)
+
+(define (leap-year? year)
+  (or (and (divides? 4 year)
+           (not (divides? 100 year)))
+      (divides? 400 year)))
+
+(define (days-in-month year month)
+  (case month
+    [(1 3 5 7 8 10 12) 31]
+    [(4 6 9 11) 30]
+    [(2) (if (leap-year? year) 29 28)]))
+
+(define (make-date year month day)
+  (seconds->date (find-seconds 0 0 0 day month year #f)))
+
+(define (meetup-day year month weekday week)
+  (let ([first-of-week
+          (case week
+            [(1st) 1]
+            [(2nd) 8]
+            [(teenth) 13]
+            [(3rd) 15]
+            [(4th) 22]
+            [(last) (- (days-in-month year month) 6)]
+            [else (raise-argument-error 'meetup-day "week" 3 year month weekday week)])]
+        [weekday
+          (case weekday
+            [(Sunday) 0]
+            [(Monday) 1]
+            [(Tuesday) 2]
+            [(Wednesday) 3]
+            [(Thursday) 4]
+            [(Friday) 5]
+            [(Saturday) 6]
+            [else (raise-argument-error 'meetup-day "weekday" 3 year month weekday week)])])
+    (make-date year month
+               (+ first-of-week
+                    (modulo
+                      (- weekday
+                       (date-week-day (make-date year month first-of-week))) 7)
+                 ))))
+
+(provide meetup-day)
diff --git a/meetup/meetup-test.rkt b/meetup/meetup-test.rkt
new file mode 100644
index 0000000..947f864
--- /dev/null
+++ b/meetup/meetup-test.rkt
@@ -0,0 +1,23 @@
+#lang racket
+
+(require rackunit
+         rackunit/text-ui
+         racket/date
+         "meetup.rkt")
+
+(define (make-date year month day)
+  (seconds->date (find-seconds 0 0 0 day month year #f)))
+
+(define tests
+  (test-suite
+    "Tests for the meetup exercise"
+    (check-equal? (meetup-day 2013 5 'Monday 'teenth) (make-date 2013 5 13))
+    (check-equal? (meetup-day 2013 2 'Saturday 'teenth) (make-date 2013 2 16))
+    (check-equal? (meetup-day 2013 5 'Tuesday '1st) (make-date 2013 5 7))
+    (check-equal? (meetup-day 2013 4 'Monday '2nd) (make-date 2013 4 8))
+    (check-equal? (meetup-day 2013 9 'Thursday '3rd) (make-date 2013 9 19))
+    (check-equal? (meetup-day 2013 3 'Sunday '4th) (make-date 2013 3 24))
+    (check-equal? (meetup-day 2013 10 'Thursday 'last) (make-date 2013 10 31))
+    (check-equal? (meetup-day 2012 2 'Wednesday 'last) (make-date 2012 2 29))))
+
+(exit (if (zero? (run-tests tests)) 0 1))