@@ -0,0 +1,56 @@
1+module Data.Aeson.Parser.Time
2+ (
3+ day
4+ , timeOfDay
5+ , timeZone
6+ , utcTime
7+ ) where
8+
9+import Control.Applicative ((<$>))
10+import Control.Monad (when, void)
11+import Data.Attoparsec.Text as A
12+import Data.Time.Calendar (Day, fromGregorianValid)
13+import Data.Time.Clock (UTCTime)
14+import qualified Data.Time.LocalTime as Local
15+import qualified Data.Text as T
16+import qualified Data.Text.Read as T
17+
18+day :: A.Parser Day
19+day = do
20+ y <- decimal <* char '-'
21+ m <- decimal <* char '-'
22+ d <- decimal
23+ maybe (fail "invalid date") return (fromGregorianValid y m d)
24+
25+timeOfDay :: A.Parser Local.TimeOfDay
26+timeOfDay = do
27+ h <- decimal <* char ':'
28+ m <- decimal <* char ':'
29+ s <- (fromRational . toRational) <$> double
30+ maybe (fail "invalid time") return (Local.makeTimeOfDayValid h m s)
31+
32+timeZone :: A.Parser Local.TimeZone
33+timeZone = do
34+ skipSpace
35+ ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
36+ if ch == 'Z'
37+ then return Local.utc
38+ else do
39+ let dec f s = case f T.decimal s of
40+ Right (n, r) | T.null r -> return n
41+ _ -> fail "invalid time zone"
42+ h <- dec T.signed =<< T.cons ch <$> A.take 2
43+ c <- peekChar'
44+ when (c == ':') $ void anyChar
45+ m <- dec id =<< A.take 2
46+ let off = h * 60 + m
47+ if off < -720 || off > 840 || m > 59
48+ then fail "invalid time zone offset"
49+ else return (Local.minutesToTimeZone off)
50+
51+utcTime :: A.Parser UTCTime
52+utcTime = do
53+ let daySep = satisfy (\c -> c == 'T' || c == ' ')
54+ lt <- Local.LocalTime <$> day <* daySep <*> timeOfDay
55+ tz <- timeZone
56+ return (Local.localTimeToUTC tz lt)