git.iko.soy/typeable/postgresql-simple
on master help sign in
Wire in the new time parser
commitca2a920ca0908090ac6414b1c8090276e1810139 authorLeon P Smith <leon@melding-monads.com> dateMon 24 Aug 2015, 00:04 (11 years ago) parent2fe8746
2 files changed+13−67
postgresql-simple.cabal+1 src/Database/PostgreSQL/Simple/Time/Implementation.hs+12−67
postgresql-simple.cabal+1
@@ -49,6 +49,7 @@ Library
4949 Database.PostgreSQL.Simple.Compat
5050 Database.PostgreSQL.Simple.HStore.Implementation
5151 Database.PostgreSQL.Simple.Time.Implementation
52+ Database.PostgreSQL.Simple.Time.Parser
5253 Database.PostgreSQL.Simple.TypeInfo.Types
5354
5455 Build-depends:
src/Database/PostgreSQL/Simple/Time/Implementation.hs+12−67
@@ -23,11 +23,13 @@ import Data.ByteString.Internal (c2w, w2c)
2323import Data.Time hiding (getTimeZone, getZonedTime)
2424import Data.Typeable
2525import Data.Word(Word8)
26+import Data.Maybe (fromMaybe)
2627import qualified Data.Attoparsec.ByteString.Char8 as A
2728import Database.PostgreSQL.Simple.Compat ((<>))
2829import Data.Monoid(Monoid(..))
2930import Data.Fixed (Pico)
3031import Unsafe.Coerce
32+import qualified Database.PostgreSQL.Simple.Time.Parser as TP
3133
3234#if !MIN_VERSION_base(4,7,0)
3335-- A kludge to work around the fact that Data.Fixed isn't very fast and
@@ -107,79 +109,30 @@ getUnbounded getFinite
107109 <|> (Finite <$> getFinite)
108110
109111getDay :: A.Parser Day
110−getDay = do
111− yearStr <- A.takeWhile A.isDigit
112− when (B.length yearStr < 4) (fail "year must consist of at least 4 digits")
113−
114− let !year = toNum yearStr
115− _ <- A.char '-'
116− !month <- digits "month"
117− _ <- A.char '-'
118− day <- digits "day"
119−
120− case fromGregorianValid year month day of
121− Nothing -> fail "invalid date"
122− Just x -> return $! x
112+getDay = TP.day
123113
124114getDate :: A.Parser Date
125115getDate = getUnbounded getDay
126116
127117getTimeOfDay :: A.Parser TimeOfDay
128−getTimeOfDay = do
129− !hour <- digits "hours"
130− _ <- A.char ':'
131− minute <- digits "minutes"
132− sec <- (A.char ':' *> getSeconds) <|> pure 0
133−
134− case makeTimeOfDayValid hour minute sec of
135− Nothing -> fail "invalid time of day"
136− Just x -> return $! x
137− where
138− getSeconds :: A.Parser Pico
139− getSeconds = do
140− secs <- digits "seconds"
141− decimal secs <|> (return $! fromInteger secs)
142−
143− decimal :: Integer -> A.Parser Pico
144− decimal secs = do
145− _ <- A.satisfy (\c -> c == '.' || c == ',')
146− digits <- B.take 12 <$> A.takeWhile1 A.isDigit
147−
148− return $! mkPico (toNum_ secs digits * 10^(12 - B.length digits))
118+getTimeOfDay = TP.timeOfDay
149119
150120getLocalTime :: A.Parser LocalTime
151−getLocalTime = LocalTime <$> getDay <*> (todSeparator *> getTimeOfDay)
152− where todSeparator = A.satisfy (\c -> c == ' ' || c == 'T')
121+getLocalTime = TP.localTime
153122
154123getLocalTimestamp :: A.Parser LocalTimestamp
155124getLocalTimestamp = getUnbounded getLocalTime
156125
157126getTimeZone :: A.Parser TimeZone
158−getTimeZone = do
159− !sign <- A.satisfy (\c -> c == '+' || c == '-' || c == 'Z')
160− if sign == 'Z'
161− then return utc
162− else do
163− !hours <- digits "timezone"
164− !mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0
165− let !absset = 60 * hours + mins
166− !offset = if sign == '+' then absset else -absset
167− return $! minutesToTimeZone offset
127+getTimeZone = fromMaybe utc <$> TP.timeZone
168128
169129type TimeZoneHMS = (Int,Int,Int)
170130
171131getTimeZoneHMS :: A.Parser TimeZoneHMS
172−getTimeZoneHMS = do
173− !sign <- A.satisfy (\c -> c == '+' || c == '-' || c == 'Z')
174− if sign == 'Z'
175− then return (0,0,0)
176− else do
177− !hours <- digits "timezone"
178− !mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0
179− !secs <- (A.char ':' *> digits "timezone seconds") <|> pure 0
180− if sign == '+'
181− then return $! (hours, mins, secs)
182− else return $! (\ !h !m !s -> (h,m,s)) (-hours) (-mins) (-secs)
132+getTimeZoneHMS = munge <$> TP.timeZoneHMS
133+ where
134+ munge Nothing = (0,0,0)
135+ munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)
183136
184137localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)
185138localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =
@@ -200,21 +153,13 @@ localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =
200153 | otherwise = (h' , 0)
201154
202155getZonedTime :: A.Parser ZonedTime
203−getZonedTime = ZonedTime <$> getLocalTime <*> getTimeZone
156+getZonedTime = TP.zonedTime
204157
205158getZonedTimestamp :: A.Parser ZonedTimestamp
206159getZonedTimestamp = getUnbounded getZonedTime
207160
208161getUTCTime :: A.Parser UTCTime
209−getUTCTime = do
210− day <- getDay
211− _ <- A.char ' '
212− time <- getTimeOfDay
213− zone <- getTimeZoneHMS
214− let !(dayDelta,time') = localToUTCTimeOfDayHMS zone time
215− let !day' = addDays dayDelta day
216− let !time'' = timeOfDayToTime time'
217− return $! UTCTime day' time''
162+getUTCTime = TP.utcTime
218163
219164getUTCTimestamp :: A.Parser UTCTimestamp
220165getUTCTimestamp = getUnbounded getUTCTime