From 6842ef68642a6aab2f9c989ea2b3606e289e962b Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 15 Sep 2009 22:34:34 +0300
Subject: [PATCH] Added parameter instance for day

---
 Web/Restful/Request.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/Web/Restful/Request.hs b/Web/Restful/Request.hs
index 9f98849b..4596458b 100644
--- a/Web/Restful/Request.hs
+++ b/Web/Restful/Request.hs
@@ -53,6 +53,8 @@ import Web.Restful.Constants
 import Web.Restful.Utils
 import Control.Applicative (Applicative (..))
 import Web.Encodings
+import Data.Time.Calendar (Day, fromGregorian)
+import Data.Char (isDigit)
 
 -- $param_overview
 -- In Restful, all of the underlying parameter values are strings. They can
@@ -257,6 +259,24 @@ instance Parameter Int where
                     ((x, _):_) -> Right x
                     _ -> Left $ "Invalid integer: " ++ s
 
+instance Parameter Day where
+    readParam s =
+        let t1 = length s == 10
+            t2 = s !! 4 == '-'
+            t3 = s !! 7 == '-'
+            t4 = all isDigit $ concat
+                    [ take 4 s
+                    , take 2 $ drop 5 s
+                    , take 2 $ drop 8 s
+                    ]
+            t = and [t1, t2, t3, t4]
+            y = read $ take 4 s
+            m = read $ take 2 $ drop 5 s
+            d = read $ take 2 $ drop 8 s
+         in if t
+                then Right $ fromGregorian y m d
+                else Left $ "Invalid date: " ++ s
+
 -- | The input for a resource.
 --
 -- Each resource can define its own instance of 'Request' and then more