module Main where
import Main.Prelude hiding (assert, isRight, isLeft, select)
import Control.Monad.IO.Class
import Test.QuickCheck.Instances
import Test.Tasty
import qualified Test.Tasty.HUnit as HUnit
import qualified Test.Tasty.QuickCheck as QuickCheck
import qualified Test.QuickCheck as QuickCheck
import qualified PostgreSQL.Binary.Encoding as A
import qualified PostgreSQL.Binary.Decoding as B
import qualified Data.ByteString as ByteString
import qualified Main.DB as DB
import qualified Main.Gens as Gens
import qualified Main.Properties as Properties
import qualified Main.IO as IO
import qualified Main.PTI as PTI
import qualified Main.TextEncoder as TextEncoder
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Main.Apx (Apx(..))
main =
defaultMain (testGroup "" [binary, textual])
binary =
testGroup "Binary format" testList
where
testList =
jsonb ++ other
where
jsonb =
if version >= 90400
then [primitiveRoundtrip "jsonb" Gens.aeson PTI.jsonb A.jsonb_ast B.jsonb_ast]
else []
other =
[
select "select (234 :: int8)" (const B.int) (234 :: Int32)
,
select "select (-234 :: int8)" (const B.int) (-234 :: Int32)
,
select "select (0 :: int8)" (const B.int) (0 :: Int32)
,
let
sql =
"select (1, 'a')"
decoder _ =
B.composite ((,) <$> B.valueComposite B.int <*> B.valueComposite B.char)
expected =
(1 :: Int64, 'a')
in select sql decoder expected
,
let
sql =
"select (1, null)"
decoder _ =
B.composite ((,) <$> B.valueComposite B.int <*> B.nullableValueComposite B.char)
expected =
(1 :: Int64, Nothing :: Maybe Char)
in select sql decoder expected
,
select "SELECT '1 year 2 months 3 days 4 hours 5 minutes 6 seconds 332211 microseconds' :: interval"
(bool B.interval_float B.interval_int)
(picosecondsToDiffTime (10^6 * (332211 + 10^6 * (6 + 60 * (5 + 60 * (4 + 24 * (3 + 31 * (2 + 12))))))))
,
select "SELECT '10 seconds' :: interval"
(bool B.interval_float B.interval_int)
(10 :: DiffTime)
,
HUnit.testCase "Interval encoder: 10 seconds" $
let
pti =
PTI.interval
encoder integerDatetimes =
(bool A.interval_float A.interval_int integerDatetimes)
decoder =
(bool B.interval_float B.interval_int)
value =
(10 :: DiffTime)
in
HUnit.assertEqual "" (Right value) =<<
IO.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder value
,
timeRoundtrip "interval" Gens.intervalDiffTime PTI.interval
(bool A.interval_float A.interval_int)
(bool B.interval_float B.interval_int)
,
timeRoundtrip "timestamp" (fmap Apx Gens.auto) PTI.timestamp
((. unApx) . bool A.timestamp_float A.timestamp_int)
(fmap Apx . bool B.timestamp_float B.timestamp_int)
,
HUnit.testCase "timestamptz offset" $ do
Right (textual, decoded) <-
DB.session $ do
integerDatetimes <- DB.integerDatetimes
let encoder = bool A.timestamptz_float A.timestamptz_int integerDatetimes
decoder = bool B.timestamptz_float B.timestamptz_int integerDatetimes
DB.unit "DROP TABLE IF EXISTS a" []
DB.unit "CREATE TABLE a (b TIMESTAMPTZ)" []
DB.unit "set timezone to 'America/Los_Angeles'" []
let p = (,,) (PTI.oidPQ (PTI.ptiOID PTI.timestamptz))
((A.encodingBytes . encoder) x)
(LibPQ.Binary)
x = read "2011-09-28 00:17:25Z"
DB.unit "insert into a (b) values ($1)" [Just p]
DB.unit "set timezone to 'Europe/Stockholm'" []
textual <- DB.oneRow "SELECT * FROM a" [] LibPQ.Text
decoded <- fmap (B.valueParser decoder) (DB.oneRow "SELECT * FROM a" [] LibPQ.Binary)
return (textual, decoded)
HUnit.assertEqual "" ("2011-09-28 02:17:25+02") textual
HUnit.assertEqual "" (Right (read "2011-09-28 00:17:25Z")) decoded
,
timeRoundtrip "timestamptz" (fmap Apx Gens.auto) PTI.timestamptz
((. unApx) . bool A.timestamptz_float A.timestamptz_int)
(fmap Apx . bool B.timestamptz_float B.timestamptz_int)
,
timeRoundtrip "timetz" (fmap Apx Gens.timetz) PTI.timetz
((. unApx) . bool A.timetz_float A.timetz_int)
(fmap Apx . bool B.timetz_float B.timetz_int)
,
timeRoundtrip "time" (fmap Apx Gens.auto) PTI.time
((. unApx) . bool A.time_float A.time_int)
(fmap Apx . bool B.time_float B.time_int)
,
primitiveRoundtrip "numeric" Gens.scientific PTI.numeric A.numeric B.numeric
,
select "SELECT -1234560.789 :: numeric" (const B.numeric) (read "-1234560.789")
,
select "SELECT -0.0789 :: numeric" (const B.numeric) (read "-0.0789")
,
select "SELECT 10000 :: numeric" (const B.numeric) (read "10000")
,
primitiveRoundtrip "float4" Gens.auto PTI.float4 A.float4 B.float4
,
primitiveRoundtrip "float8" Gens.auto PTI.float8 A.float8 B.float8
,
primitiveRoundtrip "char" Gens.char PTI.text A.char_utf8 B.char
,
primitiveRoundtrip "text_strict" Gens.text PTI.text A.text_strict B.text_strict
,
primitiveRoundtrip "text_lazy" (fmap convert Gens.text) PTI.text A.text_lazy B.text_lazy
,
primitiveRoundtrip "bytea_strict" Gens.auto PTI.bytea A.bytea_strict B.bytea_strict
,
primitiveRoundtrip "bytea_lazy" Gens.auto PTI.bytea A.bytea_lazy B.bytea_lazy
,
primitiveRoundtrip "uuid" Gens.uuid PTI.uuid A.uuid B.uuid
,
primitiveRoundtrip "inet" Gens.inet PTI.inet A.inet B.inet
,
primitiveRoundtrip "int2_int16" Gens.auto PTI.int2 A.int2_int16 B.int
,
primitiveRoundtrip "int2_word16" Gens.auto PTI.int2 A.int2_word16 B.int
,
primitiveRoundtrip "int4_int32" Gens.auto PTI.int4 A.int4_int32 B.int
,
primitiveRoundtrip "int4_word32" Gens.auto PTI.int4 A.int4_word32 B.int
,
primitiveRoundtrip "int8_int64" Gens.auto PTI.int8 A.int8_int64 B.int
,
primitiveRoundtrip "int8_word64" Gens.auto PTI.int8 A.int8_word64 B.int
,
primitiveRoundtrip "bool" Gens.auto PTI.bool A.bool B.bool
,
primitiveRoundtrip "date" Gens.auto PTI.date A.date B.date
,
let
decoder =
B.array $
B.dimensionArray replicateM $
B.dimensionArray replicateM $
B.valueArray $
B.int
in
select "SELECT ARRAY[ARRAY[1,2],ARRAY[3,4]]" (const decoder) ([[1,2],[3,4]] :: [[Int]])
,
let
encoder =
A.array (PTI.oidWord32 (PTI.ptiOID PTI.int8)) . arrayEncoder
where
arrayEncoder =
A.dimensionArray foldl' $
A.dimensionArray foldl' $
A.dimensionArray foldl' $
A.encodingArray . A.int8_int64
decoder =
B.array $
B.dimensionArray replicateM $
B.dimensionArray replicateM $
B.dimensionArray replicateM $
B.valueArray $
B.int
in
arrayCodec (Gens.array3 Gens.auto) encoder decoder
,
let
pti =
PTI.text
encoder =
A.array (PTI.oidWord32 (PTI.ptiOID pti)) . arrayEncoder
where
arrayEncoder =
A.dimensionArray foldl' $
A.dimensionArray foldl' $
A.dimensionArray foldl' $
A.encodingArray . A.text_strict
decoder =
B.array $
B.dimensionArray replicateM $
B.dimensionArray replicateM $
B.dimensionArray replicateM $
B.valueArray $
B.text_strict
in
arrayRoundtrip (Gens.array3 Gens.text) pti encoder decoder
]
textual =
testGroup "Textual format" $
[
test "numeric" Gens.scientific PTI.numeric TextEncoder.numeric (const B.numeric)
,
test "float4" Gens.auto PTI.float4 TextEncoder.float4 (const B.float4)
,
test "float8" Gens.auto PTI.float8 TextEncoder.float8 (const B.float8)
,
test "uuid" Gens.uuid PTI.uuid TextEncoder.uuid (const B.uuid)
,
test "int2_int16" Gens.auto PTI.int2 TextEncoder.int2_int16 (const B.int)
,
test "int2_word16" Gens.postgresInt PTI.int2 TextEncoder.int2_word16 (const B.int)
,
test "int4_int32" Gens.auto PTI.int4 TextEncoder.int4_int32 (const B.int)
,
test "int4_word32" Gens.postgresInt PTI.int4 TextEncoder.int4_word32 (const B.int)
,
test "int8_int64" Gens.auto PTI.int8 TextEncoder.int8_int64 (const B.int)
,
test "int8_word64" Gens.postgresInt PTI.int8 TextEncoder.int8_word64 (const B.int)
,
test "bool" Gens.auto PTI.bool TextEncoder.bool (const B.bool)
]
where
test typeName gen pti encoder decoder =
QuickCheck.testProperty (typeName <> " roundtrip") $
QuickCheck.forAll gen $ Properties.textRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder
arrayCodec gen encoder decoder =
QuickCheck.testProperty ("Array codec") $
QuickCheck.forAll gen $
\value -> (QuickCheck.===) (Right value) (B.valueParser decoder ((A.encodingBytes . encoder) value))
arrayRoundtrip gen pti encoder decoder =
QuickCheck.testProperty ("Array roundtrip") $
QuickCheck.forAll gen $ Properties.stdRoundtrip (PTI.oidPQ (fromJust (PTI.ptiArrayOID pti))) encoder decoder
stdRoundtrip typeName gen pti encoder decoder =
QuickCheck.testProperty (typeName <> " roundtrip") $
QuickCheck.forAll gen $ Properties.stdRoundtrip (PTI.oidPQ (PTI.ptiOID pti)) encoder decoder
primitiveRoundtrip typeName gen pti encoder decoder =
stdRoundtrip typeName gen pti (encoder) decoder
timeRoundtrip typeName gen pti encoder decoder =
QuickCheck.testProperty (typeName <> " roundtrip") $
QuickCheck.forAll gen $ Properties.roundtrip (PTI.oidPQ (PTI.ptiOID pti)) (\x -> encoder x) decoder
select statement decoder value =
HUnit.testCase (show statement) $
HUnit.assertEqual "" (Right value) $
unsafePerformIO $ IO.parameterlessStatement statement decoder value
{-# NOINLINE version #-}
version :: Int
version =
either (error . show) id $
unsafePerformIO $
DB.session $
DB.serverVersion