@@ -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