postgresql-binary 0.9 → 0.9.0.1
raw patch · 5 files changed
+216/−191 lines, 5 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- postgresql-binary.cabal +10/−5
- tasty/Main.hs +171/−157
- tasty/Main/DB.hs +23/−19
- tasty/Main/IO.hs +8/−7
- tasty/Main/Properties.hs +4/−3
postgresql-binary.cabal view
@@ -1,7 +1,7 @@ name: postgresql-binary version:- 0.9+ 0.9.0.1 synopsis: Encoders and decoders for the PostgreSQL's binary format description:@@ -34,6 +34,11 @@ Simple cabal-version: >=1.10+tested-with:+ GHC==7.6.1,+ GHC==7.8.1,+ GHC==7.10.1,+ GHC==8.0.1 source-repository head@@ -49,7 +54,7 @@ ghc-options: -funbox-strict-fields default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 other-modules:@@ -102,7 +107,7 @@ Main.Properties Main.Prelude default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 build-depends:@@ -150,7 +155,7 @@ "-with-rtsopts=-N" -funbox-strict-fields default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 build-depends:@@ -181,7 +186,7 @@ "-with-rtsopts=-N" -funbox-strict-fields default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010 build-depends:
tasty/Main.hs view
@@ -16,7 +16,8 @@ import qualified Main.Properties as Properties import qualified Main.IO as IO import qualified Main.PTI as PTI-import qualified Main.TextEncoder as TextEncoder +import qualified Main.TextEncoder as TextEncoder+import qualified Database.PostgreSQL.LibPQ as LibPQ import Main.Apx (Apx(..)) @@ -24,161 +25,168 @@ defaultMain (testGroup "" [binary, textual]) binary =- testGroup "Binary format"- [- stdRoundtrip "jsonb" Gens.aeson PTI.jsonb Encoder.jsonb_ast Decoder.jsonb_ast- ,- select "SELECT '1 year 2 months 3 days 4 hours 5 minutes 6 seconds 332211 microseconds' :: interval"- (bool Decoder.interval_float Decoder.interval_int)- (picosecondsToDiffTime (10^6 * (332211 + 10^6 * (6 + 60 * (5 + 60 * (4 + 24 * (3 + 31 * (2 + 12))))))))- ,- select "SELECT '10 seconds' :: interval"- (bool Decoder.interval_float Decoder.interval_int)- (10 :: DiffTime)- ,- HUnit.testCase "Interval encoder: 10 seconds" $- let- pti =- PTI.interval- encoder =- (bool Encoder.interval_float Encoder.interval_int)- decoder =- (bool Decoder.interval_float Decoder.interval_int)- value =- (10 :: DiffTime)- in- HUnit.assertEqual "" (Right value) =<<- IO.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder value- ,- timeRoundtrip "interval" Gens.intervalDiffTime PTI.interval- (bool Encoder.interval_float Encoder.interval_int)- (bool Decoder.interval_float Decoder.interval_int)- ,- timeRoundtrip "timestamp" (fmap Apx Gens.auto) PTI.timestamp- ((. unApx) . bool Encoder.timestamp_float Encoder.timestamp_int)- (fmap Apx . bool Decoder.timestamp_float Decoder.timestamp_int)- ,- HUnit.testCase "timestamptz offset" $ do- Right (textual, decoded) <-- DB.session $ do- integerDatetimes <- DB.integerDatetimes- let encoder = bool Encoder.timestamptz_float Encoder.timestamptz_int integerDatetimes- decoder = bool Decoder.timestamptz_float Decoder.timestamptz_int integerDatetimes- DB.unit "DROP TABLE IF EXISTS a" []- DB.unit "CREATE TABLE a (b TIMESTAMPTZ)" []- DB.unit "set timezone to 'America/Los_Angeles'" []- let p = (,,) (PTI.oidPQ (PTI.ptiOID PTI.timestamptz))- (Encoder.run encoder x) - (DB.Binary)- x = read "2011-09-28 00:17:25"- DB.unit "insert into a (b) values ($1)" [Just p]- DB.unit "set timezone to 'Europe/Stockholm'" []- textual <- DB.oneRow "SELECT * FROM a" [] DB.Text- decoded <- fmap (Decoder.run decoder) (DB.oneRow "SELECT * FROM a" [] DB.Binary)- return (textual, decoded)- HUnit.assertEqual "" ("2011-09-28 02:17:25+02") textual- HUnit.assertEqual "" (Right (read "2011-09-28 00:17:25")) decoded- ,- timeRoundtrip "timestamptz" (fmap Apx Gens.auto) PTI.timestamptz- ((. unApx) . bool Encoder.timestamptz_float Encoder.timestamptz_int)- (fmap Apx . bool Decoder.timestamptz_float Decoder.timestamptz_int)- ,- timeRoundtrip "timetz" (fmap Apx Gens.timetz) PTI.timetz- ((. unApx) . bool Encoder.timetz_float Encoder.timetz_int)- (fmap Apx . bool Decoder.timetz_float Decoder.timetz_int)- ,- timeRoundtrip "time" (fmap Apx Gens.auto) PTI.time- ((. unApx) . bool Encoder.time_float Encoder.time_int)- (fmap Apx . bool Decoder.time_float Decoder.time_int)- ,- stdRoundtrip "numeric" Gens.scientific PTI.numeric Encoder.numeric Decoder.numeric- ,- select "SELECT -1234560.789 :: numeric" (const Decoder.numeric) (read "-1234560.789")- ,- select "SELECT -0.0789 :: numeric" (const Decoder.numeric) (read "-0.0789")- ,- select "SELECT 10000 :: numeric" (const Decoder.numeric) (read "10000")- ,- stdRoundtrip "float4" Gens.auto PTI.float4 Encoder.float4 Decoder.float4- ,- stdRoundtrip "float8" Gens.auto PTI.float8 Encoder.float8 Decoder.float8- ,- stdRoundtrip "char" Gens.char PTI.text Encoder.char Decoder.char- ,- stdRoundtrip "text_strict" Gens.text PTI.text Encoder.text_strict Decoder.text_strict- ,- stdRoundtrip "text_lazy" (fmap convert Gens.text) PTI.text Encoder.text_lazy Decoder.text_lazy- ,- stdRoundtrip "bytea_strict" Gens.auto PTI.bytea Encoder.bytea_strict Decoder.bytea_strict- ,- stdRoundtrip "bytea_lazy" Gens.auto PTI.bytea Encoder.bytea_lazy Decoder.bytea_lazy- ,- stdRoundtrip "uuid" Gens.uuid PTI.uuid Encoder.uuid Decoder.uuid- ,- stdRoundtrip "int2_int16" Gens.auto PTI.int2 Encoder.int2_int16 Decoder.int- ,- stdRoundtrip "int2_word16" Gens.auto PTI.int2 Encoder.int2_word16 Decoder.int- ,- stdRoundtrip "int4_int32" Gens.auto PTI.int4 Encoder.int4_int32 Decoder.int- ,- stdRoundtrip "int4_word32" Gens.auto PTI.int4 Encoder.int4_word32 Decoder.int- ,- stdRoundtrip "int8_int64" Gens.auto PTI.int8 Encoder.int8_int64 Decoder.int- ,- stdRoundtrip "int8_word64" Gens.auto PTI.int8 Encoder.int8_word64 Decoder.int- ,- stdRoundtrip "bool" Gens.auto PTI.bool Encoder.bool Decoder.bool- ,- stdRoundtrip "date" Gens.auto PTI.date Encoder.date Decoder.date- ,- let- decoder =- Decoder.array $- Decoder.arrayDimension replicateM $- Decoder.arrayDimension replicateM $- Decoder.arrayNonNullValue $- Decoder.int- in- select "SELECT ARRAY[ARRAY[1,2],ARRAY[3,4]]" (const decoder) ([[1,2],[3,4]] :: [[Int]])- ,- let- encoder =- Encoder.array (PTI.oidWord32 (PTI.ptiOID PTI.int8)) $- Encoder.arrayDimension foldl' $- Encoder.arrayDimension foldl' $- Encoder.arrayDimension foldl' $- Encoder.arrayValue $- Encoder.int8_int64- decoder =- Decoder.array $- Decoder.arrayDimension replicateM $- Decoder.arrayDimension replicateM $- Decoder.arrayDimension replicateM $- Decoder.arrayNonNullValue $- Decoder.int- in- arrayCodec (Gens.array3 Gens.auto) encoder decoder- ,- let- pti =- PTI.text- encoder =- Encoder.array (PTI.oidWord32 (PTI.ptiOID pti)) $- Encoder.arrayDimension foldl' $- Encoder.arrayDimension foldl' $- Encoder.arrayDimension foldl' $- Encoder.arrayValue $- Encoder.text_strict- decoder =- Decoder.array $- Decoder.arrayDimension replicateM $- Decoder.arrayDimension replicateM $- Decoder.arrayDimension replicateM $- Decoder.arrayNonNullValue $- Decoder.text_strict- in- arrayRoundtrip (Gens.array3 Gens.text) pti encoder decoder- ]+ testGroup "Binary format" testList+ where+ testList =+ jsonb ++ other+ where+ jsonb =+ if version >= 90400+ then [stdRoundtrip "jsonb" Gens.aeson PTI.jsonb Encoder.jsonb_ast Decoder.jsonb_ast]+ else []+ other =+ [+ select "SELECT '1 year 2 months 3 days 4 hours 5 minutes 6 seconds 332211 microseconds' :: interval"+ (bool Decoder.interval_float Decoder.interval_int)+ (picosecondsToDiffTime (10^6 * (332211 + 10^6 * (6 + 60 * (5 + 60 * (4 + 24 * (3 + 31 * (2 + 12))))))))+ ,+ select "SELECT '10 seconds' :: interval"+ (bool Decoder.interval_float Decoder.interval_int)+ (10 :: DiffTime)+ ,+ HUnit.testCase "Interval encoder: 10 seconds" $+ let+ pti =+ PTI.interval+ encoder =+ (bool Encoder.interval_float Encoder.interval_int)+ decoder =+ (bool Decoder.interval_float Decoder.interval_int)+ value =+ (10 :: DiffTime)+ in+ HUnit.assertEqual "" (Right value) =<<+ IO.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder value+ ,+ timeRoundtrip "interval" Gens.intervalDiffTime PTI.interval+ (bool Encoder.interval_float Encoder.interval_int)+ (bool Decoder.interval_float Decoder.interval_int)+ ,+ timeRoundtrip "timestamp" (fmap Apx Gens.auto) PTI.timestamp+ ((. unApx) . bool Encoder.timestamp_float Encoder.timestamp_int)+ (fmap Apx . bool Decoder.timestamp_float Decoder.timestamp_int)+ ,+ HUnit.testCase "timestamptz offset" $ do+ Right (textual, decoded) <-+ DB.session $ do+ integerDatetimes <- DB.integerDatetimes+ let encoder = bool Encoder.timestamptz_float Encoder.timestamptz_int integerDatetimes+ decoder = bool Decoder.timestamptz_float Decoder.timestamptz_int integerDatetimes+ DB.unit "DROP TABLE IF EXISTS a" []+ DB.unit "CREATE TABLE a (b TIMESTAMPTZ)" []+ DB.unit "set timezone to 'America/Los_Angeles'" []+ let p = (,,) (PTI.oidPQ (PTI.ptiOID PTI.timestamptz))+ (Encoder.run encoder x) + (LibPQ.Binary)+ x = read "2011-09-28 00:17:25"+ DB.unit "insert into a (b) values ($1)" [Just p]+ DB.unit "set timezone to 'Europe/Stockholm'" []+ textual <- DB.oneRow "SELECT * FROM a" [] LibPQ.Text+ decoded <- fmap (Decoder.run decoder) (DB.oneRow "SELECT * FROM a" [] LibPQ.Binary)+ return (textual, decoded)+ HUnit.assertEqual "" ("2011-09-28 02:17:25+02") textual+ HUnit.assertEqual "" (Right (read "2011-09-28 00:17:25")) decoded+ ,+ timeRoundtrip "timestamptz" (fmap Apx Gens.auto) PTI.timestamptz+ ((. unApx) . bool Encoder.timestamptz_float Encoder.timestamptz_int)+ (fmap Apx . bool Decoder.timestamptz_float Decoder.timestamptz_int)+ ,+ timeRoundtrip "timetz" (fmap Apx Gens.timetz) PTI.timetz+ ((. unApx) . bool Encoder.timetz_float Encoder.timetz_int)+ (fmap Apx . bool Decoder.timetz_float Decoder.timetz_int)+ ,+ timeRoundtrip "time" (fmap Apx Gens.auto) PTI.time+ ((. unApx) . bool Encoder.time_float Encoder.time_int)+ (fmap Apx . bool Decoder.time_float Decoder.time_int)+ ,+ stdRoundtrip "numeric" Gens.scientific PTI.numeric Encoder.numeric Decoder.numeric+ ,+ select "SELECT -1234560.789 :: numeric" (const Decoder.numeric) (read "-1234560.789")+ ,+ select "SELECT -0.0789 :: numeric" (const Decoder.numeric) (read "-0.0789")+ ,+ select "SELECT 10000 :: numeric" (const Decoder.numeric) (read "10000")+ ,+ stdRoundtrip "float4" Gens.auto PTI.float4 Encoder.float4 Decoder.float4+ ,+ stdRoundtrip "float8" Gens.auto PTI.float8 Encoder.float8 Decoder.float8+ ,+ stdRoundtrip "char" Gens.char PTI.text Encoder.char Decoder.char+ ,+ stdRoundtrip "text_strict" Gens.text PTI.text Encoder.text_strict Decoder.text_strict+ ,+ stdRoundtrip "text_lazy" (fmap convert Gens.text) PTI.text Encoder.text_lazy Decoder.text_lazy+ ,+ stdRoundtrip "bytea_strict" Gens.auto PTI.bytea Encoder.bytea_strict Decoder.bytea_strict+ ,+ stdRoundtrip "bytea_lazy" Gens.auto PTI.bytea Encoder.bytea_lazy Decoder.bytea_lazy+ ,+ stdRoundtrip "uuid" Gens.uuid PTI.uuid Encoder.uuid Decoder.uuid+ ,+ stdRoundtrip "int2_int16" Gens.auto PTI.int2 Encoder.int2_int16 Decoder.int+ ,+ stdRoundtrip "int2_word16" Gens.auto PTI.int2 Encoder.int2_word16 Decoder.int+ ,+ stdRoundtrip "int4_int32" Gens.auto PTI.int4 Encoder.int4_int32 Decoder.int+ ,+ stdRoundtrip "int4_word32" Gens.auto PTI.int4 Encoder.int4_word32 Decoder.int+ ,+ stdRoundtrip "int8_int64" Gens.auto PTI.int8 Encoder.int8_int64 Decoder.int+ ,+ stdRoundtrip "int8_word64" Gens.auto PTI.int8 Encoder.int8_word64 Decoder.int+ ,+ stdRoundtrip "bool" Gens.auto PTI.bool Encoder.bool Decoder.bool+ ,+ stdRoundtrip "date" Gens.auto PTI.date Encoder.date Decoder.date+ ,+ let+ decoder =+ Decoder.array $+ Decoder.arrayDimension replicateM $+ Decoder.arrayDimension replicateM $+ Decoder.arrayNonNullValue $+ Decoder.int+ in+ select "SELECT ARRAY[ARRAY[1,2],ARRAY[3,4]]" (const decoder) ([[1,2],[3,4]] :: [[Int]])+ ,+ let+ encoder =+ Encoder.array (PTI.oidWord32 (PTI.ptiOID PTI.int8)) $+ Encoder.arrayDimension foldl' $+ Encoder.arrayDimension foldl' $+ Encoder.arrayDimension foldl' $+ Encoder.arrayValue $+ Encoder.int8_int64+ decoder =+ Decoder.array $+ Decoder.arrayDimension replicateM $+ Decoder.arrayDimension replicateM $+ Decoder.arrayDimension replicateM $+ Decoder.arrayNonNullValue $+ Decoder.int+ in+ arrayCodec (Gens.array3 Gens.auto) encoder decoder+ ,+ let+ pti =+ PTI.text+ encoder =+ Encoder.array (PTI.oidWord32 (PTI.ptiOID pti)) $+ Encoder.arrayDimension foldl' $+ Encoder.arrayDimension foldl' $+ Encoder.arrayDimension foldl' $+ Encoder.arrayValue $+ Encoder.text_strict+ decoder =+ Decoder.array $+ Decoder.arrayDimension replicateM $+ Decoder.arrayDimension replicateM $+ Decoder.arrayDimension replicateM $+ Decoder.arrayNonNullValue $+ Decoder.text_strict+ in+ arrayRoundtrip (Gens.array3 Gens.text) pti encoder decoder+ ] textual = testGroup "Textual format" $@@ -232,4 +240,10 @@ HUnit.assertEqual "" (Right value) $ unsafePerformIO $ IO.parameterlessStatement statement decoder value - +{-# NOINLINE version #-}+version :: Int+version =+ either (error . show) id $+ unsafePerformIO $+ DB.session $+ DB.serverVersion
tasty/Main/DB.hs view
@@ -1,10 +1,10 @@ module Main.DB (- module LibPQ, session, oneRow, unit, integerDatetimes,+ serverVersion, ) where @@ -12,12 +12,12 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.Either import Control.Monad.IO.Class-import Database.PostgreSQL.LibPQ as LibPQ+import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Data.ByteString as ByteString; import Data.ByteString (ByteString) type Session =- EitherT ByteString (ReaderT Connection IO)+ EitherT ByteString (ReaderT LibPQ.Connection IO) session :: Session a -> IO (Either ByteString a) session m =@@ -25,47 +25,51 @@ c <- connect initConnection c r <- runReaderT (runEitherT m) c- finish c+ LibPQ.finish c return r -oneRow :: ByteString -> [Maybe (Oid, ByteString, Format)] -> Format -> Session ByteString+oneRow :: ByteString -> [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)] -> LibPQ.Format -> Session ByteString oneRow statement params outFormat = do Just result <- result statement params outFormat- Just result <- liftIO $ getvalue result 0 0+ Just result <- liftIO $ LibPQ.getvalue result 0 0 return result -unit :: ByteString -> [Maybe (Oid, ByteString, Format)] -> Session ()+unit :: ByteString -> [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)] -> Session () unit statement params =- void $ result statement params Binary+ void $ result statement params LibPQ.Binary -result :: ByteString -> [Maybe (Oid, ByteString, Format)] -> Format -> Session (Maybe Result)+result :: ByteString -> [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)] -> LibPQ.Format -> Session (Maybe LibPQ.Result) result statement params outFormat = do- result <- EitherT $ ReaderT $ \connection -> fmap Right $ execParams connection statement params outFormat+ result <- EitherT $ ReaderT $ \connection -> fmap Right $ LibPQ.execParams connection statement params outFormat checkResult result return result -checkResult :: Maybe Result -> Session ()+checkResult :: Maybe LibPQ.Result -> Session () checkResult result = EitherT $ ReaderT $ \connection -> do case result of Just result -> do- resultErrorField result DiagMessagePrimary >>= maybe (return (Right ())) (return . Left)+ LibPQ.resultErrorField result LibPQ.DiagMessagePrimary >>= maybe (return (Right ())) (return . Left) Nothing -> do- m <- errorMessage connection+ m <- LibPQ.errorMessage connection return $ Left $ maybe "Fatal PQ error" (\m -> "Fatal PQ error: " <> m) m integerDatetimes :: Session Bool integerDatetimes = lift (ReaderT getIntegerDatetimes) +serverVersion :: Session Int+serverVersion =+ lift (ReaderT LibPQ.serverVersion)+ -- * ------------------------- -connect :: IO Connection+connect :: IO LibPQ.Connection connect =- connectdb bs+ LibPQ.connectdb bs where bs = ByteString.intercalate " " components@@ -85,18 +89,18 @@ password = "" db = "postgres" -initConnection :: Connection -> IO ()+initConnection :: LibPQ.Connection -> IO () initConnection c =- void $ exec c $ mconcat $ map (<> ";") $ + void $ LibPQ.exec c $ mconcat $ map (<> ";") $ [ "SET client_min_messages TO WARNING", "SET client_encoding = 'UTF8'", "SET intervalstyle = 'postgres'" ] -getIntegerDatetimes :: Connection -> IO Bool+getIntegerDatetimes :: LibPQ.Connection -> IO Bool getIntegerDatetimes c =- fmap parseResult $ parameterStatus c "integer_datetimes"+ fmap parseResult $ LibPQ.parameterStatus c "integer_datetimes" where parseResult = \case
tasty/Main/IO.hs view
@@ -15,32 +15,33 @@ import qualified PostgreSQL.Binary.Data as Data import qualified PostgreSQL.Binary.Encoder as Encoder import qualified PostgreSQL.Binary.Decoder as Decoder+import qualified Database.PostgreSQL.LibPQ as LibPQ -textRoundtrip :: DB.Oid -> TextEncoder.Encoder a -> (Bool -> Decoder.Decoder a) -> a -> IO (Either Text a)+textRoundtrip :: LibPQ.Oid -> TextEncoder.Encoder a -> (Bool -> Decoder.Decoder a) -> a -> IO (Either Text a) textRoundtrip oid encoder decoder value = fmap (either (Left . Text.decodeUtf8) id) $ DB.session $ do integerDatetimes <- DB.integerDatetimes- bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) DB.Binary+ bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) LibPQ.Binary return $ Decoder.run (decoder integerDatetimes) bytes where params integerDatetimes =- [ Just ( oid , bytes , DB.Text ) ]+ [ Just ( oid , bytes , LibPQ.Text ) ] where bytes = (convert . encoder) value -roundtrip :: DB.Oid -> (Bool -> Encoder.Encoder a) -> (Bool -> Decoder.Decoder b) -> a -> IO (Either Text b)+roundtrip :: LibPQ.Oid -> (Bool -> Encoder.Encoder a) -> (Bool -> Decoder.Decoder b) -> a -> IO (Either Text b) roundtrip oid encoder decoder value = fmap (either (Left . Text.decodeUtf8) id) $ DB.session $ do integerDatetimes <- DB.integerDatetimes- bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) DB.Binary+ bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) LibPQ.Binary return $ Decoder.run (decoder integerDatetimes) bytes where params integerDatetimes =- [ Just ( oid , bytes , DB.Binary ) ]+ [ Just ( oid , bytes , LibPQ.Binary ) ] where bytes = (convert . encoder integerDatetimes) value@@ -50,5 +51,5 @@ fmap (either (Left . Text.decodeUtf8) id) $ DB.session $ do integerDatetimes <- DB.integerDatetimes- bytes <- DB.oneRow statement [] DB.Binary+ bytes <- DB.oneRow statement [] LibPQ.Binary return $ Decoder.run (decoder integerDatetimes) bytes
tasty/Main/Properties.hs view
@@ -13,17 +13,18 @@ import qualified Main.PTI as PTI import qualified Main.DB as DB import qualified Main.IO as IO+import qualified Database.PostgreSQL.LibPQ as LibPQ roundtrip :: (Show a, Eq a) => - DB.Oid -> (Bool -> Encoder.Encoder a) -> (Bool -> Decoder.Decoder a) -> a -> Property+ LibPQ.Oid -> (Bool -> Encoder.Encoder a) -> (Bool -> Decoder.Decoder a) -> a -> Property roundtrip oid encoder decoder value = Right value === unsafePerformIO (IO.roundtrip oid encoder decoder value) -stdRoundtrip :: (Show a, Eq a) => DB.Oid -> Encoder.Encoder a -> Decoder.Decoder a -> a -> Property+stdRoundtrip :: (Show a, Eq a) => LibPQ.Oid -> Encoder.Encoder a -> Decoder.Decoder a -> a -> Property stdRoundtrip oid encoder decoder value = roundtrip oid (const encoder) (const decoder) value -textRoundtrip :: (Show a, Eq a) => DB.Oid -> TextEncoder.Encoder a -> (Bool -> Decoder.Decoder a) -> a -> Property+textRoundtrip :: (Show a, Eq a) => LibPQ.Oid -> TextEncoder.Encoder a -> (Bool -> Decoder.Decoder a) -> a -> Property textRoundtrip oid encoder decoder value = Right value === unsafePerformIO (IO.textRoundtrip oid encoder decoder value)