postgresql-binary 0.2.1 → 0.2.2

raw patch · 6 files changed

+118/−26 lines, 6 files

Files

• executables/Tests.hs +45/−10
• library/PostgreSQLBinary/Decoder.hs +3/−7
• library/PostgreSQLBinary/Encoder/Builder.hs +6/−7
• library/PostgreSQLBinary/Interval.hs +43/−0
• library/PostgreSQLBinary/Time.hs +19/−1
• postgresql-binary.cabal +2/−1

@@ -107,7 +107,8 @@   void $ PQ.exec c $ mconcat $ map (<> ";") $      [        "SET client_min_messages TO WARNING",-      "SET client_encoding = 'UTF8'"+      "SET client_encoding = 'UTF8'",+      "SET intervalstyle = 'postgres'"     ]  getIntegerDatetimes :: PQ.Connection -> IO Bool@@ -134,7 +135,8 @@  microsTimeOfDayGen :: Gen TimeOfDay microsTimeOfDayGen =-  timeToTimeOfDay <$> microsDiffTimeGen+  fmap timeToTimeOfDay $ fmap picosecondsToDiffTime $ fmap (* (10^6)) $ +    choose (0, (10^6)*24*60*60)  microsLocalTimeGen :: Gen LocalTime microsLocalTimeGen = @@ -144,9 +146,12 @@ microsUTCTimeGen =   localTimeToUTC <$> timeZoneGen <*> microsLocalTimeGen -microsDiffTimeGen :: Gen DiffTime-microsDiffTimeGen = do-  fmap picosecondsToDiffTime $ fmap (* (10^6)) $ choose (0, (10^6)*24*60*60)+intervalDiffTimeGen :: Gen DiffTime+intervalDiffTimeGen = do+  unsafeCoerce ((* (10^6)) <$> choose (uMin, uMax) :: Gen Integer)+  where+    uMin = unsafeCoerce minInterval `div` 10^6+    uMax = unsafeCoerce maxInterval `div` 10^6  timeZoneGen :: Gen TimeZone timeZoneGen =@@ -184,7 +189,16 @@       where         dimensionWidth (x, _) = fromIntegral x +-- * Constants+------------------------- +maxInterval :: DiffTime = +  unsafeCoerce $ +    (truncate (1780000 * 365.2425 * 24 * 60 * 60 * 10 ^ 12 :: Rational) :: Integer)++minInterval :: DiffTime = +  negate maxInterval+ -- * Tests ------------------------- @@ -209,15 +223,36 @@       query "SELECT '550e8400-e29b-41d4-a716-446655440000' :: uuid" [] PQ.Binary  prop_interval =-  forAll microsDiffTimeGen $ +  forAll intervalDiffTimeGen $      mappingP (PTI.oidOf PTI.interval)               (nonNullRenderer Encoder.interval)              (nonNullParser Decoder.interval) -test_intervalParsing =-  assertEqual (Right (secondsToDiffTime (44 + 60 * (10 + 60 * 24 * (20 + 31 * 2))))) =<< do-    fmap (Decoder.interval . fromJust) $ -      query "SELECT 'P0000-02-20T00:10:44' :: interval" [] PQ.Binary+test_maxInterval =+  let x = maxInterval+    in +      assertEqual (Just (Right x)) =<< do+        let +          p = +            (,,)+              (PQ.Oid (fromIntegral (PTI.oidOf PTI.interval)))+              (Encoder.interval x)+              (PQ.Binary)+        (fmap . fmap) Decoder.interval $ +          query "SELECT $1" [Just p] PQ.Binary++test_minInterval =+  let x = minInterval+    in +      assertEqual (Just (Right x)) =<< do+        let +          p = +            (,,)+              (PQ.Oid (fromIntegral (PTI.oidOf PTI.interval)))+              (Encoder.interval x)+              (PQ.Binary)+        (fmap . fmap) Decoder.interval $ +          query "SELECT $1" [Just p] PQ.Binary  prop_timestamp =   forAll microsUTCTimeGen $ 

@@ -16,6 +16,7 @@ import qualified PostgreSQLBinary.Time as Time import qualified PostgreSQLBinary.Integral as Integral import qualified PostgreSQLBinary.Numeric as Numeric+import qualified PostgreSQLBinary.Interval as Interval   -- |@@ -155,13 +156,8 @@     ub <- state $ B.splitAt 8     db <- state $ B.splitAt 4     mb <- get-    lift $ do-      u <- int ub-      d <- int db-      m <- int mb-      return $ picosecondsToDiffTime $-        10 ^ 6 * fromIntegral (u + 10 ^ 6 * 60 * 60 * 24 * (d + 31 * m) :: Int64)-+    i <- lift $ Interval.Interval <$> int ub <*> int db <*> int mb+    return $ Interval.toDiffTime i   -- * Misc

@@ -15,6 +15,7 @@ import qualified PostgreSQLBinary.Array as Array import qualified PostgreSQLBinary.Time as Time import qualified PostgreSQLBinary.Numeric as Numeric+import qualified PostgreSQLBinary.Interval as Interval   {-# INLINE run #-}@@ -70,13 +71,11 @@  {-# INLINE interval #-} interval :: DiffTime -> Builder-interval x =-  flip evalState (unsafeCoerce x :: Integer) $ do-    u <- state (`divMod` (10 ^ 6))-    d <- state (`divMod` (10 ^ 6 * 60 * 60 * 24))-    m <- get-    return $-      int64BE (fromIntegral u) <> int32BE (fromIntegral d) <> int32BE (fromIntegral m)+interval =+  Interval.fromDiffTime >>> +  fromMaybe (error "Too large DiffTime value for an interval") >>>+  \(Interval.Interval u d m) -> int64BE u <> int32BE d <> int32BE m+  {-# INLINE numeric #-} numeric :: Scientific -> Builder

@@ -0,0 +1,43 @@+module PostgreSQLBinary.Interval where++import PostgreSQLBinary.Prelude+import qualified PostgreSQLBinary.Time as Time+++data Interval = +  Interval {+    micros :: Int64,+    days :: Int32,+    months :: Int32+  } +  deriving (Show, Eq)+++-- |+-- Oddly enough despite a claim of support of up to 178000000 years in+-- <http://www.postgresql.org/docs/9.3/static/datatype-datetime.html Postgres' docs>+-- in practice it starts behaving unpredictable after a smaller limit.+maxDiffTime :: DiffTime = 1780000 * Time.microsToDiffTime Time.year+minDiffTime :: DiffTime = negate maxDiffTime++fromDiffTime :: DiffTime -> Maybe Interval+fromDiffTime x =+  if x > maxDiffTime || x < minDiffTime+    then Nothing+    else Just $ fromPicosUnsafe (unsafeCoerce x)++fromPicosUnsafe :: Integer -> Interval+fromPicosUnsafe =+  evalState $ do+    modify $ flip div (10^6)+    u <- state $ swap . flip divMod (10 ^ 6 * 60 * 60 * 24)+    d <- state $ swap . flip divMod (31)+    m <- get+    return $ Interval (fromIntegral u) (fromIntegral d) (fromIntegral m)++toDiffTime :: Interval -> DiffTime+toDiffTime x =+  picosecondsToDiffTime $ +    (10 ^ 6) *+      (fromIntegral (micros x) + +       10 ^ 6 * 60 * 60 * 24 * (fromIntegral (days x + 31 * months x)))

@@ -1,6 +1,6 @@ module PostgreSQLBinary.Time where -import PostgreSQLBinary.Prelude+import PostgreSQLBinary.Prelude hiding (second) import Data.Time.Calendar.Julian  @@ -58,3 +58,21 @@     let p = truncate $ toRational s * 10 ^ 12 :: Integer     return $       TimeOfDay h m (unsafeCoerce p)+++-- * Constants in microseconds according to Julian dates standard+-------------------------+-- According to+-- http://www.postgresql.org/docs/9.1/static/datatype-datetime.html+-- Postgres uses Julian dates internally+-------------------------++year   :: Int64 = truncate (365.2425 * fromIntegral day :: Rational)+day    :: Int64 = 24 * hour+hour   :: Int64 = 60 * minute+minute :: Int64 = 60 * second+second :: Int64 = 10 ^ 6 ++microsToDiffTime :: Int64 -> DiffTime+microsToDiffTime =+  unsafeCoerce . (* (10^6)) . fromIntegral

@@ -1,7 +1,7 @@ name:   postgresql-binary version:-  0.2.1+  0.2.2 synopsis:   Encoders and decoders for the PostgreSQL's binary format description:@@ -56,6 +56,7 @@     PostgreSQLBinary.Integral     PostgreSQLBinary.Numeric     PostgreSQLBinary.Time+    PostgreSQLBinary.Interval   exposed-modules:     PostgreSQLBinary.Array     PostgreSQLBinary.Encoder