git.iko.soy/squeal
on dev help sign in
rename tests and executable
dac1fa6Eitan Chatav
squeal-postgresql/squeal-postgresql.cabal+4−4
compare with dev
unifiedsplit
@@ -80,7 +80,7 @@ library
80 , uuid-types >= 1.0.3
80 , uuid-types >= 1.0.3
81 , vector >= 0.12.0.1
81 , vector >= 0.12.0.1
82
82
83−test-suite squeal-postgresql-doctest
83+test-suite doctest
84 default-language: Haskell2010
84 default-language: Haskell2010
85 type: exitcode-stdio-1.0
85 type: exitcode-stdio-1.0
86 hs-source-dirs: test
86 hs-source-dirs: test
@@ -91,7 +91,7 @@ test-suite squeal-postgresql-doctest
91 , doctest >= 0.11.4
91 , doctest >= 0.11.4
92 , squeal-postgresql
92 , squeal-postgresql
93
93
94−test-suite squeal-postgresql-properties
94+test-suite properties
95 default-language: Haskell2010
95 default-language: Haskell2010
96 type: exitcode-stdio-1.0
96 type: exitcode-stdio-1.0
97 hs-source-dirs: test
97 hs-source-dirs: test
@@ -106,7 +106,7 @@ test-suite squeal-postgresql-properties
106 , squeal-postgresql
106 , squeal-postgresql
107 , time >= 1.8.0.2
107 , time >= 1.8.0.2
108
108
109−test-suite squeal-postgresql-spec
109+test-suite spec
110 default-language: Haskell2010
110 default-language: Haskell2010
111 type: exitcode-stdio-1.0
111 type: exitcode-stdio-1.0
112 hs-source-dirs: test
112 hs-source-dirs: test
@@ -123,7 +123,7 @@ test-suite squeal-postgresql-spec
123 , text >= 1.2.2.2
123 , text >= 1.2.2.2
124 , vector >= 0.12.0.1
124 , vector >= 0.12.0.1
125
125
126−executable squeal-postgresql-example
126+executable example
127 default-language: Haskell2010
127 default-language: Haskell2010
128 hs-source-dirs: exe
128 hs-source-dirs: exe
129 ghc-options: -Wall
129 ghc-options: -Wall
squeal-postgresql/test/Property.hs+20−12
@@ -12,17 +12,22 @@ module Main (main) where
12
12
13import Control.Monad.Trans
13import Control.Monad.Trans
14import Data.ByteString (ByteString)
14import Data.ByteString (ByteString)
15+import Data.ByteString.Char8 (unpack)
15−import Data.Scientific (fromFloatDigits,Scientific)
16+import Data.Scientific (fromFloatDigits)
16import Data.Fixed (Fixed(MkFixed), Micro, Pico)
17import Data.Fixed (Fixed(MkFixed), Micro, Pico)
18+import Data.String (IsString(fromString))
17import Data.Time
19import Data.Time
18−import Squeal.PostgreSQL hiding (check, defaultMain)
20+import Squeal.PostgreSQL hiding (check, defaultMain, Group)
19import Hedgehog hiding (Range)
21import Hedgehog hiding (Range)
20import qualified Hedgehog.Gen as Gen
22import qualified Hedgehog.Gen as Gen
21import qualified Hedgehog.Main as Main
23import qualified Hedgehog.Main as Main
22import qualified Hedgehog.Range as Range
24import qualified Hedgehog.Range as Range
23
25
24main :: IO ()
26main :: IO ()
25−main = Main.defaultMain
27+main = Main.defaultMain [checkParallel roundtrips]
28+
29+roundtrips :: Group
30+roundtrips = Group "roundtrips"
26 [ roundtrip int2 genInt16
31 [ roundtrip int2 genInt16
27 , roundtrip int4 genInt32
32 , roundtrip int4 genInt32
28 , roundtrip int8 genInt64
33 , roundtrip int8 genInt64
@@ -81,16 +86,16 @@ main = Main.defaultMain
81 s <- MkFixed . toInteger <$> Gen.int (Range.constant 0 59)
86 s <- MkFixed . toInteger <$> Gen.int (Range.constant 0 59)
82 return $ TimeOfDay h m s
87 return $ TimeOfDay h m s
83 genLocalTime = LocalTime <$> genDay <*> genTimeOfDay
88 genLocalTime = LocalTime <$> genDay <*> genTimeOfDay
84− genTimeZone = Gen.element $ map (read @TimeZone)
89+ -- genTimeZone = Gen.element $ map (read @TimeZone)
85− [ "UTC", "UT", "GMT", "EST", "EDT", "CST"
90+ -- [ "UTC", "UT", "GMT", "EST", "EDT", "CST"
86− , "CDT", "MST", "MDT", "PST", "PDT" ]
91+ -- , "CDT", "MST", "MDT", "PST", "PDT" ]
87− genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
92+ -- genTimeWithZone = (,) <$> genTimeOfDay <*> genTimeZone
88
93
89roundtrip
94roundtrip
90 :: (ToParam x ty, FromValue ty x, Show x, Eq x)
95 :: (ToParam x ty, FromValue ty x, Show x, Eq x)
91 => TypeExpression schemas ('NotNull ty)
96 => TypeExpression schemas ('NotNull ty)
92 -> Gen x
97 -> Gen x
93− -> IO Bool
98+ -> (PropertyName, Property)
94roundtrip = roundtripOn id
99roundtrip = roundtripOn id
95
100
96roundtripOn
101roundtripOn
@@ -98,13 +103,16 @@ roundtripOn
98 => (x -> x)
103 => (x -> x)
99 -> TypeExpression schemas ('NotNull ty)
104 -> TypeExpression schemas ('NotNull ty)
100 -> Gen x
105 -> Gen x
101− -> IO Bool
106+ -> (PropertyName, Property)
102−roundtripOn norm ty gen = check . property $ do
107+roundtripOn norm ty gen = propertyWithName $ do
103 x <- forAll gen
108 x <- forAll gen
104 Just (Only y) <- lift . withConnection connectionString $
109 Just (Only y) <- lift . withConnection connectionString $
105 firstRow =<< runQueryParams
110 firstRow =<< runQueryParams
106 (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
111 (values_ (parameter @1 ty `as` #fromOnly)) (Only x)
107 norm x === y
112 norm x === y
113+ where
114+ propertyWithName prop =
115+ (fromString (unpack (renderSQL ty)), property prop)
108
116
109maxPosFloat :: RealFloat a => a
117maxPosFloat :: RealFloat a => a
110maxPosFloat = x
118maxPosFloat = x
@@ -154,5 +162,5 @@ normalizeTimeOfDay (TimeOfDay h m s) = TimeOfDay h m
154normalizeLocalTime :: LocalTime -> LocalTime
162normalizeLocalTime :: LocalTime -> LocalTime
155normalizeLocalTime (LocalTime d t) = LocalTime d (normalizeTimeOfDay t)
163normalizeLocalTime (LocalTime d t) = LocalTime d (normalizeTimeOfDay t)
156
164
157−normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
165+-- normalizeTimeWithZone :: (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone)
158−normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)
166+-- normalizeTimeWithZone (t, z) = (normalizeTimeOfDay t, z)