@@ -13,23 +13,18 @@
1313module Database.PostgreSQL.Simple.Time.Implementation where
1414
1515import Prelude hiding (take)
16−import Data.ByteString.Builder(Builder, byteString, char8, integerDec)
16+import Data.ByteString.Builder(Builder, byteString)
17+import Data.ByteString.Builder.Prim(primBounded)
1718import Control.Arrow((***))
1819import Control.Applicative
19−import Data.Bits((.&.))
2020import qualified Data.ByteString as B
21−import Data.ByteString.Internal (c2w, w2c)
2221import Data.Time hiding (getTimeZone, getZonedTime)
2322import Data.Typeable
24−import Data.Word(Word8)
2523import Data.Maybe (fromMaybe)
2624import qualified Data.Attoparsec.ByteString.Char8 as A
2725import Database.PostgreSQL.Simple.Compat ((<>))
28−import Data.Monoid(Monoid(..))
29−import Data.Fixed (Pico)
30−import Unsafe.Coerce
31−import qualified Database.PostgreSQL.Simple.Time.Internal.Parser as TP
32−import Database.PostgreSQL.Simple.Compat (fromPico)
26+import qualified Database.PostgreSQL.Simple.Time.Internal.Parser as TP
27+import qualified Database.PostgreSQL.Simple.Time.Internal.Printer as TPP
3328
3429data Unbounded a
3530 = NegInfinity
@@ -115,7 +110,7 @@ getTimeZoneHMS = munge <$> TP.timeZoneHMS
115110 munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)
116111
117112localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)
118−localToUTCTimeOfDayHMS (dh, dm, ds) tod =
113+localToUTCTimeOfDayHMS (dh, dm, ds) tod =
119114 TP.localToUTCTimeOfDayHMS (TP.UTCOffsetHMS dh dm ds) tod
120115
121116getZonedTime :: A.Parser ZonedTime
@@ -130,57 +125,23 @@ getUTCTime = TP.utcTime
130125getUTCTimestamp :: A.Parser UTCTimestamp
131126getUTCTimestamp = getUnbounded getUTCTime
132127
133−{--
134−toNum :: Num n => B.ByteString -> n
135−toNum = toNum_ 0
136−{-# INLINE toNum #-}
137−
138−toNum_ :: Num n => n -> B.ByteString -> n
139−toNum_ = B.foldl' (\a c -> 10*a + digit c)
140−
141−digit :: Num n => Word8 -> n
142−digit c = fromIntegral (c .&. 0x0f)
143−{-# INLINE digit #-}
144−
145−digits :: Num n => String -> A.Parser n
146−digits msg = do
147− x <- A.anyChar
148− y <- A.anyChar
149− if A.isDigit x && A.isDigit y
150− then return $! (10 * digit (c2w x) + digit (c2w y))
151− else fail (msg <> " is not 2 digits")
152−{-# INLINE digits #-}
153−--}
154−
155128dayToBuilder :: Day -> Builder
156−dayToBuilder (toGregorian -> (y,m,d)) = do
157− pad4 y <> char8 '-' <> pad2 m <> char8 '-' <> pad2 d
129+dayToBuilder = primBounded TPP.day
158130
159131timeOfDayToBuilder :: TimeOfDay -> Builder
160−timeOfDayToBuilder (TimeOfDay h m s) = do
161− pad2 h <> char8 ':' <> pad2 m <> char8 ':' <> showSeconds s
132+timeOfDayToBuilder = primBounded TPP.timeOfDay
162133
163134timeZoneToBuilder :: TimeZone -> Builder
164−timeZoneToBuilder tz
165− | m == 0 = sign h <> pad2 (abs h)
166− | otherwise = sign h <> pad2 (abs h) <> char8 ':' <> pad2 (abs m)
167− where
168− (h,m) = timeZoneMinutes tz `quotRem` 60
169− sign h | h >= 0 = char8 '+'
170− | otherwise = char8 '-'
135+timeZoneToBuilder = primBounded TPP.timeZone
171136
172137utcTimeToBuilder :: UTCTime -> Builder
173−utcTimeToBuilder (UTCTime day time) =
174− dayToBuilder day <> char8 ' '
175− <> timeOfDayToBuilder (timeToTimeOfDay time) <> byteString "+00"
138+utcTimeToBuilder = primBounded TPP.utcTime
176139
177140zonedTimeToBuilder :: ZonedTime -> Builder
178−zonedTimeToBuilder (ZonedTime localTime tz) =
179− localTimeToBuilder localTime <> timeZoneToBuilder tz
141+zonedTimeToBuilder = primBounded TPP.zonedTime
180142
181143localTimeToBuilder :: LocalTime -> Builder
182−localTimeToBuilder (LocalTime day tod) =
183− dayToBuilder day <> char8 ' ' <> timeOfDayToBuilder tod
144+localTimeToBuilder = primBounded TPP.localTime
184145
185146unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)
186147unboundedToBuilder finiteToBuilder unbounded
@@ -202,62 +163,4 @@ dateToBuilder :: Date -> Builder
202163dateToBuilder = unboundedToBuilder dayToBuilder
203164
204165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
205−nominalDiffTimeToBuilder xyz
206− | yz < 500000 = sign <> integerDec x
207− | otherwise = sign <> integerDec x <> char8 '.' <> showD6 y
208− where
209− sign = if xyz >= 0 then mempty else char8 '-'
210− -- A kludge to work around the fact that Data.Fixed isn't very fast and
211− -- NominalDiffTime doesn't give the MkNominalDiffTime constructor.
212− (x,yz) = ((unsafeCoerce (abs xyz) :: Integer) + 500000) `quotRem` 1000000000000
213− (fromIntegral -> y, _z) = yz `quotRem` 1000000
214−
215−showSeconds :: Pico -> Builder
216−showSeconds xyz
217− | yz == 0 = pad2 x
218− | z == 0 = pad2 x <> char8 '.' <> showD6 y
219− | otherwise = pad2 x <> char8 '.' <> pad6 y <> showD6 z
220− where
221− (x_,yz) = fromPico xyz `quotRem` 1000000000000
222− x = fromIntegral x_ :: Int
223− (fromIntegral -> y, fromIntegral -> z) = yz `quotRem` 1000000
224−
225−pad6 :: Int -> Builder
226−pad6 xy = let (x,y) = xy `quotRem` 1000
227− in pad3 x <> pad3 y
228−
229−showD6 :: Int -> Builder
230−showD6 xy = case xy `quotRem` 1000 of
231− (x,0) -> showD3 x
232− (x,y) -> pad3 x <> showD3 y
233−
234−pad3 :: Int -> Builder
235−pad3 abc = let (ab,c) = abc `quotRem` 10
236− (a,b) = ab `quotRem` 10
237− in p a <> p b <> p c
238−
239−showD3 :: Int -> Builder
240−showD3 abc = case abc `quotRem` 100 of
241− (a, 0) -> p a
242− (a,bc) -> case bc `quotRem` 10 of
243− (b,0) -> p a <> p b
244− (b,c) -> p a <> p b <> p c
245−
246−-- | p assumes its input is in the range [0..9]
247−p :: Integral n => n -> Builder
248−p n = char8 (w2c (fromIntegral (n + 48)))
249−{-# INLINE p #-}
250−
251−-- | pad2 assumes its input is in the range [0..99]
252−pad2 :: Integral n => n -> Builder
253−pad2 n = let (a,b) = n `quotRem` 10 in p a <> p b
254−{-# INLINE pad2 #-}
255−
256−-- | pad4 assumes its input is positive
257−pad4 :: Integer -> Builder
258−pad4 abcd | abcd >= 10000 = integerDec abcd
259− | otherwise = p a <> p b <> p c <> p d
260− where (ab,cd) = abcd `quotRem` 100
261− (a,b) = ab `quotRem` 10
262− (c,d) = cd `quotRem` 10
263−{-# INLINE pad4 #-}
166+nominalDiffTimeToBuilder = TPP.nominalDiffTime