@@ -0,0 +1,195 @@
1+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
4+-- Module: Database.PostgreSQL.Simple.Time.Parser
5+-- Copyright: (c) 2012-2015 Leon P Smith
6+-- (c) 2015 Bryan O'Sullivan
8+-- Maintainer: Leon P Smith <leon@melding-monads.com>
9+-- Stability: experimental
10+-- Portability: portable
12+-- Parsers for parsing dates and times.
14+module Database.PostgreSQL.Simple.Time.Parser
22+ , localToUTCTimeOfDayHMS
27+import Control.Applicative ((<$>), (<*>), (<*), (*>))
28+import Database.PostgreSQL.Simple.Compat (toPico)
29+import Data.Attoparsec.ByteString.Char8 as A
30+import Data.Bits ((.&.))
31+import Data.Char (ord)
32+import Data.Fixed (Pico)
33+import Data.Int (Int64)
34+import Data.Maybe (fromMaybe)
35+import Data.Time.Calendar (Day, fromGregorianValid, addDays)
36+import Data.Time.Clock (UTCTime(..))
37+import qualified Data.ByteString.Char8 as B8
38+import qualified Data.Time.LocalTime as Local
40+-- | Parse a date of the form @YYYY-MM-DD@.
43+ y <- decimal <* char '-'
44+ m <- twoDigits <* char '-'
46+ maybe (fail "invalid date") return (fromGregorianValid y m d)
48+-- | Parse a two-digit integer (e.g. day of month, hour).
49+twoDigits :: Parser Int
53+ let c2d c = ord c .&. 15
54+ return $! c2d a * 10 + c2d b
56+-- | Parse a time of the form @HH:MM:SS[.SSS]@.
57+timeOfDay :: Parser Local.TimeOfDay
59+ h <- twoDigits <* char ':'
60+ m <- twoDigits <* char ':'
62+ if h < 24 && m < 60 && s <= 60
63+ then return (Local.TimeOfDay h m s)
64+ else fail "invalid time"
66+data T = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int64
68+-- | Parse a count of seconds, with the integer part being two digits
70+seconds :: Parser Pico
76+ t <- anyChar *> takeWhile1 isDigit
77+ return $! parsePicos real t
78+ _ -> return $! fromIntegral real
80+ parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
81+ where T n t' = B8.foldl' step (T 12 (fromIntegral a0)) t
84+ | otherwise = T (m-1) (10 * a + fromIntegral (ord c) .&. 15)
86+-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
87+-- zero. (This makes some speedups possible.)
88+timeZone :: Parser (Maybe Local.TimeZone)
90+ ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
97+ Just ':' -> anyChar *> twoDigits
99+ let off | ch == '-' = negate off0
105+ | h > 23 || m > 59 ->
106+ fail "invalid time zone offset"
108+ let !tz = Local.minutesToTimeZone off
111+data UTCOffsetHMS = UTCOffsetHMS {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int
113+-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
114+-- zero. (This makes some speedups possible.)
115+timeZoneHMS :: Parser (Maybe UTCOffsetHMS)
117+ ch <- satisfy $ \c -> c == 'Z' || c == '+' || c == '-'
125+ _ | h == 0 && m == 0 && s == 0 ->
127+ | h > 23 || m >= 60 || s >= 60 ->
128+ fail "invalid time zone offset"
131+ then let !tz = UTCOffsetHMS h m s
133+ else let !tz = UTCOffsetHMS (-h) (-m) (-s)
139+ Just ':' -> anyChar *> twoDigits
142+localToUTCTimeOfDayHMS :: UTCOffsetHMS -> Local.TimeOfDay -> (Integer, Local.TimeOfDay)
143+localToUTCTimeOfDayHMS (UTCOffsetHMS dh dm ds) (Local.TimeOfDay h m s) =
144+ (\ !a !b -> (a,b)) dday (Local.TimeOfDay h'' m'' s'')
146+ s' = s - fromIntegral ds
148+ | s' < 0 = (s' + 60, m - dm - 1)
149+ | s' >= 60 = (s' - 60, m - dm + 1)
150+ | otherwise = (s' , m - dm )
152+ | m' < 0 = (m' + 60, h - dh - 1)
153+ | m' >= 60 = (m' - 60, h - dh + 1)
154+ | otherwise = (m' , h - dh )
156+ | h' < 0 = (h' + 24, -1)
157+ | h' >= 24 = (h' - 24, 1)
158+ | otherwise = (h' , 0)
161+-- | Parse a date and time, of the form @YYYY-MM-DD HH:MM:SS@.
162+-- The space may be replaced with a @T@. The number of seconds may be
163+-- followed by a fractional component.
164+localTime :: Parser Local.LocalTime
165+localTime = Local.LocalTime <$> day <* daySep <*> timeOfDay
166+ where daySep = satisfy (\c -> c == 'T' || c == ' ')
168+-- | Behaves as 'zonedTime', but converts any time zone offset into a
170+utcTime :: Parser UTCTime
172+ (Local.LocalTime d t) <- localTime
175+ Nothing -> let !tt = Local.timeOfDayToTime t
176+ in return (UTCTime d tt)
177+ Just tz -> let !(dd,t') = localToUTCTimeOfDayHMS tz t
179+ !tt = Local.timeOfDayToTime t'
180+ in return (UTCTime d' tt)
182+-- | Parse a date with time zone info. Acceptable formats:
184+-- @YYYY-MM-DD HH:MM:SS Z@
186+-- The first space may instead be a @T@, and the second space is
187+-- optional. The @Z@ represents UTC. The @Z@ may be replaced with a
188+-- time zone offset of the form @+0000@ or @-08:00@, where the first
189+-- two digits are hours, the @:@ is optional and the second two digits
190+-- (also optional) are minutes.
191+zonedTime :: Parser Local.ZonedTime
192+zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
194+utc :: Local.TimeZone
195+utc = Local.TimeZone 0 False ""