diff --git a/decoding/Main.hs b/decoding/Main.hs --- a/decoding/Main.hs +++ b/decoding/Main.hs @@ -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 diff --git a/encoding/Main.hs b/encoding/Main.hs --- a/encoding/Main.hs +++ b/encoding/Main.hs @@ -5,6 +5,7 @@ import qualified PostgreSQL.Binary.Encoding as E import Prelude +main :: IO () main = defaultMain [ value "bool" E.bool True, diff --git a/library/PostgreSQL/Binary/Decoding.hs b/library/PostgreSQL/Binary/Decoding.hs --- a/library/PostgreSQL/Binary/Decoding.hs +++ b/library/PostgreSQL/Binary/Decoding.hs @@ -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) diff --git a/library/PostgreSQL/Binary/Encoding.hs b/library/PostgreSQL/Binary/Encoding.hs --- a/library/PostgreSQL/Binary/Encoding.hs +++ b/library/PostgreSQL/Binary/Encoding.hs @@ -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 diff --git a/library/PostgreSQL/Binary/Encoding/Builders.hs b/library/PostgreSQL/Binary/Encoding/Builders.hs --- a/library/PostgreSQL/Binary/Encoding/Builders.hs +++ b/library/PostgreSQL/Binary/Encoding/Builders.hs @@ -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 diff --git a/library/PostgreSQL/Binary/Interval.hs b/library/PostgreSQL/Binary/Interval.hs --- a/library/PostgreSQL/Binary/Interval.hs +++ b/library/PostgreSQL/Binary/Interval.hs @@ -14,9 +14,11 @@ -- Oddly enough despite a claim of support of up to 178000000 years in -- -- 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)) + ) diff --git a/library/PostgreSQL/Binary/Numeric.hs b/library/PostgreSQL/Binary/Numeric.hs --- a/library/PostgreSQL/Binary/Numeric.hs +++ b/library/PostgreSQL/Binary/Numeric.hs @@ -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 diff --git a/library/PostgreSQL/Binary/Prelude.hs b/library/PostgreSQL/Binary/Prelude.hs --- a/library/PostgreSQL/Binary/Prelude.hs +++ b/library/PostgreSQL/Binary/Prelude.hs @@ -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 diff --git a/library/PostgreSQL/Binary/Time.hs b/library/PostgreSQL/Binary/Time.hs --- a/library/PostgreSQL/Binary/Time.hs +++ b/library/PostgreSQL/Binary/Time.hs @@ -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 diff --git a/postgresql-binary.cabal b/postgresql-binary.cabal --- a/postgresql-binary.cabal +++ b/postgresql-binary.cabal @@ -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 -maintainer: - Nikita Volkov -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 +maintainer: Nikita Volkov +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 diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -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 diff --git a/tasty/Main/Apx.hs b/tasty/Main/Apx.hs --- a/tasty/Main/Apx.hs +++ b/tasty/Main/Apx.hs @@ -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 diff --git a/tasty/Main/Composite.hs b/tasty/Main/Composite.hs --- a/tasty/Main/Composite.hs +++ b/tasty/Main/Composite.hs @@ -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) diff --git a/tasty/Main/DB.hs b/tasty/Main/DB.hs --- a/tasty/Main/DB.hs +++ b/tasty/Main/DB.hs @@ -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 = diff --git a/tasty/Main/Gens.hs b/tasty/Main/Gens.hs --- a/tasty/Main/Gens.hs +++ b/tasty/Main/Gens.hs @@ -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 diff --git a/tasty/Main/IO.hs b/tasty/Main/IO.hs --- a/tasty/Main/IO.hs +++ b/tasty/Main/IO.hs @@ -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 diff --git a/tasty/Main/PTI.hs b/tasty/Main/PTI.hs --- a/tasty/Main/PTI.hs +++ b/tasty/Main/PTI.hs @@ -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) diff --git a/tasty/Main/Prelude.hs b/tasty/Main/Prelude.hs --- a/tasty/Main/Prelude.hs +++ b/tasty/Main/Prelude.hs @@ -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 = diff --git a/tasty/Main/Properties.hs b/tasty/Main/Properties.hs --- a/tasty/Main/Properties.hs +++ b/tasty/Main/Properties.hs @@ -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) => diff --git a/tasty/Main/TextEncoder.hs b/tasty/Main/TextEncoder.hs --- a/tasty/Main/TextEncoder.hs +++ b/tasty/Main/TextEncoder.hs @@ -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