@@ -12,17 +12,22 @@ module Main (main) where
1212
1313import Control.Monad.Trans
1414import Data.ByteString (ByteString)
15−import Data.Scientific (fromFloatDigits,Scientific)
15+import Data.ByteString.Char8 (unpack)
16+import Data.Scientific (fromFloatDigits)
1617import Data.Fixed (Fixed(MkFixed), Micro, Pico)
18+import Data.String (IsString(fromString))
1719import Data.Time
18−import Squeal.PostgreSQL hiding (check, defaultMain)
20+import Squeal.PostgreSQL hiding (check, defaultMain, Group)
1921import Hedgehog hiding (Range)
2022import qualified Hedgehog.Gen as Gen
2123import qualified Hedgehog.Main as Main
2224import qualified Hedgehog.Range as Range
2325
2426main :: IO ()
25−main = Main.defaultMain
27+main = Main.defaultMain [checkParallel roundtrips]
28+
29+roundtrips :: Group
30+roundtrips = Group "roundtrips"
2631 [ roundtrip int2 genInt16
2732 , roundtrip int4 genInt32
2833 , roundtrip int8 genInt64
@@ -81,16 +86,16 @@ main = Main.defaultMain
8186 s <- MkFixed . toInteger <$> Gen.int (Range.constant 0 59)
8287 return $ TimeOfDay h m s
8388 genLocalTime = LocalTime <$> genDay <*> genTimeOfDay
84− genTimeZone = Gen.element $ map (read @TimeZone)
85− [ "UTC", "UT", "GMT", "EST", "EDT", "CST"
86− , "CDT", "MST", "MDT", "PST", "PDT" ]
87− genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
89+ -- genTimeZone = Gen.element $ map (read @TimeZone)
90+ -- [ "UTC", "UT", "GMT", "EST", "EDT", "CST"
91+ -- , "CDT", "MST", "MDT", "PST", "PDT" ]
92+ -- genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
8893
8994roundtrip
9095 :: (ToParam x ty, FromValue ty x, Show x, Eq x)
9196 => TypeExpression schemas ('NotNull ty)
9297 -> Gen x
93− -> IO Bool
98+ -> (PropertyName, Property)
9499roundtrip = roundtripOn id
95100
96101roundtripOn
@@ -98,13 +103,16 @@ roundtripOn
98103 => (x -> x)
99104 -> TypeExpression schemas ('NotNull ty)
100105 -> Gen x
101− -> IO Bool
102−roundtripOn norm ty gen = check . property $ do
106+ -> (PropertyName, Property)
107+roundtripOn norm ty gen = propertyWithName $ do
103108 x <- forAll gen
104109 Just (Only y) <- lift . withConnection connectionString $
105110 firstRow =<< runQueryParams
106111 (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
107112 norm x === y
113+ where
114+ propertyWithName prop =
115+ (fromString (unpack (renderSQL ty)), property prop)
108116
109117maxPosFloat :: RealFloat a => a
110118maxPosFloat = x
@@ -154,5 +162,5 @@ normalizeTimeOfDay (TimeOfDay h m s) = TimeOfDay h m
154162normalizeLocalTime :: LocalTime -> LocalTime
155163normalizeLocalTime (LocalTime d t) = LocalTime d (normalizeTimeOfDay t)
156164
157−normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
158−normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)
165+-- normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
166+-- normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)