postgresql-simple 0.6.3 → 0.6.4
raw patch · 13 files changed
+309/−21 lines, 13 filesdep +time-compatdep −timedep ~aesondep ~attoparsecdep ~base
Dependencies added: time-compat
Dependencies removed: time
Dependency ranges changed: aeson, attoparsec, base, hashable, inspection-testing, postgresql-libpq, semigroups, template-haskell, text, transformers, vector
Files
- CHANGES.md +10/−0
- postgresql-simple.cabal +6/−5
- src/Database/PostgreSQL/Simple/Copy.hs +25/−0
- src/Database/PostgreSQL/Simple/FromField.hs +10/−1
- src/Database/PostgreSQL/Simple/Range.hs +1/−1
- src/Database/PostgreSQL/Simple/Time.hs +2/−0
- src/Database/PostgreSQL/Simple/Time/Implementation.hs +11/−1
- src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs +12/−3
- src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs +14/−2
- src/Database/PostgreSQL/Simple/ToField.hs +6/−1
- test/Interval.hs +176/−0
- test/Main.hs +35/−6
- test/Time.hs +1/−1
CHANGES.md view
@@ -1,3 +1,13 @@+### Version 0.6.4 (2021-01-06)++ * Add foldCopyData helper function+ Thanks to Sebastián Estrella for the implementation+ https://github.com/haskellari/postgresql-simple/pull/56+ * Implement support for postgresql 'interval' type+ Thanks to Andre Marques Lee for the implementation+ https://github.com/haskellari/postgresql-simple/pull/60+ * Depend on `time-compat` to provide uniform `time` related interface.+ ### Version 0.6.3 (2020-11-15) * Add `fromFieldJSONByteString`
postgresql-simple.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: postgresql-simple-version: 0.6.3+version: 0.6.4 synopsis: Mid-Level PostgreSQL client library description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -31,7 +31,7 @@ || ==8.4.4 || ==8.6.5 || ==8.8.4- || ==8.10.2+ || ==8.10.3 library default-language: Haskell2010@@ -82,7 +82,7 @@ , containers >=0.5.0.0 && <0.7 , template-haskell >=2.8.0.0 && <2.17 , text >=1.2.3.0 && <1.3- , time >=1.4.0.1 && <1.12+ , time-compat >=1.9.5 && <1.12 , transformers >=0.3.0.0 && <0.6 -- Other dependencies@@ -93,7 +93,7 @@ , case-insensitive >=1.2.0.11 && <1.3 , hashable >=1.2.7.0 && <1.4 , Only >=0.1 && <0.1.1- , postgresql-libpq >=0.9.4.2 && <0.10+ , postgresql-libpq >=0.9.4.3 && <0.10 , scientific >=0.3.6.2 && <0.4 , uuid-types >=1.0.3 && <1.1 , vector >=0.12.0.1 && <0.13@@ -150,6 +150,7 @@ Notify Serializable Time+ Interval ghc-options: -threaded ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind@@ -176,7 +177,7 @@ , tasty-golden , tasty-hunit , text- , time+ , time-compat , vector if !impl(ghc >=7.6)
src/Database/PostgreSQL/Simple/Copy.hs view
@@ -32,6 +32,7 @@ ( copy , copy_ , CopyOutResult(..)+ , foldCopyData , getCopyData , putCopyData , putCopyEnd@@ -102,6 +103,30 @@ | CopyOutDone {-# UNPACK #-} !Int64 -- ^ No more rows, and a count of the -- number of rows returned. deriving (Eq, Typeable, Show)+++-- | Fold over @COPY TO STDOUT@ query passing each copied row to an accumulator+-- and calling a post-process at the end. A connection must be in the+-- @CopyOut@ state in order to call this function.+--+-- __Example__+--+-- > (acc, count) <- foldCopyData conn+-- > (\acc row -> return (row:acc))+-- > (\acc count -> return (acc, count))+-- > []++foldCopyData+ :: Connection -- ^ Database connection+ -> (a -> B.ByteString -> IO a) -- ^ Accumulate one row of the result+ -> (a -> Int64 -> IO b) -- ^ Post-process accumulator with a count of rows+ -> a -- ^ Initial accumulator+ -> IO b -- ^ Result+foldCopyData conn f g !acc = do+ result <- getCopyData conn+ case result of+ CopyOutRow row -> f acc row >>= foldCopyData conn f g+ CopyOutDone count -> g acc count -- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
src/Database/PostgreSQL/Simple/FromField.hs view
@@ -129,7 +129,7 @@ import Data.Int (Int16, Int32, Int64) import Data.IORef (IORef, newIORef) import Data.Ratio (Ratio)-import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )+import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime ) import Data.Typeable (Typeable, typeOf) import Data.Vector (Vector) import Data.Vector.Mutable (IOVector)@@ -486,6 +486,15 @@ -- | date instance FromField Date where fromField = ff TI.dateOid "Date" parseDate++-- | interval. Requires you to configure intervalstyle as @iso_8601@.+--+-- You can configure intervalstyle on every connection with a @SET@ command,+-- but for better performance you may want to configure it permanently in the+-- file found with @SHOW config_file;@ .+--+instance FromField CalendarDiffTime where+ fromField = ff TI.intervalOid "CalendarDiffTime" parseCalendarDiffTime ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a) -> Field -> Maybe B8.ByteString -> Conversion a
src/Database/PostgreSQL/Simple/Range.hs view
@@ -38,7 +38,7 @@ import Data.Scientific (Scientific) import qualified Data.Text.Lazy.Builder as LT import qualified Data.Text.Lazy.Encoding as LT-import Data.Time (Day, LocalTime,+import Data.Time.Compat (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime,
src/Database/PostgreSQL/Simple/Time.hs view
@@ -227,6 +227,7 @@ , parseUTCTimestamp , parseZonedTimestamp , parseLocalTimestamp+ , parseCalendarDiffTime , dayToBuilder , utcTimeToBuilder , zonedTimeToBuilder@@ -239,6 +240,7 @@ , localTimestampToBuilder , unboundedToBuilder , nominalDiffTimeToBuilder+ , calendarDiffTimeToBuilder ) where import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs view
@@ -18,7 +18,8 @@ import Control.Arrow((***)) import Control.Applicative import qualified Data.ByteString as B-import Data.Time hiding (getTimeZone, getZonedTime)+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)+import Data.Time.LocalTime.Compat (CalendarDiffTime) import Data.Typeable import Data.Maybe (fromMaybe) import qualified Data.Attoparsec.ByteString.Char8 as A@@ -77,6 +78,9 @@ parseDate :: B.ByteString -> Either String Date parseDate = A.parseOnly (getDate <* A.endOfInput) +parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)+ getUnbounded :: A.Parser a -> A.Parser (Unbounded a) getUnbounded getFinite = (pure NegInfinity <* A.string "-infinity")@@ -125,6 +129,9 @@ getUTCTimestamp :: A.Parser UTCTimestamp getUTCTimestamp = getUnbounded getUTCTime +getCalendarDiffTime :: A.Parser CalendarDiffTime+getCalendarDiffTime = TP.calendarDiffTime+ dayToBuilder :: Day -> Builder dayToBuilder = primBounded TPP.day @@ -164,3 +171,6 @@ nominalDiffTimeToBuilder :: NominalDiffTime -> Builder nominalDiffTimeToBuilder = TPP.nominalDiffTime++calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder+calendarDiffTimeToBuilder = TPP.calendarDiffTime
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs view
@@ -21,20 +21,24 @@ , localToUTCTimeOfDayHMS , utcTime , zonedTime+ , calendarDiffTime ) where import Control.Applicative ((<$>), (<*>), (<*), (*>)) import Database.PostgreSQL.Simple.Compat (toPico) import Data.Attoparsec.ByteString.Char8 as A import Data.Bits ((.&.))+import Data.ByteString (ByteString) import Data.Char (ord) import Data.Fixed (Pico) import Data.Int (Int64) import Data.Maybe (fromMaybe)-import Data.Time.Calendar (Day, fromGregorianValid, addDays)-import Data.Time.Clock (UTCTime(..))+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)+import Data.Time.Clock.Compat (UTCTime(..))+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)+import Data.Time.LocalTime.Compat (CalendarDiffTime) import qualified Data.ByteString.Char8 as B8-import qualified Data.Time.LocalTime as Local+import qualified Data.Time.LocalTime.Compat as Local -- | Parse a date of the form @YYYY-MM-DD@. day :: Parser Day@@ -193,3 +197,8 @@ utc :: Local.TimeZone utc = Local.TimeZone 0 False ""++calendarDiffTime :: Parser CalendarDiffTime+calendarDiffTime = do+ contents <- takeByteString+ iso8601ParseM $ B8.unpack contents
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs view
@@ -17,19 +17,23 @@ , localTime , zonedTime , nominalDiffTime+ , calendarDiffTime ) where import Control.Arrow ((>>>))-import Data.ByteString.Builder (Builder, integerDec)+import Data.ByteString.Builder (Builder, byteString, integerDec) import Data.ByteString.Builder.Prim ( liftFixedToBounded, (>$<), (>*<) , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec) import Data.Char ( chr ) import Data.Int ( Int32, Int64 )-import Data.Time+import Data.String (fromString)+import Data.Time.Compat ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay , TimeZone, timeZoneMinutes )+import Data.Time.Format.ISO8601.Compat (iso8601Show)+import Data.Time.LocalTime.Compat (CalendarDiffTime) import Database.PostgreSQL.Simple.Compat ((<>), fromPico) import Unsafe.Coerce (unsafeCoerce) @@ -121,3 +125,11 @@ nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y)) where (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000++calendarDiffTime :: CalendarDiffTime -> Builder+calendarDiffTime = byteString+ . fromString+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted+ -- to ASCII output.+ . iso8601Show
src/Database/PostgreSQL/Simple/ToField.hs view
@@ -36,7 +36,8 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intersperse) import Data.Monoid (mappend)-import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)+import Data.Time.LocalTime.Compat (CalendarDiffTime) import Data.Typeable (Typeable) import Data.Word (Word, Word8, Word16, Word32, Word64) import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow@@ -291,6 +292,10 @@ instance ToField NominalDiffTime where toField = Plain . inQuotes . nominalDiffTimeToBuilder+ {-# INLINE toField #-}++instance ToField CalendarDiffTime where+ toField = Plain . inQuotes . calendarDiffTimeToBuilder {-# INLINE toField #-} instance (ToField a) => ToField (PGArray a) where
+ test/Interval.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE QuasiQuotes #-}++{-++Testing strategies:++fromString . toString == id ** Todo?++toString . fromString == almost id ** Todo?++postgresql -> haskell -> postgresql * Done++haskell -> postgresql -> haskell ** Todo?++But still, what we really want to establish is that the two values+correspond; for example, a conversion that consistently added hour+when printed to a string and subtracted an hour when parsed from string+would still pass these tests.+++Right now, we are checking that 1400+ timestamps in the range of 1860 to+2060 round trip from postgresql to haskell and back in 5 different timezones.+In addition to UTC, the four timezones were selected so that 2 have a positive+offset, and 2 have a negative offset, and that 2 have an offset of a+whole number of hours, while the other two do not.++It may be worth adding a few more timezones to ensure better test coverage.++We are checking a handful of selected timestamps to ensure we hit+various corner-cases in the code, in addition to 1400 timestamps randomly+generated with granularity of seconds down to microseconds in powers of ten.++-}++module Interval (testInterval) where++import Common+import Control.Monad(forM_, replicateM_)+import Data.Time.Compat+import Data.Time.LocalTime.Compat (CalendarDiffTime(..))+import Data.ByteString(ByteString)+import Database.PostgreSQL.Simple.SqlQQ++data IntervalTestCase = IntervalTestCase+ { label :: String+ , inputMonths :: Integer+ , inputSeconds :: NominalDiffTime+ , asText :: String+ }+ deriving (Eq, Show)++testInterval :: TestEnv -> Assertion+testInterval env@TestEnv{..} = do++ initializeTable env++ let milliseconds = 0.001+ seconds = 1+ minutes = 60 * seconds+ hours = 60 * minutes+ days = 24 * hours+ weeks = 7 * days+ months = 1+ years = 12 * months++ mapM (checkRoundTrip env)+ [ IntervalTestCase+ { label = "zero"+ , inputMonths = 0+ , inputSeconds = 0+ , asText = "PT0"+ }+ , IntervalTestCase+ { label = "1 year"+ , inputMonths = 1 * years+ , inputSeconds = 0+ , asText = "P1Y"+ }+ , IntervalTestCase+ { label = "2 months"+ , inputMonths = 2 * months+ , inputSeconds = 0+ , asText = "P2M"+ }+ , IntervalTestCase+ { label = "3 weeks"+ , inputMonths = 0+ , inputSeconds = 3 * weeks+ , asText = "P3W"+ }+ , IntervalTestCase+ { label = "4 days"+ , inputMonths = 0+ , inputSeconds = 4 * days+ , asText = "P4D"+ }+ , IntervalTestCase+ { label = "5 hours"+ , inputMonths = 0+ , inputSeconds = 5 * hours+ , asText = "PT5H"+ }+ , IntervalTestCase+ { label = "6 minutes"+ , inputMonths = 0+ , inputSeconds = 6 * minutes+ , asText = "PT6M"+ }+ , IntervalTestCase+ { label = "7 seconds"+ , inputMonths = 0+ , inputSeconds = 7 * seconds+ , asText = "PT7S"+ }+ , IntervalTestCase+ { label = "8 milliseconds"+ , inputMonths = 0+ , inputSeconds = 8 * milliseconds+ , asText = "PT0.008S"+ }+ , IntervalTestCase+ { label = "combination of intervals (day-size or bigger)"+ , inputMonths = 2 * years + 4 * months+ , inputSeconds = 3 * weeks + 5 * days+ , asText = "P2Y4M3W5D"+ }+ , IntervalTestCase+ { label = "combination of intervals (smaller than day-size)"+ , inputMonths = 0+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds+ , asText = "PT18H56M23.563S"+ }+ , IntervalTestCase+ { label = "full combination of intervals"+ , inputMonths = 2 * years + 4 * months+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds+ , asText = "P2Y4M3W5DT18H56M23.563S"+ }+ ]++ return ()++initializeTable :: TestEnv -> IO ()+initializeTable TestEnv{..} = withTransaction conn $ do+ execute_ conn+ [sql| CREATE TEMPORARY TABLE testinterval+ ( id serial, sample interval, PRIMARY KEY(id) ) |]++ return ()++checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do++ let input = CalendarDiffTime+ { ctMonths = inputMonths+ , ctTime = inputSeconds+ }++ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|+ INSERT INTO testinterval (sample)+ VALUES (?)+ RETURNING id, sample+ |] (Only input)++ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $+ output == input++ [(Only isExpectedIso)] <- query conn [sql|+ SELECT sample = (?)::interval+ FROM testinterval+ WHERE id = ?+ |] (asText, returnedId)++ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")+ isExpectedIso+
test/Main.hs view
@@ -24,6 +24,7 @@ import Control.Exception as E import Control.Monad import Data.Char+import Data.Foldable (toList) import Data.List (concat, sort) import Data.IORef import Data.Monoid ((<>))@@ -45,7 +46,7 @@ import qualified Data.Vector as V import System.FilePath import System.Timeout(timeout)-import Data.Time(getCurrentTime, diffUTCTime)+import Data.Time.Compat (getCurrentTime, diffUTCTime) import System.Environment (getEnvironment) import Test.Tasty@@ -53,6 +54,7 @@ import Notify import Serializable import Time+import Interval tests :: TestEnv -> TestTree tests env = testGroup "tests"@@ -63,6 +65,7 @@ , testCase "Notify" . testNotify , testCase "Serializable" . testSerializable , testCase "Time" . testTime+ , testCase "Interval" . testInterval , testCase "Array" . testArray , testCase "Array of nullables" . testNullableArray , testCase "HStore" . testHStore@@ -442,6 +445,14 @@ -- so that we can issue more queries: [Only (x::Int)] <- query_ conn "SELECT 2 + 2" x @?= 4+ -- foldCopyData+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"+ (acc, count) <- foldCopyData conn+ (\acc row -> return (row:acc))+ (\acc count -> return (acc, count))+ []+ sort acc @?= sort copyRows+ count @?= 2 where copyRows = ["1,foo\n" ,"2,bar\n"]@@ -595,7 +606,11 @@ -- that 'testConnect' connects to the same database every time it is called. withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a withTestEnv connstr cb =- withConn $ \conn ->+ withConn $ \conn -> do+ -- currently required for interval to work.+ -- we also test that this doesn't interfere with anything else+ execute_ conn "SET intervalstyle TO 'iso_8601'"+ cb TestEnv { conn = conn , withConn = withConn@@ -604,13 +619,27 @@ withConn = bracket (connectPostgreSQL connstr) close main :: IO ()-main = do+main = withConnstring $ \connstring -> do+ withTestEnv connstring (defaultMain . tests)++withConnstring :: (BS8.ByteString -> IO ()) -> IO ()+withConnstring kont = do env <- getEnvironment case lookup "DATABASE_CONNSTRING" env of- Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"- Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)- where+ Just s -> kont (BS8.pack (special s))+ Nothing -> case lookup "GITHUB_ACTIONS" env of+ Just "true" -> kont (BS8.pack gha)+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"+ where -- https://www.appveyor.com/docs/services-databases/ special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'" special "travis" = "" special s = s++ gha = unwords+ [ "dbname='postgres'"+ , "user='postgres'"+ , "password='postgres'"+ , "host='postgres'"+ , "port=5432"+ ]
test/Time.hs view
@@ -36,7 +36,7 @@ import Common import Control.Monad(forM_, replicateM_)-import Data.Time+import Data.Time.Compat import Data.ByteString(ByteString) import Database.PostgreSQL.Simple.SqlQQ