postgresql-binary 0.13.1 → 0.13.1.1
raw patch · 20 files changed
+395/−326 lines, 20 filesdep ~rerebase
Dependency ranges changed: rerebase
Files
- decoding/Main.hs +5/−4
- encoding/Main.hs +1/−0
- library/PostgreSQL/Binary/Decoding.hs +12/−19
- library/PostgreSQL/Binary/Encoding.hs +2/−9
- library/PostgreSQL/Binary/Encoding/Builders.hs +10/−7
- library/PostgreSQL/Binary/Interval.hs +14/−7
- library/PostgreSQL/Binary/Numeric.hs +4/−4
- library/PostgreSQL/Binary/Prelude.hs +2/−4
- library/PostgreSQL/Binary/Time.hs +23/−19
- postgresql-binary.cabal +113/−119
- tasty/Main.hs +83/−72
- tasty/Main/Apx.hs +10/−4
- tasty/Main/Composite.hs +1/−9
- tasty/Main/DB.hs +12/−12
- tasty/Main/Gens.hs +22/−16
- tasty/Main/IO.hs +10/−13
- tasty/Main/PTI.hs +69/−0
- tasty/Main/Prelude.hs +1/−0
- tasty/Main/Properties.hs +1/−7
- tasty/Main/TextEncoder.hs +0/−1
decoding/Main.hs view
@@ -6,6 +6,7 @@ import qualified PostgreSQL.Binary.Encoding as E import Prelude +main :: IO () main = defaultMain [ b "bool" D.bool ((E.encodingBytes . E.bool) True),@@ -28,10 +29,10 @@ let encoder = E.array 23 . E.dimensionArray foldl' (E.encodingArray . E.int4_int32) decoder =- D.array $- D.dimensionArray replicateM $- D.valueArray $- (D.int :: D.Value Int32)+ D.array+ $ D.dimensionArray replicateM+ $ D.valueArray+ $ (D.int :: D.Value Int32) in b "array" decoder (E.encodingBytes (encoder [1, 2, 3, 4])) ] where
encoding/Main.hs view
@@ -5,6 +5,7 @@ import qualified PostgreSQL.Binary.Encoding as E import Prelude +main :: IO () main = defaultMain [ value "bool" E.bool True,
library/PostgreSQL/Binary/Decoding.hs view
@@ -76,7 +76,7 @@ import qualified PostgreSQL.Binary.Integral as Integral import qualified PostgreSQL.Binary.Interval as Interval import qualified PostgreSQL.Binary.Numeric as Numeric-import PostgreSQL.Binary.Prelude hiding (bool, drop, fail, failure, state, take)+import PostgreSQL.Binary.Prelude hiding (bool, drop, fail, state, take) import qualified PostgreSQL.Binary.Time as Time type Value =@@ -106,13 +106,6 @@ size = intOfSize 4 :: Value Int32 -{-# INLINEABLE content #-}-content :: Value (Maybe ByteString)-content =- intOfSize 4 >>= \case- (-1) -> pure Nothing- n -> fmap Just (bytesOfSize n)- {-# INLINE nonNull #-} nonNull :: Maybe a -> Value a nonNull =@@ -179,15 +172,15 @@ isCidr <- intOfSize 1 ipSize <- intOfSize 1 if- | af == Inet.inetAddressFamily ->- do- ip <- ip4- return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv4 ip)- | af == Inet.inet6AddressFamily ->- do- ip <- ip6- return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv6 ip)- | otherwise -> BinaryParser.failure ("Unknown address family: " <> fromString (show af))+ | af == Inet.inetAddressFamily ->+ do+ ip <- ip4+ return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv4 ip)+ | af == Inet.inet6AddressFamily ->+ do+ ip <- ip6+ return $ inetFromBytes af netmask isCidr ipSize (IPAddr.IPv6 ip)+ | otherwise -> BinaryParser.failure ("Unknown address family: " <> fromString (show af)) where inetFromBytes :: Word8 -> Word8 -> Word8 -> Int8 -> IPAddr.IP -> IPAddr.NetAddr IPAddr.IP inetFromBytes _ netmask _ _ ip = IPAddr.netAddr ip netmask@@ -396,7 +389,7 @@ -- hstore replicateM text text -- @ {-# INLINEABLE hstore #-}-hstore :: (forall m. Monad m => Int -> m (k, Maybe v) -> m r) -> Value k -> Value v -> Value r+hstore :: (forall m. (Monad m) => Int -> m (k, Maybe v) -> m r) -> Value k -> Value v -> Value r hstore replicateM keyContent valueContent = do componentsAmount <- intOfSize 4@@ -492,7 +485,7 @@ -- -- * A decoder of its components, which can be either another 'dimensionArray' or 'nullableValueArray'. {-# INLINE dimensionArray #-}-dimensionArray :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b+dimensionArray :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b dimensionArray replicateM (Array component) = Array $ \case head : tail -> replicateM (fromIntegral head) (component tail)
library/PostgreSQL/Binary/Encoding.hs view
@@ -69,10 +69,8 @@ import qualified ByteString.StrictBuilder as C import qualified Data.Aeson as R-import qualified Data.ByteString.Builder as M import qualified Data.ByteString.Lazy as N import qualified Data.Text.Lazy as L-import qualified Data.Vector as A import qualified Network.IP.Addr as G import qualified PostgreSQL.Binary.Encoding.Builders as B import PostgreSQL.Binary.Prelude hiding (bool, length)@@ -104,7 +102,7 @@ -- A helper for encoding of arrays of single dimension from foldables. -- The first parameter is OID of the element type. {-# INLINE array_foldable #-}-array_foldable :: Foldable foldable => Word32 -> (element -> Maybe Encoding) -> foldable element -> Encoding+array_foldable :: (Foldable foldable) => Word32 -> (element -> Maybe Encoding) -> foldable element -> Encoding array_foldable oid elementBuilder = array oid . dimensionArray foldl' (maybe nullArray encodingArray . elementBuilder) @@ -127,7 +125,7 @@ -- | -- A polymorphic @HSTORE@ encoder. {-# INLINE hStore_foldable #-}-hStore_foldable :: Foldable foldable => foldable (Text, Maybe Text) -> Encoding+hStore_foldable :: (Foldable foldable) => foldable (Text, Maybe Text) -> Encoding hStore_foldable = B.hStoreUsingFoldl foldl @@ -231,11 +229,6 @@ bytea_lazy :: N.ByteString -> Encoding bytea_lazy = B.bytea_lazy--{-# INLINE bytea_lazyBuilder #-}-bytea_lazyBuilder :: M.Builder -> Encoding-bytea_lazyBuilder =- B.bytea_lazyBuilder {-# INLINE date #-} date :: Day -> Encoding
library/PostgreSQL/Binary/Encoding/Builders.hs view
@@ -170,7 +170,10 @@ ip6 x = case G.ip6ToWords x of (w1, w2, w3, w4, w5, w6, w7, w8) ->- int2_word16 w1 <> int2_word16 w2 <> int2_word16 w3 <> int2_word16 w4+ int2_word16 w1+ <> int2_word16 w2+ <> int2_word16 w3+ <> int2_word16 w4 <> int2_word16 w5 <> int2_word16 w6 <> int2_word16 w7@@ -309,8 +312,8 @@ <> int32BE m where P.Interval u d m =- fromMaybe (error ("Too large DiffTime value for an interval " <> show x)) $- P.fromDiffTime x+ fromMaybe (error ("Too large DiffTime value for an interval " <> show x))+ $ P.fromDiffTime x {-# INLINEABLE interval_float #-} interval_float :: DiffTime -> Builder@@ -320,8 +323,8 @@ <> int32BE m where P.Interval u d m =- fromMaybe (error ("Too large DiffTime value for an interval " <> show x)) $- P.fromDiffTime x+ fromMaybe (error ("Too large DiffTime value for an interval " <> show x))+ $ P.fromDiffTime x s = fromIntegral u / (10 ^ 6) @@ -424,12 +427,12 @@ int4_int count <> payload {-# INLINE hStoreUsingFoldMapAndSize #-}-hStoreUsingFoldMapAndSize :: (forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a) -> Int -> b -> Builder+hStoreUsingFoldMapAndSize :: (forall a. (Monoid a) => ((Text, Maybe Text) -> a) -> b -> a) -> Int -> b -> Builder hStoreUsingFoldMapAndSize foldMap size input = int4_int size <> foldMap (uncurry hStoreRow) input {-# INLINE hStoreFromFoldMapAndSize #-}-hStoreFromFoldMapAndSize :: (forall a. Monoid a => (Text -> Maybe Text -> a) -> a) -> Int -> Builder+hStoreFromFoldMapAndSize :: (forall a. (Monoid a) => (Text -> Maybe Text -> a) -> a) -> Int -> Builder hStoreFromFoldMapAndSize foldMap size = int4_int size <> foldMap hStoreRow
library/PostgreSQL/Binary/Interval.hs view
@@ -14,9 +14,11 @@ -- 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 unpredictably after a smaller limit.-maxDiffTime :: DiffTime = 1780000 * Time.microsToDiffTime Time.yearMicros+maxDiffTime :: DiffTime+maxDiffTime = 1780000 * Time.microsToDiffTime Time.yearMicros -minDiffTime :: DiffTime = negate maxDiffTime+minDiffTime :: DiffTime+minDiffTime = negate maxDiffTime fromDiffTime :: DiffTime -> Maybe Interval fromDiffTime x =@@ -35,8 +37,13 @@ toDiffTime :: Interval -> DiffTime toDiffTime x =- picosecondsToDiffTime $- (10 ^ 6)- * ( fromIntegral (micros x)- + 10 ^ 6 * 60 * 60 * 24 * (fromIntegral (days x + 31 * months x))- )+ picosecondsToDiffTime+ $ (10 ^ 6)+ * ( fromIntegral (micros x)+ + 10+ ^ 6+ * 60+ * 60+ * 24+ * (fromIntegral (days x + 31 * months x))+ )
library/PostgreSQL/Binary/Numeric.hs view
@@ -17,7 +17,7 @@ nanSignCode = 0xC000 {-# INLINE extractComponents #-}-extractComponents :: Integral a => a -> [Word16]+extractComponents :: (Integral a) => a -> [Word16] extractComponents = (reverse .) . (. abs) . unfoldr $ \case 0 -> Nothing@@ -25,12 +25,12 @@ (d, m) -> Just (fromIntegral m, d) {-# INLINE mergeComponents #-}-mergeComponents :: Integral a => Vector a -> Integer+mergeComponents :: (Integral a) => Vector a -> Integer mergeComponents = Vector.foldl' (\l r -> l * 10000 + fromIntegral r) 0 {-# INLINE mergeDigits #-}-mergeDigits :: Integral a => Vector a -> a+mergeDigits :: (Integral a) => Vector a -> a mergeDigits = Vector.foldl' (\l r -> l * 10 + r) 0 @@ -55,7 +55,7 @@ liftA2 (+) (fmap (* 10000) acc) component {-# INLINE signer #-}-signer :: Integral a => Word16 -> Either Text (a -> a)+signer :: (Integral a) => Word16 -> Either Text (a -> a) signer = \case 0x0000 -> return id
library/PostgreSQL/Binary/Prelude.hs view
@@ -37,7 +37,7 @@ import Data.Fixed as Exports import Data.Foldable as Exports import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports+import Data.Functor as Exports hiding (unzip) import Data.Functor.Identity as Exports import Data.HashMap.Strict as Exports (HashMap) import Data.IORef as Exports@@ -85,8 +85,6 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec) import Text.Printf as Exports (hPrintf, printf) import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports@@ -109,6 +107,6 @@ mapLeft f = either (Left . f) Right -joinMap :: Monad m => (a -> m b) -> m a -> m b+joinMap :: (Monad m) => (a -> m b) -> m a -> m b joinMap f = join . liftM f
library/PostgreSQL/Binary/Time.hs view
@@ -1,6 +1,5 @@ module PostgreSQL.Binary.Time where -import Data.Time.Calendar.Julian import PostgreSQL.Binary.Prelude hiding (second) {-# INLINEABLE dayToPostgresJulian #-}@@ -9,7 +8,7 @@ (+ (2400001 - 2451545)) . toModifiedJulianDay {-# INLINEABLE postgresJulianToDay #-}-postgresJulianToDay :: Integral a => a -> Day+postgresJulianToDay :: (Integral a) => a -> Day postgresJulianToDay = ModifiedJulianDay . fromIntegral . subtract (2400001 - 2451545) @@ -20,8 +19,8 @@ h <- state $ flip divMod $ 10 ^ 6 * 60 * 60 m <- state $ flip divMod $ 10 ^ 6 * 60 u <- get- return $- TimeOfDay (fromIntegral h) (fromIntegral m) (microsToPico u)+ return+ $ TimeOfDay (fromIntegral h) (fromIntegral m) (microsToPico u) {-# INLINEABLE microsToUTC #-} microsToUTC :: Int64 -> UTCTime@@ -29,8 +28,8 @@ evalState $ do d <- state $ flip divMod $ 10 ^ 6 * 60 * 60 * 24 u <- get- return $- UTCTime (postgresJulianToDay d) (microsToDiffTime u)+ return+ $ UTCTime (postgresJulianToDay d) (microsToDiffTime u) {-# INLINEABLE microsToPico #-} microsToPico :: Int64 -> Pico@@ -48,8 +47,8 @@ evalState $ do d <- state $ flip divMod $ 10 ^ 6 * 60 * 60 * 24 u <- get- return $- LocalTime (postgresJulianToDay d) (microsToTimeOfDay u)+ return+ $ LocalTime (postgresJulianToDay d) (microsToTimeOfDay u) {-# INLINEABLE secsToTimeOfDay #-} secsToTimeOfDay :: Double -> TimeOfDay@@ -58,8 +57,8 @@ h <- state $ flip divMod' $ 60 * 60 m <- state $ flip divMod' $ 60 s <- get- return $- TimeOfDay (fromIntegral h) (fromIntegral m) (secsToPico s)+ return+ $ TimeOfDay (fromIntegral h) (fromIntegral m) (secsToPico s) {-# INLINEABLE secsToUTC #-} secsToUTC :: Double -> UTCTime@@ -67,8 +66,8 @@ evalState $ do d <- state $ flip divMod' $ 60 * 60 * 24 s <- get- return $- UTCTime (postgresJulianToDay d) (secsToDiffTime s)+ return+ $ UTCTime (postgresJulianToDay d) (secsToDiffTime s) {-# INLINEABLE secsToLocalTime #-} secsToLocalTime :: Double -> LocalTime@@ -76,8 +75,8 @@ evalState $ do d <- state $ flip divMod' $ 60 * 60 * 24 s <- get- return $- LocalTime (postgresJulianToDay d) (secsToTimeOfDay s)+ return+ $ LocalTime (postgresJulianToDay d) (secsToTimeOfDay s) {-# INLINEABLE secsToPico #-} secsToPico :: Double -> Pico@@ -123,12 +122,17 @@ -- http://www.postgresql.org/docs/9.1/static/datatype-datetime.html -- Postgres uses Julian dates internally -yearMicros :: Int64 = truncate (365.2425 * fromIntegral dayMicros :: Rational)+yearMicros :: Int64+yearMicros = truncate (365.2425 * fromIntegral dayMicros :: Rational) -dayMicros :: Int64 = 24 * hourMicros+dayMicros :: Int64+dayMicros = 24 * hourMicros -hourMicros :: Int64 = 60 * minuteMicros+hourMicros :: Int64+hourMicros = 60 * minuteMicros -minuteMicros :: Int64 = 60 * secondMicros+minuteMicros :: Int64+minuteMicros = 60 * secondMicros -secondMicros :: Int64 = 10 ^ 6+secondMicros :: Int64+secondMicros = 10 ^ 6
postgresql-binary.cabal view
@@ -1,9 +1,7 @@-name:- postgresql-binary-version:- 0.13.1-synopsis:- Encoders and decoders for the PostgreSQL's binary format+cabal-version: 3.0+name: postgresql-binary+version: 0.13.1.1+synopsis: Encoders and decoders for the PostgreSQL's binary format description: An API for dealing with PostgreSQL's binary data format. .@@ -14,144 +12,140 @@ It supports all Postgres versions starting from 8.3 and is tested against 8.3, 9.3 and 9.5 with the @integer_datetimes@ setting off and on.-category:- PostgreSQL, Database, Codecs, Parsing-homepage:- https://github.com/nikita-volkov/postgresql-binary -bug-reports:- https://github.com/nikita-volkov/postgresql-binary/issues -author:- Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:- Nikita Volkov <nikita.y.volkov@mail.ru>-copyright:- (c) 2014, Nikita Volkov-license:- MIT-license-file:- LICENSE-build-type:- Simple-cabal-version:- >=1.10-extra-source-files:- CHANGELOG.md +category: PostgreSQL, Database, Codecs, Parsing+homepage: https://github.com/nikita-volkov/postgresql-binary +bug-reports: https://github.com/nikita-volkov/postgresql-binary/issues +author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2014, Nikita Volkov+license: MIT+license-file: LICENSE+extra-source-files: CHANGELOG.md+ source-repository head- type:- git- location:- git://github.com/nikita-volkov/postgresql-binary.git+ type: git+ location: git://github.com/nikita-volkov/postgresql-binary.git -library- hs-source-dirs:- library- ghc-options:- -funbox-strict-fields+common base+ default-language: Haskell2010 default-extensions:- 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+ NoImplicitPrelude+ NoMonomorphismRestriction+ Arrows+ BangPatterns+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveDataTypeable+ DeriveFunctor+ DeriveGeneric+ EmptyDataDecls+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ LiberalTypeSynonyms+ MagicHash+ MultiParamTypeClasses+ MultiWayIf+ OverloadedStrings+ ParallelListComp+ PatternGuards+ QuasiQuotes+ RankNTypes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TupleSections+ TypeFamilies+ TypeOperators+ UnboxedTuples++library+ import: base+ hs-source-dirs: library+ ghc-options: -funbox-strict-fields exposed-modules: PostgreSQL.Binary.Decoding PostgreSQL.Binary.Encoding+ other-modules:+ PostgreSQL.Binary.BuilderPrim PostgreSQL.Binary.Encoding.Builders- PostgreSQL.Binary.Prelude+ PostgreSQL.Binary.Inet PostgreSQL.Binary.Integral PostgreSQL.Binary.Interval PostgreSQL.Binary.Numeric+ PostgreSQL.Binary.Prelude PostgreSQL.Binary.Time- PostgreSQL.Binary.Inet- PostgreSQL.Binary.BuilderPrim+ build-depends:- aeson >=2 && <3,- base >=4.12 && <5,- binary-parser >=0.5.7 && <0.6,- bytestring >=0.10.4 && <0.12,- bytestring-strict-builder >=0.4.5.4 && <0.5,- containers >=0.5 && <0.7,- network-ip >=0.3 && <0.4,- scientific >=0.3 && <0.4,- text >=1.2 && <3,- time >=1.9 && <2,- transformers >=0.3 && <0.7,- unordered-containers ==0.2.*,- uuid ==1.3.*,- vector >=0.12 && <0.14+ , aeson >=2 && <3+ , base >=4.12 && <5+ , binary-parser >=0.5.7 && <0.6+ , bytestring >=0.10.4 && <0.12+ , bytestring-strict-builder >=0.4.5.4 && <0.5+ , containers >=0.5 && <0.7+ , network-ip >=0.3 && <0.4+ , scientific >=0.3 && <0.4+ , text >=1.2 && <3+ , time >=1.9 && <2+ , transformers >=0.3 && <0.7+ , unordered-containers >=0.2 && <0.3+ , uuid >=1.3 && <1.4+ , vector >=0.12 && <0.14 -- This test-suite must be executed in a single-thread. test-suite tasty- type:- exitcode-stdio-1.0- hs-source-dirs:- tasty- main-is:- Main.hs+ import: base+ type: exitcode-stdio-1.0+ hs-source-dirs: tasty+ main-is: Main.hs other-modules:- Main.Composite - Main.TextEncoder- Main.DB Main.Apx- Main.IO+ Main.Composite+ Main.DB Main.Gens- Main.PTI- Main.Properties+ Main.IO Main.Prelude- default-extensions:- 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+ Main.Properties+ Main.PTI+ Main.TextEncoder+ build-depends:- aeson >=2 && <3,- network-ip >=0.2 && <1,- postgresql-binary,- postgresql-libpq ==0.9.*,- QuickCheck >=2.10 && <3,- quickcheck-instances >=0.3.22 && <0.4,- rerebase >=1.10.0.1 && <2,- tasty >=1.4 && <2,- tasty-hunit >=0.10 && <0.11,- tasty-quickcheck >=0.10 && <0.11+ , aeson >=2 && <3+ , network-ip >=0.2 && <1+ , postgresql-binary+ , postgresql-libpq >=0.9 && <0.10+ , QuickCheck >=2.10 && <3+ , quickcheck-instances >=0.3.22 && <0.4+ , rerebase >=1.20.1.1 && <2+ , tasty >=1.4 && <2+ , tasty-hunit >=0.10 && <0.11+ , tasty-quickcheck >=0.10 && <0.11 benchmark encoding- type: - exitcode-stdio-1.0- hs-source-dirs:- encoding- main-is:- Main.hs- ghc-options:- -O2- -threaded- "-with-rtsopts=-N"- -funbox-strict-fields- default-extensions:- 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+ import: base+ type: exitcode-stdio-1.0+ hs-source-dirs: encoding+ main-is: Main.hs+ ghc-options: -O2 -threaded -with-rtsopts=-N -funbox-strict-fields build-depends:- criterion >=1.5.9 && <2,- postgresql-binary,- rerebase >=1.10.0.1 && <2+ , criterion >=1.5.9 && <2+ , postgresql-binary+ , rerebase >=1.20.1.1 && <2 benchmark decoding- type: - exitcode-stdio-1.0- hs-source-dirs:- decoding- main-is:- Main.hs- ghc-options:- -O2- -threaded- "-with-rtsopts=-N"- -funbox-strict-fields- default-extensions:- 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+ import: base+ type: exitcode-stdio-1.0+ hs-source-dirs: decoding+ main-is: Main.hs+ ghc-options: -O2 -threaded -with-rtsopts=-N -funbox-strict-fields build-depends:- criterion >=1.5.9 && <2,- postgresql-binary,- rerebase >=1.10.0.1 && <2+ , criterion >=1.5.9 && <2+ , postgresql-binary+ , rerebase >=1.20.1.1 && <2
tasty/Main.hs view
@@ -1,7 +1,5 @@ module Main where -import Control.Monad.IO.Class-import qualified Data.ByteString as ByteString import qualified Data.Text.Lazy as TextLazy import qualified Database.PostgreSQL.LibPQ as LibPQ import Main.Apx (Apx (..))@@ -10,20 +8,20 @@ import qualified Main.Gens as Gens import qualified Main.IO as IO import qualified Main.PTI as PTI-import Main.Prelude hiding (assert, isLeft, isRight, select)+import Main.Prelude hiding (isLeft, isRight, select) import qualified Main.Properties as Properties import qualified Main.TextEncoder as TextEncoder import qualified PostgreSQL.Binary.Decoding as B import qualified PostgreSQL.Binary.Encoding as A-import qualified Test.QuickCheck as QuickCheck-import Test.QuickCheck.Instances import Test.Tasty import Test.Tasty.HUnit as HUnit import Test.Tasty.QuickCheck as QuickCheck +main :: IO () main = defaultMain (testGroup "" [binary, textual]) +binary :: TestTree binary = testGroup "Binary format" testList where@@ -62,17 +60,17 @@ "SELECT '10 seconds' :: interval" (bool B.interval_float B.interval_int) (10 :: DiffTime),- HUnit.testCase "Interval encoder: 10 seconds" $- let pti =- PTI.interval- encoder integerDatetimes =- (bool A.interval_float A.interval_int integerDatetimes)- decoder =- (bool B.interval_float B.interval_int)- value =- (10 :: DiffTime)- in HUnit.assertEqual "" (Right value)- =<< IO.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder value,+ HUnit.testCase "Interval encoder: 10 seconds"+ $ let pti =+ PTI.interval+ encoder integerDatetimes =+ (bool A.interval_float A.interval_int integerDatetimes)+ decoder =+ (bool B.interval_float B.interval_int)+ value =+ (10 :: DiffTime)+ in HUnit.assertEqual "" (Right value)+ =<< IO.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder value, timeRoundtrip "interval" Gens.intervalDiffTime@@ -147,27 +145,28 @@ primitiveRoundtrip "bool" Gens.auto PTI.bool A.bool B.bool, primitiveRoundtrip "date" Gens.auto PTI.date A.date B.date, let decoder =- B.array $- B.dimensionArray replicateM $- B.dimensionArray replicateM $- B.valueArray $- B.int+ B.array+ $ B.dimensionArray replicateM+ $ B.dimensionArray replicateM+ $ B.valueArray+ $ B.int in select "SELECT ARRAY[ARRAY[1,2],ARRAY[3,4]]" (const decoder) ([[1, 2], [3, 4]] :: [[Int]]), let encoder = A.array (PTI.oidWord32 (PTI.ptiOID PTI.int8)) . arrayEncoder where arrayEncoder =- A.dimensionArray foldl' $- A.dimensionArray foldl' $- A.dimensionArray foldl' $- A.encodingArray . A.int8_int64+ A.dimensionArray foldl'+ $ A.dimensionArray foldl'+ $ A.dimensionArray foldl'+ $ A.encodingArray+ . A.int8_int64 decoder =- B.array $- B.dimensionArray replicateM $- B.dimensionArray replicateM $- B.dimensionArray replicateM $- B.valueArray $- B.int+ B.array+ $ B.dimensionArray replicateM+ $ B.dimensionArray replicateM+ $ B.dimensionArray replicateM+ $ B.valueArray+ $ B.int in arrayCodec (Gens.array3 Gens.auto) encoder decoder, let pti = PTI.text@@ -175,47 +174,53 @@ A.array (PTI.oidWord32 (PTI.ptiOID pti)) . arrayEncoder where arrayEncoder =- A.dimensionArray foldl' $- A.dimensionArray foldl' $- A.dimensionArray foldl' $- A.encodingArray . A.text_strict+ A.dimensionArray foldl'+ $ A.dimensionArray foldl'+ $ A.dimensionArray foldl'+ $ A.encodingArray+ . A.text_strict decoder =- B.array $- B.dimensionArray replicateM $- B.dimensionArray replicateM $- B.dimensionArray replicateM $- B.valueArray $- B.text_strict+ B.array+ $ B.dimensionArray replicateM+ $ B.dimensionArray replicateM+ $ B.dimensionArray replicateM+ $ B.valueArray+ $ B.text_strict in arrayRoundtrip (Gens.array3 Gens.text) pti encoder decoder ] +textual :: TestTree textual =- testGroup "Textual format" $- [ test "numeric" Gens.scientific PTI.numeric TextEncoder.numeric (const B.numeric),- test "float4" Gens.auto PTI.float4 TextEncoder.float4 (const B.float4),- test "float8" Gens.auto PTI.float8 TextEncoder.float8 (const B.float8),- test "uuid" Gens.uuid PTI.uuid TextEncoder.uuid (const B.uuid),- test "int2_int16" Gens.auto PTI.int2 TextEncoder.int2_int16 (const B.int),- test "int2_word16" Gens.postgresInt PTI.int2 TextEncoder.int2_word16 (const B.int),- test "int4_int32" Gens.auto PTI.int4 TextEncoder.int4_int32 (const B.int),- test "int4_word32" Gens.postgresInt PTI.int4 TextEncoder.int4_word32 (const B.int),- test "int8_int64" Gens.auto PTI.int8 TextEncoder.int8_int64 (const B.int),- test "int8_word64" Gens.postgresInt PTI.int8 TextEncoder.int8_word64 (const B.int),- test "bool" Gens.auto PTI.bool TextEncoder.bool (const B.bool)- ]+ testGroup "Textual format"+ $ [ test "numeric" Gens.scientific PTI.numeric TextEncoder.numeric (const B.numeric),+ test "float4" Gens.auto PTI.float4 TextEncoder.float4 (const B.float4),+ test "float8" Gens.auto PTI.float8 TextEncoder.float8 (const B.float8),+ test "uuid" Gens.uuid PTI.uuid TextEncoder.uuid (const B.uuid),+ test "int2_int16" Gens.auto PTI.int2 TextEncoder.int2_int16 (const B.int),+ test "int2_word16" Gens.postgresInt PTI.int2 TextEncoder.int2_word16 (const B.int),+ test "int4_int32" Gens.auto PTI.int4 TextEncoder.int4_int32 (const B.int),+ test "int4_word32" Gens.postgresInt PTI.int4 TextEncoder.int4_word32 (const B.int),+ test "int8_int64" Gens.auto PTI.int8 TextEncoder.int8_int64 (const B.int),+ test "int8_word64" Gens.postgresInt PTI.int8 TextEncoder.int8_word64 (const B.int),+ test "bool" Gens.auto PTI.bool TextEncoder.bool (const B.bool)+ ] where test typeName gen pti encoder decoder =- QuickCheck.testProperty (typeName <> " roundtrip") $- QuickCheck.forAll gen $ Properties.textRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder+ QuickCheck.testProperty (typeName <> " roundtrip")+ $ QuickCheck.forAll gen+ $ Properties.textRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder +arrayCodec :: (Show t, Eq t) => Gen t -> (t -> A.Encoding) -> B.Value t -> TestTree arrayCodec gen encoder decoder =- QuickCheck.testProperty ("Array codec") $- QuickCheck.forAll gen $- \value -> (QuickCheck.===) (Right value) (B.valueParser decoder ((A.encodingBytes . encoder) value))+ QuickCheck.testProperty ("Array codec")+ $ QuickCheck.forAll gen+ $ \value -> (QuickCheck.===) (Right value) (B.valueParser decoder ((A.encodingBytes . encoder) value)) +arrayRoundtrip :: (Show a, Eq a) => Gen a -> PTI.PTI -> (a -> A.Encoding) -> B.Value a -> TestTree arrayRoundtrip gen pti encoder decoder =- QuickCheck.testProperty ("Array roundtrip") $- QuickCheck.forAll gen $ Properties.stdRoundtrip (PTI.oidPQ (fromJust (PTI.ptiArrayOID pti))) encoder decoder+ QuickCheck.testProperty ("Array roundtrip")+ $ QuickCheck.forAll gen+ $ Properties.stdRoundtrip (PTI.oidPQ (fromJust (PTI.ptiArrayOID pti))) encoder decoder stdRoundtrip :: (Eq a, Show a) =>@@ -226,25 +231,31 @@ B.Value a -> TestTree stdRoundtrip typeName gen pti encoder decoder =- QuickCheck.testProperty (typeName <> " roundtrip") $- QuickCheck.forAll gen $ Properties.stdRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder+ QuickCheck.testProperty (typeName <> " roundtrip")+ $ QuickCheck.forAll gen+ $ Properties.stdRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder +primitiveRoundtrip :: (Eq a, Show a) => TestName -> Gen a -> PTI.PTI -> (a -> A.Encoding) -> B.Value a -> TestTree primitiveRoundtrip typeName gen pti encoder decoder = stdRoundtrip typeName gen pti (encoder) decoder +timeRoundtrip :: (Show a, Eq a) => TestName -> Gen a -> PTI.PTI -> (Bool -> a -> A.Encoding) -> (Bool -> B.Value a) -> TestTree timeRoundtrip typeName gen pti encoder decoder =- QuickCheck.testProperty (typeName <> " roundtrip") $- QuickCheck.forAll gen $ Properties.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) (\x -> encoder x) decoder+ QuickCheck.testProperty (typeName <> " roundtrip")+ $ QuickCheck.forAll gen+ $ Properties.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) (\x -> encoder x) decoder +select :: (Eq b, Show b) => ByteString -> (Bool -> B.Value b) -> b -> TestTree select statement decoder value =- HUnit.testCase (show statement) $- HUnit.assertEqual "" (Right value) $- unsafePerformIO $ IO.parameterlessStatement statement decoder value+ HUnit.testCase (show statement)+ $ HUnit.assertEqual "" (Right value)+ $ unsafePerformIO+ $ IO.parameterlessStatement statement decoder value {-# NOINLINE version #-} version :: Int version =- either (error . show) id $- unsafePerformIO $- DB.session $- DB.serverVersion+ either (error . show) id+ $ unsafePerformIO+ $ DB.session+ $ DB.serverVersion
tasty/Main/Apx.hs view
@@ -10,8 +10,10 @@ instance (Eq (Apx a), Eq (Apx b)) => Eq (Apx (a, b)) where (==) (Apx (a1, a2)) (Apx (b1, b2)) =- Apx a1 == Apx b1- && Apx a2 == Apx b2+ Apx a1+ == Apx b1+ && Apx a2+ == Apx b2 instance Eq (Apx LocalTime) where (==) (Apx a) (Apx b) =@@ -38,8 +40,12 @@ instance Eq (Apx Rational) where (==) (Apx a) (Apx b) =- a + error >= b- && a - error <= b+ a+ + error+ >= b+ && a+ - error+ <= b where error = 10 ^^ negate 3
tasty/Main/Composite.hs view
@@ -1,20 +1,12 @@ module Main.Composite where import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Key as AesonKey-import qualified Data.Aeson.KeyMap as AesonKeyMap-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Scientific as Scientific import qualified Data.Text as Text-import qualified Data.UUID as UUID-import qualified Data.Vector as Vector import qualified Main.Gens as Gens-import Main.Prelude hiding (assert, choose, isLeft, isRight)-import qualified Network.IP.Addr as IPAddr+import Main.Prelude hiding (choose, isLeft, isRight) import qualified PostgreSQL.Binary.Decoding as Decoding import qualified PostgreSQL.Binary.Encoding as Encoding import Test.QuickCheck hiding (vector)-import Test.QuickCheck.Instances newtype Composite = Composite [CompositeFieldValue] deriving (Show, Eq, Ord)
tasty/Main/DB.hs view
@@ -9,7 +9,6 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader-import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Database.PostgreSQL.LibPQ as LibPQ import Main.Prelude hiding (unit)@@ -46,8 +45,9 @@ checkResult :: Maybe LibPQ.Result -> Session () checkResult result =- ExceptT $- ReaderT $ \connection -> do+ ExceptT+ $ ReaderT+ $ \connection -> do case result of Just result -> do LibPQ.resultErrorField result LibPQ.DiagMessagePrimary >>= maybe (return (Right ())) (return . Left)@@ -81,19 +81,19 @@ host = "localhost" port = 5432 user = "postgres"- password = ""+ password = "postgres" db = "postgres" initConnection :: LibPQ.Connection -> IO () initConnection c =- void $- LibPQ.exec c $- mconcat $- map (<> ";") $- [ "SET client_min_messages TO WARNING",- "SET client_encoding = 'UTF8'",- "SET intervalstyle = 'postgres'"- ]+ void+ $ LibPQ.exec c+ $ mconcat+ $ map (<> ";")+ $ [ "SET client_min_messages TO WARNING",+ "SET client_encoding = 'UTF8'",+ "SET intervalstyle = 'postgres'"+ ] getIntegerDatetimes :: LibPQ.Connection -> IO Bool getIntegerDatetimes c =
tasty/Main/Gens.hs view
@@ -8,12 +8,9 @@ import qualified Data.Text as Text import qualified Data.UUID as UUID import qualified Data.Vector as Vector-import qualified Main.PTI as PTI-import Main.Prelude hiding (assert, choose, isLeft, isRight)+import Main.Prelude hiding (choose, isLeft, isRight) import qualified Network.IP.Addr as IPAddr-import qualified PostgreSQL.Binary.Encoding as Encoder import Test.QuickCheck hiding (vector)-import Test.QuickCheck.Instances maybeOf :: Gen a -> Gen (Maybe a) maybeOf gen =@@ -21,7 +18,7 @@ -- * Generators -auto :: Arbitrary a => Gen a+auto :: (Arbitrary a) => Gen a auto = arbitrary @@ -29,7 +26,7 @@ vector element = join $ Vector.replicateM <$> arbitrary <*> pure element -hashMap :: (Eq a, Hashable a) => Gen a -> Gen b -> Gen (HashMap a b)+hashMap :: (Hashable a) => Gen a -> Gen b -> Gen (HashMap a b) hashMap key value = fmap HashMap.fromList $ join $ replicateM <$> arbitrary <*> pure row where@@ -76,7 +73,7 @@ value = byDepth (succ depth) -postgresInt :: (Bounded a, Ord a, Integral a, Arbitrary a) => Gen a+postgresInt :: (Bounded a, Integral a, Arbitrary a) => Gen a postgresInt = arbitrary >>= \x -> if x > halfMaxBound then postgresInt else pure x where@@ -97,10 +94,10 @@ microsTimeOfDay :: Gen TimeOfDay microsTimeOfDay =- fmap timeToTimeOfDay $- fmap picosecondsToDiffTime $- fmap (* (10 ^ 6)) $- choose (0, (10 ^ 6) * 24 * 60 * 60)+ fmap timeToTimeOfDay+ $ fmap picosecondsToDiffTime+ $ fmap (* (10 ^ 6))+ $ choose (0, (10 ^ 6) * 24 * 60 * 60) microsLocalTime :: Gen LocalTime microsLocalTime =@@ -137,7 +134,14 @@ IPAddr.netAddr <$> ( IPAddr.IPv6 <$> ( IPAddr.ip6FromWords- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary ) ) <*> choose (0, 128)@@ -153,9 +157,11 @@ -- * Constants -maxInterval :: DiffTime =- unsafeCoerce $- (truncate (1780000 * 365.2425 * 24 * 60 * 60 * 10 ^ 12 :: Rational) :: Integer)+maxInterval :: DiffTime+maxInterval =+ unsafeCoerce+ $ (truncate (1780000 * 365.2425 * 24 * 60 * 60 * 10 ^ 12 :: Rational) :: Integer) -minInterval :: DiffTime =+minInterval :: DiffTime+minInterval = negate maxInterval
tasty/Main/IO.hs view
@@ -4,24 +4,19 @@ import qualified Data.ByteString.Builder as ByteStringBuilder import qualified Data.ByteString.Lazy as ByteStringLazy-import qualified Data.Scientific as Scientific import qualified Data.Text.Encoding as Text-import qualified Data.UUID as UUID-import qualified Data.Vector as Vector import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Main.DB as DB-import qualified Main.PTI as PTI-import Main.Prelude hiding (assert, isLeft, isRight)+import Main.Prelude hiding (isLeft, isRight) import qualified Main.TextEncoder as TextEncoder import qualified PostgreSQL.Binary.Decoding as A import qualified PostgreSQL.Binary.Encoding as B-import Test.QuickCheck-import Test.QuickCheck.Instances textRoundtrip :: LibPQ.Oid -> TextEncoder.Encoder a -> (Bool -> A.Value a) -> a -> IO (Either Text a) textRoundtrip oid encoder decoder value =- fmap (either (Left . Text.decodeUtf8) id) $- DB.session $ do+ fmap (either (Left . Text.decodeUtf8) id)+ $ DB.session+ $ do integerDatetimes <- DB.integerDatetimes bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) LibPQ.Binary return $ A.valueParser (decoder integerDatetimes) bytes@@ -34,8 +29,9 @@ roundtrip :: LibPQ.Oid -> (Bool -> a -> B.Encoding) -> (Bool -> A.Value b) -> a -> IO (Either Text b) roundtrip oid encoder decoder value =- fmap (either (Left . Text.decodeUtf8) id) $- DB.session $ do+ fmap (either (Left . Text.decodeUtf8) id)+ $ DB.session+ $ do integerDatetimes <- DB.integerDatetimes bytes <- DB.oneRow "SELECT $1" (params integerDatetimes) LibPQ.Binary return $ A.valueParser (decoder integerDatetimes) bytes@@ -48,8 +44,9 @@ parameterlessStatement :: ByteString -> (Bool -> A.Value a) -> a -> IO (Either Text a) parameterlessStatement statement decoder value =- fmap (either (Left . Text.decodeUtf8) id) $- DB.session $ do+ fmap (either (Left . Text.decodeUtf8) id)+ $ DB.session+ $ do integerDatetimes <- DB.integerDatetimes bytes <- DB.oneRow statement [] LibPQ.Binary return $ A.valueParser (decoder integerDatetimes) bytes
tasty/Main/PTI.hs view
@@ -19,140 +19,209 @@ -- * Constants +abstime :: PTI abstime = mkPTI 702 (Just 1023) +aclitem :: PTI aclitem = mkPTI 1033 (Just 1034) +bit :: PTI bit = mkPTI 1560 (Just 1561) +bool :: PTI bool = mkPTI 16 (Just 1000) +box :: PTI box = mkPTI 603 (Just 1020) +bpchar :: PTI bpchar = mkPTI 1042 (Just 1014) +bytea :: PTI bytea = mkPTI 17 (Just 1001) +char :: PTI char = mkPTI 18 (Just 1002) +cid :: PTI cid = mkPTI 29 (Just 1012) +cidr :: PTI cidr = mkPTI 650 (Just 651) +circle :: PTI circle = mkPTI 718 (Just 719) +cstring :: PTI cstring = mkPTI 2275 (Just 1263) +date :: PTI date = mkPTI 1082 (Just 1182) +daterange :: PTI daterange = mkPTI 3912 (Just 3913) +float4 :: PTI float4 = mkPTI 700 (Just 1021) +float8 :: PTI float8 = mkPTI 701 (Just 1022) +gtsvector :: PTI gtsvector = mkPTI 3642 (Just 3644) +inet :: PTI inet = mkPTI 869 (Just 1041) +int2 :: PTI int2 = mkPTI 21 (Just 1005) +int2vector :: PTI int2vector = mkPTI 22 (Just 1006) +int4 :: PTI int4 = mkPTI 23 (Just 1007) +int4range :: PTI int4range = mkPTI 3904 (Just 3905) +int8 :: PTI int8 = mkPTI 20 (Just 1016) +int8range :: PTI int8range = mkPTI 3926 (Just 3927) +interval :: PTI interval = mkPTI 1186 (Just 1187) +json :: PTI json = mkPTI 114 (Just 199) +jsonb :: PTI jsonb = mkPTI 3802 (Just 3807) +line :: PTI line = mkPTI 628 (Just 629) +lseg :: PTI lseg = mkPTI 601 (Just 1018) +macaddr :: PTI macaddr = mkPTI 829 (Just 1040) +money :: PTI money = mkPTI 790 (Just 791) +name :: PTI name = mkPTI 19 (Just 1003) +numeric :: PTI numeric = mkPTI 1700 (Just 1231) +numrange :: PTI numrange = mkPTI 3906 (Just 3907) +oid :: PTI oid = mkPTI 26 (Just 1028) +oidvector :: PTI oidvector = mkPTI 30 (Just 1013) +path :: PTI path = mkPTI 602 (Just 1019) +point :: PTI point = mkPTI 600 (Just 1017) +polygon :: PTI polygon = mkPTI 604 (Just 1027) +record :: PTI record = mkPTI 2249 (Just 2287) +refcursor :: PTI refcursor = mkPTI 1790 (Just 2201) +regclass :: PTI regclass = mkPTI 2205 (Just 2210) +regconfig :: PTI regconfig = mkPTI 3734 (Just 3735) +regdictionary :: PTI regdictionary = mkPTI 3769 (Just 3770) +regoper :: PTI regoper = mkPTI 2203 (Just 2208) +regoperator :: PTI regoperator = mkPTI 2204 (Just 2209) +regproc :: PTI regproc = mkPTI 24 (Just 1008) +regprocedure :: PTI regprocedure = mkPTI 2202 (Just 2207) +regtype :: PTI regtype = mkPTI 2206 (Just 2211) +reltime :: PTI reltime = mkPTI 703 (Just 1024) +text :: PTI text = mkPTI 25 (Just 1009) +tid :: PTI tid = mkPTI 27 (Just 1010) +time :: PTI time = mkPTI 1083 (Just 1183) +timestamp :: PTI timestamp = mkPTI 1114 (Just 1115) +timestamptz :: PTI timestamptz = mkPTI 1184 (Just 1185) +timetz :: PTI timetz = mkPTI 1266 (Just 1270) +tinterval :: PTI tinterval = mkPTI 704 (Just 1025) +tsquery :: PTI tsquery = mkPTI 3615 (Just 3645) +tsrange :: PTI tsrange = mkPTI 3908 (Just 3909) +tstzrange :: PTI tstzrange = mkPTI 3910 (Just 3911) +tsvector :: PTI tsvector = mkPTI 3614 (Just 3643) +txid_snapshot :: PTI txid_snapshot = mkPTI 2970 (Just 2949) +unknown :: PTI unknown = mkPTI 705 Nothing +uuid :: PTI uuid = mkPTI 2950 (Just 2951) +varbit :: PTI varbit = mkPTI 1562 (Just 1563) +varchar :: PTI varchar = mkPTI 1043 (Just 1015) +void :: PTI void = mkPTI 2278 Nothing +xid :: PTI xid = mkPTI 28 (Just 1011) +xml :: PTI xml = mkPTI 142 (Just 143)
tasty/Main/Prelude.hs view
@@ -11,6 +11,7 @@ import qualified Data.ByteString.Lazy import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Builder+import Test.QuickCheck.Instances () import Prelude as Exports hiding (Data, assert, check, fail) type LazyByteString =
tasty/Main/Properties.hs view
@@ -1,18 +1,12 @@ module Main.Properties where -import qualified Data.Scientific as Scientific-import qualified Data.UUID as UUID-import qualified Data.Vector as Vector import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Main.DB as DB import qualified Main.IO as IO-import qualified Main.PTI as PTI-import Main.Prelude hiding (assert, isLeft, isRight)+import Main.Prelude hiding (isLeft, isRight) import qualified Main.TextEncoder as C import qualified PostgreSQL.Binary.Decoding as A import qualified PostgreSQL.Binary.Encoding as B import Test.QuickCheck-import Test.QuickCheck.Instances roundtrip :: (Show a, Eq a) =>
tasty/Main/TextEncoder.hs view
@@ -4,7 +4,6 @@ import Data.ByteString.Builder import qualified Data.ByteString.Builder.Scientific-import qualified Data.Text.Encoding import qualified Data.UUID import Main.Prelude hiding (bool, maybe) import qualified Main.Prelude as Prelude