on dev help sign in
binary tests

binary tests for some basic types. I will need such tests for range types. Later I will need this to be exhaustive over all pg types.

commit1e3cf9f272a03c581ba98747b960bfe8fd73085c authorEitan Chatav <eitan@EEM109LMBP-1.local> dateSun 14 Jul 2019, 20:05 (7 years ago) parent0980480
4 files changed+56−3
squeal-postgresql/squeal-postgresql.cabal+6−1 squeal-postgresql/test/Specs/Binary.hs+45 squeal-postgresql/test/Specs/Specs.hs+4−1 stack.yaml+1−1
squeal-postgresql/squeal-postgresql.cabal+6−1
@@ -96,13 +96,18 @@ test-suite squeal-postgresql-specs
9696 hs-source-dirs: test/Specs
9797 ghc-options: -Wall
9898 main-is: Specs.hs
99− other-modules: ExceptionHandling
99+ other-modules:
100+ Binary
101+ , ExceptionHandling
100102 build-depends:
101103 base >= 4.10.0.0
102104 , async >= 2.2.2
103105 , bytestring >= 0.10.8.2
104106 , generics-sop >= 0.3.1.0
105107 , hspec >= 2.4.8
108+ , hedgehog >= 1.0
109+ , mtl >= 2.2.2
110+ , scientific >= 0.3.5.3
106111 , squeal-postgresql
107112 , text >= 1.2.2.2
108113 , transformers >= 0.5.2.0
squeal-postgresql/test/Specs/Binary.hsnew file+45
@@ -0,0 +1,45 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , OverloadedLabels
4+ , OverloadedStrings
5+ , TypeApplications
6+ , TypeOperators
7+#-}
8+
9+module Binary (roundtrips) where
10+
11+import Control.Monad.Trans
12+import Data.ByteString (ByteString)
13+import Data.Scientific (fromFloatDigits)
14+import Squeal.PostgreSQL hiding (check, defaultMain)
15+import Hedgehog
16+import qualified Hedgehog.Gen as Gen
17+import qualified Hedgehog.Main as Main
18+import qualified Hedgehog.Range as Range
19+
20+roundtrips :: IO ()
21+roundtrips = Main.defaultMain
22+ [ check $ roundtrip int2 (Gen.int16 Range.constantBounded)
23+ , check $ roundtrip int4 (Gen.int32 Range.constantBounded)
24+ , check $ roundtrip int8 (Gen.int64 Range.constantBounded)
25+ , check $ roundtrip bool Gen.bool
26+ , check $ roundtrip numeric (scientific (Range.exponentialFloatFrom 0 (-1E9) 1E9))
27+ , check $ roundtrip float4 (Gen.float (Range.exponentialFloatFrom 0 (-1E9) 1E9))
28+ ]
29+ where
30+ scientific = fmap fromFloatDigits . Gen.float
31+
32+connectionString :: ByteString
33+connectionString = "host=localhost port=5432 dbname=exampledb"
34+
35+roundtrip
36+ :: (ToParam x ty, FromValue ty x, Show x, Eq x)
37+ => TypeExpression schemas ('NotNull ty)
38+ -> Gen x
39+ -> Property
40+roundtrip ty gen = property $ do
41+ x <- forAll gen
42+ Just (Only y) <- lift . withConnection connectionString $
43+ firstRow =<< runQueryParams
44+ (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
45+ x === y
squeal-postgresql/test/Specs/Specs.hs+4−1
@@ -2,6 +2,9 @@ module Main where
22
33import Test.Hspec
44import qualified ExceptionHandling
5+import qualified Binary
56
67main :: IO ()
7−main = hspec ExceptionHandling.specs
8+main = do
9+ hspec ExceptionHandling.specs
10+ Binary.roundtrips
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-13.25
1+resolver: nightly-2019-07-14
22packages:
33- squeal-postgresql
44