38bfdb4 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

First (untested) draft of faster time builders

38bfdb4Leon P Smith14 years ago

src/Database/PostgreSQL/Simple/Time.hs+17−6

compare with master

unifiedsplit

@@ -14,19 +14,30 @@

15module Database.PostgreSQL.Simple.Time

16 ( Unbounded(..)

17+ , Date

17 , UTCTimestamp

18 , UTCTimestamp

18− , parseUTCTimestamp

19 , ZonedTimestamp

20− , parseZonedTimestamp

21 , LocalTimestamp

20 , LocalTimestamp

22− , parseLocalTimestamp

21+ , parseDay

23− , Date

24− , parseDate

25 , parseUTCTime

22 , parseUTCTime

26 , parseZonedTime

23 , parseZonedTime

27 , parseLocalTime

24 , parseLocalTime

28− , parseDay

29 , parseTimeOfDay

25 , parseTimeOfDay

26+ , parseDate

27+ , parseUTCTimestamp

28+ , parseZonedTimestamp

29+ , parseLocalTimestamp

30+ , dayToBuilder

31+ , utcTimeToBuilder

32+ , zonedTimeToBuilder

33+ , localTimeToBuilder

34+ , timeOfDayToBuilder

35+ , timeZoneToBuilder

36+ , dateToBuilder

37+ , utcTimestampToBuilder

38+ , zonedTimestampToBuilder

39+ , localTimestampToBuilder

40+ , unboundedToBuilder

30 ) where

41 ) where

32import Database.PostgreSQL.Simple.Time.Implementation

43import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+112−4

@@ -12,19 +12,27 @@

13module Database.PostgreSQL.Simple.Time.Implementation where

15−import Prelude hiding (take)

15+import Prelude hiding (take, (++))

16−--import Blaze.ByteString.Builder(fromByteString)

16+import Blaze.ByteString.Builder(Builder, fromByteString)

17−--import Blaze.ByteString.Builder.Char8(fromString, fromChar)

17+import Blaze.ByteString.Builder.Char8(fromChar)

18+import Blaze.Text.Int(integral)

18import Control.Arrow((***))

19import Control.Arrow((***))

19import Control.Applicative

20import Control.Applicative

20import Control.Monad(when)

21import Control.Monad(when)

21import Data.Bits((.&.))

22import Data.Bits((.&.))

22import qualified Data.ByteString as B

23import qualified Data.ByteString as B

23−import Data.ByteString.Internal (c2w)

24+import Data.ByteString.Internal (c2w, w2c)

24import Data.Time hiding (getTimeZone, getZonedTime)

25import Data.Time hiding (getTimeZone, getZonedTime)

25import Data.Typeable

26import Data.Typeable

26import Data.Word(Word8)

27import Data.Word(Word8)

27import qualified Data.Attoparsec.Char8 as A

28import qualified Data.Attoparsec.Char8 as A

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

30+import Data.Fixed (Pico)

31+import Unsafe.Coerce

32+

33+(++) :: Monoid a => a -> a -> a

34+(++) = mappend

35+infixr 5 ++

29data Unbounded a

37data Unbounded a

30 = NegInfinity

38 = NegInfinity

@@ -169,3 +177,103 @@ digits msg = do

169 then return $! (10 * digit (c2w x) + digit (c2w y))

177 then return $! (10 * digit (c2w x) + digit (c2w y))

170 else fail (msg ++ " is not 2 digits")

178 else fail (msg ++ " is not 2 digits")

171{-# INLINE digits #-}

179{-# INLINE digits #-}

180+

181+dayToBuilder :: Day -> Builder

182+dayToBuilder (toGregorian -> (y,m,d)) = do

183+ pad4 y ++ fromChar '-' ++ pad2 m ++ fromChar '-' ++ pad2 d

184+

185+timeOfDayToBuilder :: TimeOfDay -> Builder

186+timeOfDayToBuilder (TimeOfDay h m s) = do

187+ pad2 h ++ fromChar ':' ++ pad2 m ++ fromChar ':' ++ showSec s

188+ where

189+ showSec s = case toMicroseconds s of

190+ (s, 0) -> pad2 s

191+ (s,us) -> pad2 s ++ fromChar '.' ++ showMicroseconds us

192+

193+timeZoneToBuilder :: TimeZone -> Builder

194+timeZoneToBuilder tz

195+ | m == 0 = sign h ++ pad2 (abs h)

196+ | otherwise = sign h ++ pad2 (abs h) ++ fromChar ':' ++ pad2 (abs m)

197+ where

198+ (h,m) = timeZoneMinutes tz `quotRem` 60

199+ sign h | h >= 0 = fromChar '+'

200+ | otherwise = fromChar '-'

201+

202+utcTimeToBuilder :: UTCTime -> Builder

203+utcTimeToBuilder (UTCTime day time) =

204+ dayToBuilder day ++ fromChar ' '

205+ ++ timeOfDayToBuilder (timeToTimeOfDay time) ++ fromByteString "+00"

206+

207+zonedTimeToBuilder :: ZonedTime -> Builder

208+zonedTimeToBuilder (ZonedTime localTime tz) =

209+ localTimeToBuilder localTime ++ timeZoneToBuilder tz

210+

211+localTimeToBuilder :: LocalTime -> Builder

212+localTimeToBuilder (LocalTime day tod) =

213+ dayToBuilder day ++ fromChar ' ' ++ timeOfDayToBuilder tod

214+

215+unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)

216+unboundedToBuilder finiteToBuilder unbounded

217+ = case unbounded of

218+ NegInfinity -> fromByteString "-infinity"

219+ Finite a -> finiteToBuilder a

220+ PosInfinity -> fromByteString "infinity"

221+

222+utcTimestampToBuilder :: UTCTimestamp -> Builder

223+utcTimestampToBuilder = unboundedToBuilder utcTimeToBuilder

224+

225+zonedTimestampToBuilder :: ZonedTimestamp -> Builder

226+zonedTimestampToBuilder = unboundedToBuilder zonedTimeToBuilder

227+

228+localTimestampToBuilder :: LocalTimestamp -> Builder

229+localTimestampToBuilder = unboundedToBuilder localTimeToBuilder

230+

231+dateToBuilder :: Date -> Builder

232+dateToBuilder = unboundedToBuilder dayToBuilder

233+

234+toMicroseconds :: Pico -> (Int,Int)

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

236+-- give me access to the MkFixed constructor.

237+toMicroseconds p = let (x,y) = (unsafeCoerce p :: Integer)

238+ `quotRem` 1000000000000

239+ (y',r) = y `quotRem` 1000000

240+ y'' = case compare r 500000 of

241+ LT -> y'

242+ EQ | even y' -> y'

243+ _ -> y' + 1

244+ in ( fromIntegral x, fromIntegral y'' )

245+

246+-- Assumes the input is within the range [0..999999]

247+showMicroseconds :: Int -> Builder

248+showMicroseconds us =

249+ case us `quotRem` 1000 of

250+ (ms, 0) -> case ms `quotRem` 100 of

251+ (a, 0) -> p a

252+ (a,ms) -> case ms `quotRem` 10 of

253+ (b,0) -> p a ++ p b

254+ (b,c) -> p a ++ p b ++ p c

255+ (ms,us) -> case ms `quotRem` 100 of

256+ (a,ms) -> case ms `quotRem` 10 of

257+ (b ,c) -> case us `quotRem` 100 of

258+ (d, 0) -> p a ++ p b ++ p c ++ p d

259+ (d,us) -> case us `quotRem` 10 of

260+ (e , 0) -> p a ++ p b ++ p c ++ p d ++ p e

261+ (e , f) -> p a ++ p b ++ p c ++ p d ++ p e ++ p f

262+

263+-- | p assumes its input is in the range [0..9]

264+p :: Integral n => n -> Builder

265+p n = fromChar (w2c (fromIntegral (n + 48)))

266+{-# INLINE p #-}

267+

268+-- | pad2 assumes its input is in the range [0..99]

269+pad2 :: Integral n => n -> Builder

270+pad2 n = let (a,b) = n `quotRem` 10 in p a ++ p b

271+{-# INLINE pad2 #-}

272+

273+-- | pad4 assumes its input is positive

274+pad4 :: (Integral n, Show n) => n -> Builder

275+pad4 n | n >= 1000 = integral n

276+ | n >= 100 = fromChar '0' ++ integral n

277+ | n >= 10 = fromByteString "00" ++ integral n

278+ | otherwise = fromByteString "000" ++ integral n

279+{-# INLINE pad4 #-}

src/Database/PostgreSQL/Simple/ToField.hs+26−8

@@ -28,10 +28,7 @@ import Data.ByteString (ByteString)

28import Data.Int (Int8, Int16, Int32, Int64)

29import Data.List (intersperse)

30import Data.Monoid (mappend)

31−import Data.Time.Calendar (Day, showGregorian)

31+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime)

32−import Data.Time.Clock (UTCTime)

33−import Data.Time.Format (formatTime)

34−import Data.Time.LocalTime (TimeOfDay, ZonedTime)

35import Data.Typeable (Typeable)

32import Data.Typeable (Typeable)

36import Data.Word (Word, Word8, Word16, Word32, Word64)

33import Data.Word (Word, Word8, Word16, Word32, Word64)

37import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null)

34import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null)

@@ -43,6 +40,7 @@ import qualified Data.Text as ST

43import qualified Data.Text.Encoding as ST

40import qualified Data.Text.Encoding as ST

44import qualified Data.Text.Lazy as LT

41import qualified Data.Text.Lazy as LT

45import qualified Database.PostgreSQL.LibPQ as PQ

42import qualified Database.PostgreSQL.LibPQ as PQ

43+import Database.PostgreSQL.Simple.Time

47-- | How to render an element when substituting it into a query.

45-- | How to render an element when substituting it into a query.

48data Action =

46data Action =

@@ -188,19 +186,39 @@ instance ToField LT.Text where

188 {-# INLINE toField #-}

186 {-# INLINE toField #-}

189

187

190instance ToField UTCTime where

188instance ToField UTCTime where

191− toField = Plain . Utf8.fromString . formatTime defaultTimeLocale "'%F %T%Q+00'"

189+ toField = Plain . inQuotes . utcTimeToBuilder

192 {-# INLINE toField #-}

190 {-# INLINE toField #-}

193

191

194instance ToField ZonedTime where

192instance ToField ZonedTime where

195− toField = Plain . Utf8.fromString . formatTime defaultTimeLocale "'%F %T%Q%z'"

193+ toField = Plain . inQuotes . zonedTimeToBuilder

194+ {-# INLINE toField #-}

195+

196+instance ToField LocalTime where

197+ toField = Plain . inQuotes . localTimeToBuilder

196 {-# INLINE toField #-}

198 {-# INLINE toField #-}

197

199

198instance ToField Day where

200instance ToField Day where

199− toField = Plain . inQuotes . Utf8.fromString . showGregorian

201+ toField = Plain . inQuotes . dayToBuilder

200 {-# INLINE toField #-}

202 {-# INLINE toField #-}

201

203

202instance ToField TimeOfDay where

204instance ToField TimeOfDay where

203− toField = Plain . inQuotes . Utf8.fromString . show

205+ toField = Plain . inQuotes . timeOfDayToBuilder

206+ {-# INLINE toField #-}

207+

208+instance ToField UTCTimestamp where

209+ toField = Plain . inQuotes . utcTimestampToBuilder

210+ {-# INLINE toField #-}

211+

212+instance ToField ZonedTimestamp where

213+ toField = Plain . inQuotes . zonedTimestampToBuilder

214+ {-# INLINE toField #-}

215+

216+instance ToField LocalTimestamp where

217+ toField = Plain . inQuotes . localTimestampToBuilder

218+ {-# INLINE toField #-}

219+

220+instance ToField Date where

221+ toField = Plain . inQuotes . dateToBuilder

204 {-# INLINE toField #-}

222 {-# INLINE toField #-}

205

223

206-- | Surround a string with single-quote characters: \"@'@\"

224-- | Surround a string with single-quote characters: \"@'@\"