git.iko.soy/squeal
on dev help sign in
Update Property.hs
65893e0Eitan Chatav
squeal-postgresql/test/Property.hs+72−47
compare with dev
unifiedsplit
@@ -12,7 +12,7 @@ module Property (propertyTests) where
12
12
13import Control.Monad.Trans
13import Control.Monad.Trans
14import Data.ByteString (ByteString)
14import Data.ByteString (ByteString)
15−import Data.Scientific (fromFloatDigits)
15+import Data.Scientific (fromFloatDigits,Scientific)
16import Data.Fixed (Fixed(MkFixed), Micro, Pico)
16import Data.Fixed (Fixed(MkFixed), Micro, Pico)
17import Data.Time
17import Data.Time
18import Squeal.PostgreSQL hiding (check, defaultMain)
18import Squeal.PostgreSQL hiding (check, defaultMain)
@@ -23,48 +23,50 @@ import qualified Hedgehog.Range as Range
23
23
24propertyTests :: IO ()
24propertyTests :: IO ()
25propertyTests = Main.defaultMain
25propertyTests = Main.defaultMain
26− [ roundtrip int2 genInt16 id
26+ [ roundtrip int2 genInt16
27− , roundtrip int4 genInt32 id
27+ , roundtrip int4 genInt32
28− , roundtrip int8 genInt64 id
28+ , roundtrip int8 genInt64
29− , roundtrip bool Gen.bool id
29+ , roundtrip bool Gen.bool
30− , roundtrip numeric genScientific id
30+ , roundtrip numeric genScientific
31− , roundtrip float4 genFloat id
31+ , roundtrip float4 genFloat
32− , roundtrip float8 genDouble id
32+ , roundtrip float8 genDouble
33− , roundtrip time genTimeOfDay normalizeTimeOfDay
33+ , roundtripOn normalizeTimeOfDay time genTimeOfDay
34 -- , roundtrip timetz genTimeWithZone normalizeTimeWithZone
34 -- , roundtrip timetz genTimeWithZone normalizeTimeWithZone
35− , roundtrip timestamp genLocalTime normalizeLocalTime
35+ , roundtripOn normalizeLocalTime timestamp genLocalTime
36− , roundtrip timestamptz genUTCTime id
36+ , roundtrip timestamptz genUTCTime
37− , roundtrip date genDay id
37+ , roundtrip date genDay
38− , roundtrip interval genDiffTime id
38+ , roundtrip interval genDiffTime
39− , roundtrip int4range (genRange genInt32) normalizeIntRange
39+ , roundtripOn normalizeIntRange int4range (genRange genInt32)
40− , roundtrip int8range (genRange genInt64) normalizeIntRange
40+ , roundtripOn normalizeIntRange int8range (genRange genInt64)
41− , roundtrip numrange (genRange genScientific) id
41+ , roundtrip numrange (genRange genScientific)
42− , roundtrip tsrange (genRange genLocalTime) (fmap normalizeLocalTime)
42+ , roundtripOn (fmap normalizeLocalTime) tsrange (genRange genLocalTime)
43− , roundtrip tstzrange (genRange genUTCTime) id
43+ , roundtrip tstzrange (genRange genUTCTime)
44− , roundtrip daterange (genRange genDay) normalizeIntRange
44+ , roundtripOn normalizeIntRange daterange (genRange genDay)
45 ]
45 ]
46 where
46 where
47 genInt16 = Gen.int16 Range.exponentialBounded
47 genInt16 = Gen.int16 Range.exponentialBounded
48 genInt32 = Gen.int32 Range.exponentialBounded
48 genInt32 = Gen.int32 Range.exponentialBounded
49 genInt64 = Gen.int64 Range.exponentialBounded
49 genInt64 = Gen.int64 Range.exponentialBounded
50− genScientific = fromFloatDigits <$>
50+ genScientific = fromFloatDigits <$> genFloat
51+ genPosFloat = Gen.float
51− Gen.float (Range.exponentialFloatFrom 0 (-1E9) 1E9)
52+ (Range.exponentialFloatFrom 1 minPosFloat maxPosFloat)
53+ genFloat = Gen.prune $ Gen.choice
54+ [ genPosFloat
55+ , negate <$> genPosFloat
56+ , Gen.element [0,1/0] ]
57+ genPosDouble = Gen.double
52− genFloat = Gen.float (Range.exponentialFloatFrom 0 (-1E9) 1E9)
58+ (Range.exponentialFloatFrom 1 minPosFloat maxPosFloat)
53− genDouble = Gen.double (Range.exponentialFloatFrom 0 (-1E308) 1E308)
59+ genDouble = Gen.prune $ Gen.choice
60+ [ genPosDouble
61+ , negate <$> genPosDouble
62+ , Gen.element [0,1/0] ]
54 genRange gen = do
63 genRange gen = do
55 lb <- gen
64 lb <- gen
56− ub <- Gen.filter (lb <=) gen
65+ ub <- Gen.filter (lb <) gen
57 Gen.element
66 Gen.element
58− [ Empty
67+ [ Empty, singleton lb, whole
59− , NonEmpty (Closed lb) (Closed ub)
68+ , lb <=..<= ub , lb <=..< ub, lb <..<= ub, lb <..< ub
60− , NonEmpty (Closed lb) (Open ub)
69+ , atLeast lb, moreThan lb, atMost ub, lessThan ub ]
61− , NonEmpty (Closed lb) Infinite
62− , NonEmpty (Open lb) (Closed ub)
63− , NonEmpty (Open lb) (Open ub)
64− , NonEmpty (Open lb) Infinite
65− , NonEmpty Infinite (Closed ub)
66− , NonEmpty Infinite (Open ub)
67− , NonEmpty Infinite Infinite ]
68 genDay = do
70 genDay = do
69 y <- toInteger <$> Gen.int (Range.constant 2000 2019)
71 y <- toInteger <$> Gen.int (Range.constant 2000 2019)
70 m <- Gen.int (Range.constant 1 12)
72 m <- Gen.int (Range.constant 1 12)
@@ -84,6 +86,42 @@ propertyTests = Main.defaultMain
84 , "CDT", "MST", "MDT", "PST", "PDT" ]
86 , "CDT", "MST", "MDT", "PST", "PDT" ]
85 genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
87 genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
86
88
89+roundtrip
90+ :: (ToParam x ty, FromValue ty x, Show x, Eq x)
91+ => TypeExpression schemas ('NotNull ty)
92+ -> Gen x
93+ -> IO Bool
94+roundtrip = roundtripOn id
95+
96+roundtripOn
97+ :: (ToParam x ty, FromValue ty x, Show x, Eq x)
98+ => (x -> x)
99+ -> TypeExpression schemas ('NotNull ty)
100+ -> Gen x
101+ -> IO Bool
102+roundtripOn norm ty gen = check . property $ do
103+ x <- forAll gen
104+ Just (Only y) <- lift . withConnection connectionString $
105+ firstRow =<< runQueryParams
106+ (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
107+ norm x === y
108+
109+maxPosFloat :: RealFloat a => a
110+maxPosFloat = x
111+ where
112+ n = floatDigits x
113+ b = floatRadix x
114+ (_, u) = floatRange x
115+ x = encodeFloat (b^n - 1) (u - n)
116+
117+minPosFloat :: RealFloat a => a
118+minPosFloat = x
119+ where
120+ n = floatDigits x
121+ b = floatRadix x
122+ (l, _) = floatRange x
123+ x = encodeFloat (b^n - 1) (l - n - 1)
124+
87connectionString :: ByteString
125connectionString :: ByteString
88connectionString = "host=localhost port=5432 dbname=exampledb"
126connectionString = "host=localhost port=5432 dbname=exampledb"
89
127
@@ -118,16 +156,3 @@ normalizeLocalTime (LocalTime d t) = LocalTime d (normalizeTimeOfDay t)
118
156
119normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
157normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
120normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)
158normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)
121−
122−roundtrip
123− :: (ToParam x ty, FromValue ty x, Show x, Eq x)
124− => TypeExpression schemas ('NotNull ty)
125− -> Gen x
126− -> (x -> x)
127− -> IO Bool
128−roundtrip ty gen norm = check . property $ do
129− x <- forAll gen
130− Just (Only y) <- lift . withConnection connectionString $
131− firstRow =<< runQueryParams
132− (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
133− norm x === y