ca2a920 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Wire in the new time parser

ca2a920Leon P Smith11 years ago

postgresql-simple.cabal+1

compare with master

unifiedsplit

@@ -49,6 +49,7 @@ Library

49 Database.PostgreSQL.Simple.Compat

50 Database.PostgreSQL.Simple.HStore.Implementation

51 Database.PostgreSQL.Simple.Time.Implementation

52+ Database.PostgreSQL.Simple.Time.Parser

52 Database.PostgreSQL.Simple.TypeInfo.Types

53 Database.PostgreSQL.Simple.TypeInfo.Types

54 Build-depends:

55 Build-depends:

src/Database/PostgreSQL/Simple/Time/Implementation.hs+12−67

@@ -23,11 +23,13 @@ import Data.ByteString.Internal (c2w, w2c)

23import Data.Time hiding (getTimeZone, getZonedTime)

24import Data.Typeable

25import Data.Word(Word8)

26+import Data.Maybe (fromMaybe)

26import qualified Data.Attoparsec.ByteString.Char8 as A

27import qualified Data.Attoparsec.ByteString.Char8 as A

27import Database.PostgreSQL.Simple.Compat ((<>))

28import Database.PostgreSQL.Simple.Compat ((<>))

28import Data.Monoid(Monoid(..))

29import Data.Monoid(Monoid(..))

29import Data.Fixed (Pico)

30import Data.Fixed (Pico)

30import Unsafe.Coerce

31import Unsafe.Coerce

32+import qualified Database.PostgreSQL.Simple.Time.Parser as TP

32#if !MIN_VERSION_base(4,7,0)

34#if !MIN_VERSION_base(4,7,0)

33-- A kludge to work around the fact that Data.Fixed isn't very fast and

35-- A kludge to work around the fact that Data.Fixed isn't very fast and

@@ -107,79 +109,30 @@ getUnbounded getFinite

107 <|> (Finite <$> getFinite)

109 <|> (Finite <$> getFinite)

108

110

109getDay :: A.Parser Day

111getDay :: A.Parser Day

110−getDay = do

112+getDay = TP.day

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

123

113

124getDate :: A.Parser Date

114getDate :: A.Parser Date

125getDate = getUnbounded getDay

115getDate = getUnbounded getDay

126

116

127getTimeOfDay :: A.Parser TimeOfDay

117getTimeOfDay :: A.Parser TimeOfDay

128−getTimeOfDay = do

118+getTimeOfDay = TP.timeOfDay

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))

149

119

150getLocalTime :: A.Parser LocalTime

120getLocalTime :: A.Parser LocalTime

151−getLocalTime = LocalTime <$> getDay <*> (todSeparator *> getTimeOfDay)

121+getLocalTime = TP.localTime

152− where todSeparator = A.satisfy (\c -> c == ' ' || c == 'T')

153

122

154getLocalTimestamp :: A.Parser LocalTimestamp

123getLocalTimestamp :: A.Parser LocalTimestamp

155getLocalTimestamp = getUnbounded getLocalTime

124getLocalTimestamp = getUnbounded getLocalTime

156

125

157getTimeZone :: A.Parser TimeZone

126getTimeZone :: A.Parser TimeZone

158−getTimeZone = do

127+getTimeZone = fromMaybe utc <$> TP.timeZone

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

168

128

169type TimeZoneHMS = (Int,Int,Int)

129type TimeZoneHMS = (Int,Int,Int)

170

130

171getTimeZoneHMS :: A.Parser TimeZoneHMS

131getTimeZoneHMS :: A.Parser TimeZoneHMS

172−getTimeZoneHMS = do

132+getTimeZoneHMS = munge <$> TP.timeZoneHMS

173− !sign <- A.satisfy (\c -> c == '+' || c == '-' || c == 'Z')

133+ where

174− if sign == 'Z'

134+ munge Nothing = (0,0,0)

175− then return (0,0,0)

135+ munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)

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)

183

136

184localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)

137localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)

185localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =

138localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =

@@ -200,21 +153,13 @@ localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =

200 | otherwise = (h' , 0)

153 | otherwise = (h' , 0)

201

154

202getZonedTime :: A.Parser ZonedTime

155getZonedTime :: A.Parser ZonedTime

203−getZonedTime = ZonedTime <$> getLocalTime <*> getTimeZone

156+getZonedTime = TP.zonedTime

204

157

205getZonedTimestamp :: A.Parser ZonedTimestamp

158getZonedTimestamp :: A.Parser ZonedTimestamp

206getZonedTimestamp = getUnbounded getZonedTime

159getZonedTimestamp = getUnbounded getZonedTime

207

160

208getUTCTime :: A.Parser UTCTime

161getUTCTime :: A.Parser UTCTime

209−getUTCTime = do

162+getUTCTime = TP.utcTime

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''

218

163

219getUTCTimestamp :: A.Parser UTCTimestamp

164getUTCTimestamp :: A.Parser UTCTimestamp

220getUTCTimestamp = getUnbounded getUTCTime

165getUTCTimestamp = getUnbounded getUTCTime