09a5bab · typeable/postgresql-simple

postgresql-simple.cabal+4−3

compare with master

unifiedsplit

@@ -82,7 +82,7 @@ library

82 , containers >=0.5.0.0 && <0.7

83 , template-haskell >=2.8.0.0 && <2.17

84 , text >=1.2.3.0 && <1.3

85− , time >=1.4.0.1 && <1.12

85+ , time-compat >=1.9.5 && <1.12

86 , transformers >=0.3.0.0 && <0.6

87

88 -- Other dependencies

@@ -93,7 +93,7 @@ library

93 , case-insensitive >=1.2.0.11 && <1.3

94 , hashable >=1.2.7.0 && <1.4

95 , Only >=0.1 && <0.1.1

96− , postgresql-libpq >=0.9.4.2 && <0.10

96+ , postgresql-libpq >=0.9.4.3 && <0.10

97 , scientific >=0.3.6.2 && <0.4

98 , uuid-types >=1.0.3 && <1.1

99 , vector >=0.12.0.1 && <0.13

@@ -150,6 +150,7 @@ test-suite test

150 Notify

151 Serializable

152 Time

153+ Interval

153

154

154 ghc-options: -threaded

155 ghc-options: -threaded

155 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

156 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

@@ -176,7 +177,7 @@ test-suite test

176 , tasty-golden

177 , tasty-golden

177 , tasty-hunit

178 , tasty-hunit

178 , text

179 , text

179− , time

180+ , time-compat

180 , vector

181 , vector

181

182

182 if !impl(ghc >=7.6)

183 if !impl(ghc >=7.6)

src/Database/PostgreSQL/Simple/FromField.hs+10−1

@@ -129,7 +129,7 @@ import Data.Functor.Identity (Identity(Identity))

129import Data.Int (Int16, Int32, Int64)

130import Data.IORef (IORef, newIORef)

131import Data.Ratio (Ratio)

132−import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )

132+import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )

133import Data.Typeable (Typeable, typeOf)

134import Data.Vector (Vector)

135import Data.Vector.Mutable (IOVector)

@@ -487,6 +487,15 @@ instance FromField LocalTimestamp where

487instance FromField Date where

488 fromField = ff TI.dateOid "Date" parseDate

489

490+-- | interval. Requires you to configure intervalstyle as @iso_8601@.

491+--

492+-- You can configure intervalstyle on every connection with a @SET@ command,

493+-- but for better performance you may want to configure it permanently in the

494+-- file found with @SHOW config_file;@ .

495+--

496+instance FromField CalendarDiffTime where

497+ fromField = ff TI.intervalOid "CalendarDiffTime" parseCalendarDiffTime

498+

490ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)

499ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)

491 -> Field -> Maybe B8.ByteString -> Conversion a

500 -> Field -> Maybe B8.ByteString -> Conversion a

492ff compatOid hsType parseBS f mstr =

501ff compatOid hsType parseBS f mstr =

src/Database/PostgreSQL/Simple/Range.hs+1−1

@@ -38,7 +38,7 @@ import Data.Monoid (mempty)

38import Data.Scientific (Scientific)

39import qualified Data.Text.Lazy.Builder as LT

40import qualified Data.Text.Lazy.Encoding as LT

41−import Data.Time (Day, LocalTime,

41+import Data.Time.Compat (Day, LocalTime,

42 NominalDiffTime,

43 TimeOfDay, UTCTime,

44 ZonedTime,

src/Database/PostgreSQL/Simple/Time.hs+2

@@ -227,6 +227,7 @@ module Database.PostgreSQL.Simple.Time

227 , parseUTCTimestamp

228 , parseZonedTimestamp

229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

230 , dayToBuilder

231 , dayToBuilder

231 , utcTimeToBuilder

232 , utcTimeToBuilder

232 , zonedTimeToBuilder

233 , zonedTimeToBuilder

@@ -239,6 +240,7 @@ module Database.PostgreSQL.Simple.Time

239 , localTimestampToBuilder

240 , localTimestampToBuilder

240 , unboundedToBuilder

241 , unboundedToBuilder

241 , nominalDiffTimeToBuilder

242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

242 ) where

244 ) where

243

245

244import Database.PostgreSQL.Simple.Time.Implementation

246import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1

@@ -18,7 +18,8 @@ import Data.ByteString.Builder.Prim(primBounded)

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

19import Control.Applicative

20import qualified Data.ByteString as B

21−import Data.Time hiding (getTimeZone, getZonedTime)

21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)

22+import Data.Time.LocalTime.Compat (CalendarDiffTime)

22import Data.Typeable

23import Data.Typeable

23import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

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

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

@@ -77,6 +78,9 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)

77parseDate :: B.ByteString -> Either String Date

78parseDate :: B.ByteString -> Either String Date

78parseDate = A.parseOnly (getDate <* A.endOfInput)

79parseDate = A.parseOnly (getDate <* A.endOfInput)

79

80

81+parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime

82+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)

83+

80getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

84getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

81getUnbounded getFinite

85getUnbounded getFinite

82 = (pure NegInfinity <* A.string "-infinity")

86 = (pure NegInfinity <* A.string "-infinity")

@@ -125,6 +129,9 @@ getUTCTime = TP.utcTime

125getUTCTimestamp :: A.Parser UTCTimestamp

129getUTCTimestamp :: A.Parser UTCTimestamp

126getUTCTimestamp = getUnbounded getUTCTime

130getUTCTimestamp = getUnbounded getUTCTime

127

131

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

133+getCalendarDiffTime = TP.calendarDiffTime

134+

128dayToBuilder :: Day -> Builder

135dayToBuilder :: Day -> Builder

129dayToBuilder = primBounded TPP.day

136dayToBuilder = primBounded TPP.day

130

137

@@ -164,3 +171,6 @@ dateToBuilder = unboundedToBuilder dayToBuilder

164

171

165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

166nominalDiffTimeToBuilder = TPP.nominalDiffTime

173nominalDiffTimeToBuilder = TPP.nominalDiffTime

174+

175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176+calendarDiffTimeToBuilder = TPP.calendarDiffTime

src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3

@@ -21,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser

21 , localToUTCTimeOfDayHMS

22 , utcTime

23 , zonedTime

24+ , calendarDiffTime

24 ) where

25 ) where

25

26

26import Control.Applicative ((<$>), (<*>), (<*), (*>))

27import Control.Applicative ((<$>), (<*>), (<*), (*>))

27import Database.PostgreSQL.Simple.Compat (toPico)

28import Database.PostgreSQL.Simple.Compat (toPico)

28import Data.Attoparsec.ByteString.Char8 as A

29import Data.Attoparsec.ByteString.Char8 as A

29import Data.Bits ((.&.))

30import Data.Bits ((.&.))

31+import Data.ByteString (ByteString)

30import Data.Char (ord)

32import Data.Char (ord)

31import Data.Fixed (Pico)

33import Data.Fixed (Pico)

32import Data.Int (Int64)

34import Data.Int (Int64)

33import Data.Maybe (fromMaybe)

35import Data.Maybe (fromMaybe)

34−import Data.Time.Calendar (Day, fromGregorianValid, addDays)

36+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)

35−import Data.Time.Clock (UTCTime(..))

37+import Data.Time.Clock.Compat (UTCTime(..))

38+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)

39+import Data.Time.LocalTime.Compat (CalendarDiffTime)

36import qualified Data.ByteString.Char8 as B8

40import qualified Data.ByteString.Char8 as B8

37−import qualified Data.Time.LocalTime as Local

41+import qualified Data.Time.LocalTime.Compat as Local

38

42

39-- | Parse a date of the form @YYYY-MM-DD@.

43-- | Parse a date of the form @YYYY-MM-DD@.

40day :: Parser Day

44day :: Parser Day

@@ -193,3 +197,8 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

193

197

194utc :: Local.TimeZone

198utc :: Local.TimeZone

195utc = Local.TimeZone 0 False ""

199utc = Local.TimeZone 0 False ""

200+

201+calendarDiffTime :: Parser CalendarDiffTime

202+calendarDiffTime = do

203+ contents <- takeByteString

204+ iso8601ParseM $ B8.unpack contents

src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2

@@ -17,19 +17,23 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer

17 , localTime

18 , zonedTime

19 , nominalDiffTime

20+ , calendarDiffTime

20 ) where

21 ) where

21

22

22import Control.Arrow ((>>>))

23import Control.Arrow ((>>>))

23−import Data.ByteString.Builder (Builder, integerDec)

24+import Data.ByteString.Builder (Builder, byteString, integerDec)

24import Data.ByteString.Builder.Prim

25import Data.ByteString.Builder.Prim

25 ( liftFixedToBounded, (>$<), (>*<)

26 ( liftFixedToBounded, (>$<), (>*<)

26 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

27 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

27import Data.Char ( chr )

28import Data.Char ( chr )

28import Data.Int ( Int32, Int64 )

29import Data.Int ( Int32, Int64 )

29−import Data.Time

30+import Data.String (fromString)

31+import Data.Time.Compat

30 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

32 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

31 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

33 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

32 , TimeZone, timeZoneMinutes )

34 , TimeZone, timeZoneMinutes )

35+import Data.Time.Format.ISO8601.Compat (iso8601Show)

36+import Data.Time.LocalTime.Compat (CalendarDiffTime)

33import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

37import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

34import Unsafe.Coerce (unsafeCoerce)

38import Unsafe.Coerce (unsafeCoerce)

35

39

@@ -121,3 +125,11 @@ nominalDiffTime :: NominalDiffTime -> Builder

121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

122 where

126 where

123 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

128+

129+calendarDiffTime :: CalendarDiffTime -> Builder

130+calendarDiffTime = byteString

131+ . fromString

132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".

133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted

134+ -- to ASCII output.

135+ . iso8601Show

src/Database/PostgreSQL/Simple/ToField.hs+6−1

@@ -36,7 +36,8 @@ import Data.Functor.Identity (Identity(Identity))

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

37import Data.List (intersperse)

38import Data.Monoid (mappend)

39−import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

40+import Data.Time.LocalTime.Compat (CalendarDiffTime)

40import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

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

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

42import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

43import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

@@ -293,6 +294,10 @@ instance ToField NominalDiffTime where

293 toField = Plain . inQuotes . nominalDiffTimeToBuilder

294 toField = Plain . inQuotes . nominalDiffTimeToBuilder

294 {-# INLINE toField #-}

295 {-# INLINE toField #-}

295

296

297+instance ToField CalendarDiffTime where

298+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

299+ {-# INLINE toField #-}

300+

296instance (ToField a) => ToField (PGArray a) where

301instance (ToField a) => ToField (PGArray a) where

297 toField pgArray =

302 toField pgArray =

298 case fromPGArray pgArray of

303 case fromPGArray pgArray of

test/Interval.hsnew file+176

@@ -0,0 +1,176 @@

1+{-# LANGUAGE QuasiQuotes #-}

2+

3+{-

4+

5+Testing strategies:

6+

7+fromString . toString == id ** Todo?

8+

9+toString . fromString == almost id ** Todo?

10+

11+postgresql -> haskell -> postgresql * Done

12+

13+haskell -> postgresql -> haskell ** Todo?

14+

15+But still, what we really want to establish is that the two values

16+correspond; for example, a conversion that consistently added hour

17+when printed to a string and subtracted an hour when parsed from string

18+would still pass these tests.

19+

20+

21+Right now, we are checking that 1400+ timestamps in the range of 1860 to

22+2060 round trip from postgresql to haskell and back in 5 different timezones.

23+In addition to UTC, the four timezones were selected so that 2 have a positive

24+offset, and 2 have a negative offset, and that 2 have an offset of a

25+whole number of hours, while the other two do not.

26+

27+It may be worth adding a few more timezones to ensure better test coverage.

28+

29+We are checking a handful of selected timestamps to ensure we hit

30+various corner-cases in the code, in addition to 1400 timestamps randomly

31+generated with granularity of seconds down to microseconds in powers of ten.

32+

33+-}

34+

35+module Interval (testInterval) where

36+

37+import Common

38+import Control.Monad(forM_, replicateM_)

39+import Data.Time.Compat

40+import Data.Time.LocalTime.Compat (CalendarDiffTime(..))

41+import Data.ByteString(ByteString)

42+import Database.PostgreSQL.Simple.SqlQQ

43+

44+data IntervalTestCase = IntervalTestCase

45+ { label :: String

46+ , inputMonths :: Integer

47+ , inputSeconds :: NominalDiffTime

48+ , asText :: String

49+ }

50+ deriving (Eq, Show)

51+

52+testInterval :: TestEnv -> Assertion

53+testInterval env@TestEnv{..} = do

54+

55+ initializeTable env

56+

57+ let milliseconds = 0.001

58+ seconds = 1

59+ minutes = 60 * seconds

60+ hours = 60 * minutes

61+ days = 24 * hours

62+ weeks = 7 * days

63+ months = 1

64+ years = 12 * months

65+

66+ mapM (checkRoundTrip env)

67+ [ IntervalTestCase

68+ { label = "zero"

69+ , inputMonths = 0

70+ , inputSeconds = 0

71+ , asText = "PT0"

72+ }

73+ , IntervalTestCase

74+ { label = "1 year"

75+ , inputMonths = 1 * years

76+ , inputSeconds = 0

77+ , asText = "P1Y"

78+ }

79+ , IntervalTestCase

80+ { label = "2 months"

81+ , inputMonths = 2 * months

82+ , inputSeconds = 0

83+ , asText = "P2M"

84+ }

85+ , IntervalTestCase

86+ { label = "3 weeks"

87+ , inputMonths = 0

88+ , inputSeconds = 3 * weeks

89+ , asText = "P3W"

90+ }

91+ , IntervalTestCase

92+ { label = "4 days"

93+ , inputMonths = 0

94+ , inputSeconds = 4 * days

95+ , asText = "P4D"

96+ }

97+ , IntervalTestCase

98+ { label = "5 hours"

99+ , inputMonths = 0

100+ , inputSeconds = 5 * hours

101+ , asText = "PT5H"

102+ }

103+ , IntervalTestCase

104+ { label = "6 minutes"

105+ , inputMonths = 0

106+ , inputSeconds = 6 * minutes

107+ , asText = "PT6M"

108+ }

109+ , IntervalTestCase

110+ { label = "7 seconds"

111+ , inputMonths = 0

112+ , inputSeconds = 7 * seconds

113+ , asText = "PT7S"

114+ }

115+ , IntervalTestCase

116+ { label = "8 milliseconds"

117+ , inputMonths = 0

118+ , inputSeconds = 8 * milliseconds

119+ , asText = "PT0.008S"

120+ }

121+ , IntervalTestCase

122+ { label = "combination of intervals (day-size or bigger)"

123+ , inputMonths = 2 * years + 4 * months

124+ , inputSeconds = 3 * weeks + 5 * days

125+ , asText = "P2Y4M3W5D"

126+ }

127+ , IntervalTestCase

128+ { label = "combination of intervals (smaller than day-size)"

129+ , inputMonths = 0

130+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

131+ , asText = "PT18H56M23.563S"

132+ }

133+ , IntervalTestCase

134+ { label = "full combination of intervals"

135+ , inputMonths = 2 * years + 4 * months

136+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds

137+ , asText = "P2Y4M3W5DT18H56M23.563S"

138+ }

139+ ]

140+

141+ return ()

142+

143+initializeTable :: TestEnv -> IO ()

144+initializeTable TestEnv{..} = withTransaction conn $ do

145+ execute_ conn

146+ [sql| CREATE TEMPORARY TABLE testinterval

147+ ( id serial, sample interval, PRIMARY KEY(id) ) |]

148+

149+ return ()

150+

151+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()

152+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do

153+

154+ let input = CalendarDiffTime

155+ { ctMonths = inputMonths

156+ , ctTime = inputSeconds

157+ }

158+

159+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|

160+ INSERT INTO testinterval (sample)

161+ VALUES (?)

162+ RETURNING id, sample

163+ |] (Only input)

164+

165+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $

166+ output == input

167+

168+ [(Only isExpectedIso)] <- query conn [sql|

169+ SELECT sample = (?)::interval

170+ FROM testinterval

171+ WHERE id = ?

172+ |] (asText, returnedId)

173+

174+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")

175+ isExpectedIso

176+

test/Main.hs+8−2

@@ -46,7 +46,7 @@ import qualified Data.Text.Encoding as T

46import qualified Data.Vector as V

47import System.FilePath

48import System.Timeout(timeout)

49−import Data.Time(getCurrentTime, diffUTCTime)

49+import Data.Time.Compat (getCurrentTime, diffUTCTime)

50import System.Environment (getEnvironment)

51

52import Test.Tasty

@@ -54,6 +54,7 @@ import Test.Tasty.Golden

54import Notify

55import Serializable

56import Time

57+import Interval

57

58

58tests :: TestEnv -> TestTree

59tests :: TestEnv -> TestTree

59tests env = testGroup "tests"

60tests env = testGroup "tests"

@@ -64,6 +65,7 @@ tests env = testGroup "tests"

64 , testCase "Notify" . testNotify

65 , testCase "Notify" . testNotify

65 , testCase "Serializable" . testSerializable

66 , testCase "Serializable" . testSerializable

66 , testCase "Time" . testTime

67 , testCase "Time" . testTime

68+ , testCase "Interval" . testInterval

67 , testCase "Array" . testArray

69 , testCase "Array" . testArray

68 , testCase "Array of nullables" . testNullableArray

70 , testCase "Array of nullables" . testNullableArray

69 , testCase "HStore" . testHStore

71 , testCase "HStore" . testHStore

@@ -604,7 +606,11 @@ isFormatError i FormatError{..}

604-- that 'testConnect' connects to the same database every time it is called.

606-- that 'testConnect' connects to the same database every time it is called.

605withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

607withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

606withTestEnv connstr cb =

608withTestEnv connstr cb =

607− withConn $ \conn ->

609+ withConn $ \conn -> do

610+ -- currently required for interval to work.

611+ -- we also test that this doesn't interfere with anything else

612+ execute_ conn "SET intervalstyle TO 'iso_8601'"

613+

608 cb TestEnv

614 cb TestEnv

609 { conn = conn

615 { conn = conn

610 , withConn = withConn

616 , withConn = withConn

test/Time.hs+1−1

@@ -36,7 +36,7 @@ module Time (testTime) where

36

37import Common

38import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

40import Data.ByteString(ByteString)

41import Database.PostgreSQL.Simple.SqlQQ

42