Hello community,
here is the log from the commit of package ghc-postgresql-typed for
openSUSE:Factory checked in at 2017-05-18 20:50:54
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-postgresql-typed (Old)
and /work/SRC/openSUSE:Factory/.ghc-postgresql-typed.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-postgresql-typed"
Thu May 18 20:50:54 2017 rev:2 rq:495709 version:0.5.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-postgresql-typed/ghc-postgresql-typed.changes
2017-05-10 20:54:28.429350640 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-postgresql-typed.new/ghc-postgresql-typed.changes
2017-05-18 20:50:55.861152662 +0200
@@ -1,0 +2,10 @@
+Mon Mar 27 12:36:38 UTC 2017 - psim...@suse.com
+
+- Update to version 0.5.1 with cabal2obs.
+
+-------------------------------------------------------------------
+Sun Mar 26 15:39:47 UTC 2017 - psim...@suse.com
+
+- Update to version 0.5.0 revision 1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
postgresql-typed-0.5.0.tar.gz
New:
----
postgresql-typed-0.5.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-postgresql-typed.spec ++++++
--- /var/tmp/diff_new_pack.q9vnxs/_old 2017-05-18 20:50:56.389078158 +0200
+++ /var/tmp/diff_new_pack.q9vnxs/_new 2017-05-18 20:50:56.393077593 +0200
@@ -19,9 +19,9 @@
%global pkg_name postgresql-typed
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.5.0
+Version: 0.5.1
Release: 0
-Summary: A PostgreSQL library with compile-time SQL type inference and
optional HDBC backend
+Summary: PostgreSQL interface with compile-time SQL type checking,
optional HDBC backend
License: BSD-3-Clause
Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
++++++ postgresql-typed-0.5.0.tar.gz -> postgresql-typed-0.5.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-typed-0.5.0/Database/PostgreSQL/Typed/Types.hs
new/postgresql-typed-0.5.1/Database/PostgreSQL/Typed/Types.hs
--- old/postgresql-typed-0.5.0/Database/PostgreSQL/Typed/Types.hs
2017-01-27 04:25:55.000000000 +0100
+++ new/postgresql-typed-0.5.1/Database/PostgreSQL/Typed/Types.hs
2017-03-22 21:23:11.000000000 +0100
@@ -94,9 +94,14 @@
import GHC.TypeLits (Symbol, symbolVal, KnownSymbol)
import Numeric (readFloat)
#ifdef VERSION_postgresql_binary
+#if MIN_VERSION_postgresql_binary(0,12,0)
+import qualified PostgreSQL.Binary.Decoding as BinD
+import qualified PostgreSQL.Binary.Encoding as BinE
+#else
import qualified PostgreSQL.Binary.Decoder as BinD
import qualified PostgreSQL.Binary.Encoder as BinE
#endif
+#endif
type PGTextValue = BS.ByteString
type PGBinaryValue = BS.ByteString
@@ -259,11 +264,31 @@
| otherwise = Just s
#ifdef VERSION_postgresql_binary
-binDec :: PGType t => BinD.Decoder a -> PGTypeID t -> PGBinaryValue -> a
-binDec d t = either (\e -> error $ "pgDecodeBinary " ++ show (pgTypeName t) ++
": " ++ show e) id . BinD.run d
+binEnc :: BinEncoder a -> a -> BS.ByteString
+binEnc = (.)
+#if MIN_VERSION_postgresql_binary(0,12,0)
+ BinE.encodingBytes
+
+type BinDecoder = BinD.Value
+type BinEncoder a = a -> BinE.Encoding
+#else
+ buildPGValue
+
+type BinDecoder = BinD.Decoder
+type BinEncoder a = BinE.Encoder a
+#endif
+
+binDec :: PGType t => BinDecoder a -> PGTypeID t -> PGBinaryValue -> a
+binDec d t = either (\e -> error $ "pgDecodeBinary " ++ show (pgTypeName t) ++
": " ++ show e) id .
+#if MIN_VERSION_postgresql_binary(0,12,0)
+ BinD.valueParser
+#else
+ BinD.run
+#endif
+ d
#define BIN_COL pgBinaryColumn _ _ = True
-#define BIN_ENC(F) pgEncodeValue _ _ = PGBinaryValue . buildPGValue . (F)
+#define BIN_ENC(F) pgEncodeValue _ _ = PGBinaryValue . binEnc (F)
#define BIN_DEC(F) pgDecodeBinary _ = binDec (F)
#else
#define BIN_COL
@@ -382,21 +407,23 @@
pgDecode _ = read . BSC.unpack
BIN_DEC(BinD.float8)
+-- XXX need real encoding as text
+-- but then no one should be using this type really...
instance PGType "\"char\"" where
type PGVal "\"char\"" = Word8
BIN_COL
instance PGParameter "\"char\"" Word8 where
pgEncode _ = BS.singleton
- BIN_ENC(BinE.char . w2c)
+ pgEncodeValue _ _ = PGBinaryValue . BS.singleton
instance PGColumn "\"char\"" Word8 where
pgDecode _ = BS.head
- BIN_DEC(c2w <$> BinD.char)
+ pgDecodeBinary _ _ = BS.head
instance PGParameter "\"char\"" Char where
pgEncode _ = BSC.singleton
- BIN_ENC(BinE.char)
+ pgEncodeValue _ _ = PGBinaryValue . BSC.singleton
instance PGColumn "\"char\"" Char where
pgDecode _ = BSC.head
- BIN_DEC(BinD.char)
+ pgDecodeBinary _ _ = BSC.head
class PGType t => PGStringType t
@@ -565,12 +592,12 @@
binColDatetime _ _ = False
#ifdef VERSION_postgresql_binary
-binEncDatetime :: PGParameter t a => BinE.Encoder a -> BinE.Encoder a ->
PGTypeEnv -> PGTypeID t -> a -> PGValue
-binEncDatetime _ ff PGTypeEnv{ pgIntegerDatetimes = Just False } _ =
PGBinaryValue . buildPGValue . ff
-binEncDatetime fi _ PGTypeEnv{ pgIntegerDatetimes = Just True } _ =
PGBinaryValue . buildPGValue . fi
+binEncDatetime :: PGParameter t a => BinEncoder a -> BinEncoder a -> PGTypeEnv
-> PGTypeID t -> a -> PGValue
+binEncDatetime _ ff PGTypeEnv{ pgIntegerDatetimes = Just False } _ =
PGBinaryValue . binEnc ff
+binEncDatetime fi _ PGTypeEnv{ pgIntegerDatetimes = Just True } _ =
PGBinaryValue . binEnc fi
binEncDatetime _ _ PGTypeEnv{ pgIntegerDatetimes = Nothing } t = PGTextValue .
pgEncode t
-binDecDatetime :: PGColumn t a => BinD.Decoder a -> BinD.Decoder a ->
PGTypeEnv -> PGTypeID t -> PGBinaryValue -> a
+binDecDatetime :: PGColumn t a => BinDecoder a -> BinDecoder a -> PGTypeEnv ->
PGTypeID t -> PGBinaryValue -> a
binDecDatetime _ ff PGTypeEnv{ pgIntegerDatetimes = Just False } = binDec ff
binDecDatetime fi _ PGTypeEnv{ pgIntegerDatetimes = Just True } = binDec fi
binDecDatetime _ _ PGTypeEnv{ pgIntegerDatetimes = Nothing } = error
"pgDecodeBinary: unknown integer_datetimes value"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/postgresql-typed.cabal
new/postgresql-typed-0.5.1/postgresql-typed.cabal
--- old/postgresql-typed-0.5.0/postgresql-typed.cabal 2017-01-27
04:25:55.000000000 +0100
+++ new/postgresql-typed-0.5.1/postgresql-typed.cabal 2017-03-22
21:32:15.000000000 +0100
@@ -1,5 +1,5 @@
Name: postgresql-typed
-Version: 0.5.0
+Version: 0.5.1
Cabal-Version: >= 1.8
License: BSD3
License-File: COPYING
@@ -10,7 +10,7 @@
Bug-Reports: https://github.com/dylex/postgresql-typed/issues
Homepage: https://github.com/dylex/postgresql-typed
Category: Database
-Synopsis: A PostgreSQL library with compile-time SQL type inference and
optional HDBC backend
+Synopsis: PostgreSQL interface with compile-time SQL type checking,
optional HDBC backend
Description: Automatically type-check SQL statements at compile time.
Uses Template Haskell and the raw PostgreSQL protocol to
describe SQL statements at compile time and provide appropriate type
marshalling for both parameters and results.
Allows not only syntax verification of your SQL but also full
type safety between your SQL and Haskell.
@@ -117,6 +117,15 @@
type: exitcode-stdio-1.0
hs-source-dirs: test/hdbc, test
main-is: runtests.hs
+ other-modules:
+ Connect
+ SpecificDB
+ TestMisc
+ TestSbasics
+ TestTime
+ TestUtils
+ Testbasics
+ Tests
if flag(HDBC)
build-depends: base, network, time, containers, convertible,
postgresql-typed, HDBC, HUnit
else
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/Main.hs
new/postgresql-typed-0.5.1/test/Main.hs
--- old/postgresql-typed-0.5.0/test/Main.hs 2017-01-27 04:25:55.000000000
+0100
+++ new/postgresql-typed-0.5.1/test/Main.hs 2017-03-22 21:23:58.000000000
+0100
@@ -8,6 +8,7 @@
import Data.Char (isDigit, toUpper)
import Data.Int (Int32)
import qualified Data.Time as Time
+import Data.Word (Word8)
import System.Exit (exitSuccess, exitFailure)
import qualified Test.QuickCheck as Q
import Test.QuickCheck.Test (isSuccess)
@@ -96,12 +97,13 @@
preparedApply :: PGConnection -> Int32 -> IO [String]
preparedApply c = pgQuery c . [pgSQL|$(integer)SELECT typname FROM
pg_catalog.pg_type WHERE oid = $1|]
-selectProp :: PGConnection -> Bool -> Int32 -> Float -> Time.LocalTime ->
Time.UTCTime -> Time.Day -> Time.DiffTime -> Str -> [Maybe Str] -> Range.Range
Int32 -> MyEnum -> PGInet -> Q.Property
-selectProp c b i f t z d p s l r e a = Q.ioProperty $ do
- [(Just b', Just i', Just f', Just s', Just d', Just t', Just z', Just p',
Just l', Just r', Just e', Just a')] <- pgQuery c
- [pgSQL|$SELECT ${b}::bool, ${Just i}::int, ${f}::float4, ${strString
s}::varchar, ${Just d}::date, ${t}::timestamp, ${z}::timestamptz,
${p}::interval, ${map (fmap strByte) l}::text[], ${r}::int4range, ${e}::myenum,
${a}::inet|]
+selectProp :: PGConnection -> Bool -> Word8 -> Int32 -> Float ->
Time.LocalTime -> Time.UTCTime -> Time.Day -> Time.DiffTime -> Str -> [Maybe
Str] -> Range.Range Int32 -> MyEnum -> PGInet -> Q.Property
+selectProp pgc b c i f t z d p s l r e a = Q.ioProperty $ do
+ [(Just b', Just c', Just i', Just f', Just s', Just d', Just t', Just z',
Just p', Just l', Just r', Just e', Just a')] <- pgQuery pgc
+ [pgSQL|$SELECT ${b}::bool, ${c}::"char", ${Just i}::int, ${f}::float4,
${strString s}::varchar, ${Just d}::date, ${t}::timestamp, ${z}::timestamptz,
${p}::interval, ${map (fmap strByte) l}::text[], ${r}::int4range, ${e}::myenum,
${a}::inet|]
return $ Q.conjoin
[ i Q.=== i'
+ , c Q.=== c'
, b Q.=== b'
, strString s Q.=== s'
, f Q.=== f'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/SpecificDB.hs
new/postgresql-typed-0.5.1/test/hdbc/SpecificDB.hs
--- old/postgresql-typed-0.5.0/test/hdbc/SpecificDB.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/SpecificDB.hs 2016-08-06
16:56:46.000000000 +0200
@@ -0,0 +1,27 @@
+module SpecificDB where
+import Database.HDBC
+import Database.PostgreSQL.Typed.HDBC
+
+import Connect
+
+connectDB :: IO Connection
+connectDB =
+ handleSqlError (do dbh <- connect db
+ _ <- run dbh "SET client_min_messages=WARNING" []
+ return dbh)
+
+dateTimeTypeOfSqlValue :: SqlValue -> String
+dateTimeTypeOfSqlValue (SqlLocalDate _) = "date"
+dateTimeTypeOfSqlValue (SqlLocalTimeOfDay _) = "time without time zone"
+dateTimeTypeOfSqlValue (SqlZonedLocalTimeOfDay _ _) = "time with time zone"
+dateTimeTypeOfSqlValue (SqlLocalTime _) = "timestamp without time zone"
+dateTimeTypeOfSqlValue (SqlZonedTime _) = "timestamp with time zone"
+dateTimeTypeOfSqlValue (SqlUTCTime _) = "timestamp with time zone"
+dateTimeTypeOfSqlValue (SqlDiffTime _) = "interval"
+dateTimeTypeOfSqlValue (SqlPOSIXTime _) = "numeric"
+dateTimeTypeOfSqlValue (SqlEpochTime _) = "integer"
+dateTimeTypeOfSqlValue (SqlTimeDiff _) = "interval"
+dateTimeTypeOfSqlValue _ = "text"
+
+supportsFracTime :: Bool
+supportsFracTime = True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/TestMisc.hs
new/postgresql-typed-0.5.1/test/hdbc/TestMisc.hs
--- old/postgresql-typed-0.5.0/test/hdbc/TestMisc.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/TestMisc.hs 2016-08-06
04:15:14.000000000 +0200
@@ -0,0 +1,181 @@
+module TestMisc(tests, setup) where
+import Test.HUnit
+import Database.HDBC
+import TestUtils
+import System.IO
+import Control.Exception
+import Data.Char
+import Control.Monad
+import qualified Data.Map as Map
+
+rowdata =
+ [[SqlInt32 0, toSql "Testing", SqlNull],
+ [SqlInt32 1, toSql "Foo", SqlInt32 5],
+ [SqlInt32 2, toSql "Bar", SqlInt32 9]]
+
+colnames = ["testid", "teststring", "testint"]
+alrows :: [[(String, SqlValue)]]
+alrows = map (zip colnames) rowdata
+
+setup f = dbTestCase $ \dbh ->
+ do run dbh "CREATE TABLE hdbctest2 (testid INTEGER PRIMARY KEY NOT NULL,
teststring TEXT, testint INTEGER)" []
+ sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"
+ executeMany sth rowdata
+ finish sth
+ commit dbh
+ finally (f dbh)
+ (do run dbh "DROP TABLE hdbctest2" []
+ commit dbh
+ )
+
+cloneTest dbh a =
+ do dbh2 <- clone dbh
+ finally (handleSqlError (a dbh2))
+ (handleSqlError (disconnect dbh2))
+
+testgetColumnNames = setup $ \dbh ->
+ do sth <- prepare dbh "SELECT * from hdbctest2"
+ execute sth []
+ cols <- getColumnNames sth
+ finish sth
+ ["testid", "teststring", "testint"] @=? map (map toLower) cols
+
+testdescribeResult = setup $ \dbh -> when (not ((hdbcDriverName dbh) `elem`
+ ["sqlite3"])) $
+ do sth <- prepare dbh "SELECT * from hdbctest2"
+ execute sth []
+ cols <- describeResult sth
+ ["testid", "teststring", "testint"] @=? map (map toLower . fst) cols
+ let coldata = map snd cols
+ assertBool "r0 type" (colType (coldata !! 0) `elem`
+ [SqlBigIntT, SqlIntegerT])
+ assertBool "r1 type" (colType (coldata !! 1) `elem`
+ [SqlVarCharT, SqlLongVarCharT])
+ assertBool "r2 type" (colType (coldata !! 2) `elem`
+ [SqlBigIntT, SqlIntegerT])
+ finish sth
+
+testdescribeTable = setup $ \dbh -> when (not ((hdbcDriverName dbh) `elem`
+ ["sqlite3"])) $
+ do cols <- describeTable dbh "hdbctest2"
+ ["testid", "teststring", "testint"] @=? map (map toLower . fst) cols
+ let coldata = map snd cols
+ assertBool "r0 type" (colType (coldata !! 0) `elem`
+ [SqlBigIntT, SqlIntegerT])
+ assertEqual "r0 nullable" (Just False) (colNullable (coldata !! 0))
+ assertBool "r1 type" (colType (coldata !! 1) `elem`
+ [SqlVarCharT, SqlLongVarCharT])
+ assertEqual "r1 nullable" (Just True) (colNullable (coldata !! 1))
+ assertBool "r2 type" (colType (coldata !! 2) `elem`
+ [SqlBigIntT, SqlIntegerT])
+ assertEqual "r2 nullable" (Just True) (colNullable (coldata !! 2))
+
+testquickQuery = setup $ \dbh ->
+ do results <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []
+ rowdata @=? results
+
+testfetchRowAL = setup $ \dbh ->
+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"
+ execute sth []
+ fetchRowAL sth >>= (Just (head alrows) @=?)
+ fetchRowAL sth >>= (Just (alrows !! 1) @=?)
+ fetchRowAL sth >>= (Just (alrows !! 2) @=?)
+ fetchRowAL sth >>= (Nothing @=?)
+ finish sth
+
+testfetchRowMap = setup $ \dbh ->
+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"
+ execute sth []
+ fetchRowMap sth >>= (Just (Map.fromList $ head alrows) @=?)
+ fetchRowMap sth >>= (Just (Map.fromList $ alrows !! 1) @=?)
+ fetchRowMap sth >>= (Just (Map.fromList $ alrows !! 2) @=?)
+ fetchRowMap sth >>= (Nothing @=?)
+ finish sth
+
+testfetchAllRowsAL = setup $ \dbh ->
+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"
+ execute sth []
+ fetchAllRowsAL sth >>= (alrows @=?)
+
+testfetchAllRowsMap = setup $ \dbh ->
+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"
+ execute sth []
+ fetchAllRowsMap sth >>= (map (Map.fromList) alrows @=?)
+
+testexception = setup $ \dbh ->
+ catchSql (do sth <- prepare dbh "SELECT invalidcol FROM hdbctest2"
+ execute sth []
+ assertFailure "No exception was raised"
+ )
+ (\e -> commit dbh)
+
+testrowcount = setup $ \dbh ->
+ do r <- run dbh "UPDATE hdbctest2 SET testint = 25 WHERE testid = 20" []
+ assertEqual "UPDATE with no change" 0 r
+ r <- run dbh "UPDATE hdbctest2 SET testint = 26 WHERE testid = 0" []
+ assertEqual "UPDATE with 1 change" 1 r
+ r <- run dbh "UPDATE hdbctest2 SET testint = 27 WHERE testid <> 0" []
+ assertEqual "UPDATE with 2 changes" 2 r
+ commit dbh
+ res <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []
+ assertEqual "final results"
+ [[SqlInt32 0, toSql "Testing", SqlInt32 26],
+ [SqlInt32 1, toSql "Foo", SqlInt32 27],
+ [SqlInt32 2, toSql "Bar", SqlInt32 27]] res
+
+{- Since we might be running against a live DB, we can't look at a specific
+list here (though a SpecificDB test case may be able to). We can ensure
+that our test table is, or is not, present, as appropriate. -}
+
+testgetTables1 = setup $ \dbh ->
+ do r <- getTables dbh
+ True @=? "hdbctest2" `elem` r
+
+testgetTables2 = dbTestCase $ \dbh ->
+ do r <- getTables dbh
+ False @=? "hdbctest2" `elem` r
+
+testclone = setup $ \dbho -> cloneTest dbho $ \dbh ->
+ do results <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []
+ rowdata @=? results
+
+testnulls = setup $ \dbh ->
+ do let dn = hdbcDriverName dbh
+ when (not (dn `elem` ["postgresql", "odbc", "postgresql-typed"])) (
+ do sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"
+ executeMany sth rows
+ finish sth
+ res <- quickQuery dbh "SELECT * from hdbctest2 WHERE testid > 99
ORDER BY testid" []
+ seq (length res) rows @=? res
+ )
+ where rows = [[SqlInt32 100, SqlString "foo\NULbar", SqlNull],
+ [SqlInt32 101, SqlString "bar\NUL", SqlNull],
+ [SqlInt32 102, SqlString "\NUL", SqlNull],
+ [SqlInt32 103, SqlString "\xFF", SqlNull],
+ [SqlInt32 104, SqlString "regular", SqlNull]]
+
+testunicode = setup $ \dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"
+ executeMany sth rows
+ finish sth
+ res <- quickQuery dbh "SELECT * from hdbctest2 WHERE testid > 99
ORDER BY testid" []
+ seq (length res) rows @=? res
+ where rows = [[SqlInt32 100, SqlString "foo\x263a", SqlNull],
+ [SqlInt32 101, SqlString "bar\x00A3", SqlNull],
+ [SqlInt32 102, SqlString (take 263 (repeat 'a')), SqlNull]]
+
+tests = TestList [TestLabel "getColumnNames" testgetColumnNames,
+ TestLabel "describeResult" testdescribeResult,
+ TestLabel "describeTable" testdescribeTable,
+ TestLabel "quickQuery" testquickQuery,
+ TestLabel "fetchRowAL" testfetchRowAL,
+ TestLabel "fetchRowMap" testfetchRowMap,
+ TestLabel "fetchAllRowsAL" testfetchAllRowsAL,
+ TestLabel "fetchAllRowsMap" testfetchAllRowsMap,
+ TestLabel "sql exception" testexception,
+ TestLabel "clone" testclone,
+ TestLabel "update rowcount" testrowcount,
+ TestLabel "get tables1" testgetTables1,
+ TestLabel "get tables2" testgetTables2,
+ TestLabel "nulls" testnulls,
+ TestLabel "unicode" testunicode]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/TestSbasics.hs
new/postgresql-typed-0.5.1/test/hdbc/TestSbasics.hs
--- old/postgresql-typed-0.5.0/test/hdbc/TestSbasics.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/TestSbasics.hs 2016-08-05
05:07:32.000000000 +0200
@@ -0,0 +1,170 @@
+module TestSbasics(tests) where
+import Test.HUnit
+import Data.List
+import Database.HDBC
+import TestUtils
+import Control.Exception
+
+openClosedb = sqlTestCase $
+ do dbh <- connectDB
+ disconnect dbh
+
+multiFinish = dbTestCase (\dbh ->
+ do sth <- prepare dbh "SELECT 1 + 1"
+ sExecute sth []
+ finish sth
+ finish sth
+ finish sth
+ )
+
+runRawTest = dbTestCase (\dbh ->
+ do runRaw dbh "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int)"
+ tables <- getTables dbh
+ assertBool "valid1 table not created!" ("valid1" `elem` tables)
+ assertBool "valid2 table not created!" ("valid2" `elem` tables)
+ )
+
+runRawErrorTest = dbTestCase (\dbh ->
+ let expected = "ERROR: syntax error at or near \"INVALID\""
+ in do err <- (runRaw dbh "CREATE TABLE valid1 (a int); INVALID" >> return
"No error") `catchSql`
+ (return . seErrorMsg)
+ assertBool "Error message inappropriate" (expected `isPrefixOf` err)
+ rollback dbh
+ tables <- getTables dbh
+ assertBool "valid1 table created!" (not $ "valid1" `elem` tables)
+ )
+
+
+basicQueries = dbTestCase (\dbh ->
+ do sth <- prepare dbh "SELECT 1 + 1"
+ sExecute sth []
+ sFetchRow sth >>= (assertEqual "row 1" (Just [Just "2"]))
+ sFetchRow sth >>= (assertEqual "last row" Nothing)
+ )
+
+createTable = dbTestCase (\dbh ->
+ do sRun dbh "CREATE TABLE hdbctest1 (testname VARCHAR(20), testid INTEGER,
testint INTEGER, testtext TEXT)" []
+ commit dbh
+ )
+
+dropTable = dbTestCase (\dbh ->
+ do sRun dbh "DROP TABLE hdbctest1" []
+ commit dbh
+ )
+
+runReplace = dbTestCase (\dbh ->
+ do sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r1
+ sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, 2, ?)" r2
+ commit dbh
+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname =
'runReplace' ORDER BY testid"
+ sExecute sth []
+ sFetchRow sth >>= (assertEqual "r1" (Just r1))
+ sFetchRow sth >>= (assertEqual "r2" (Just [Just "runReplace", Just "2",
+ Just "2", Nothing]))
+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)
+ )
+ where r1 = [Just "runReplace", Just "1", Just "1234", Just "testdata"]
+ r2 = [Just "runReplace", Just "2", Nothing]
+
+executeReplace = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES
('executeReplace',?,?,?)"
+ sExecute sth [Just "1", Just "1234", Just "Foo"]
+ sExecute sth [Just "2", Nothing, Just "Bar"]
+ commit dbh
+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = ? ORDER BY
testid"
+ sExecute sth [Just "executeReplace"]
+ sFetchRow sth >>= (assertEqual "r1"
+ (Just $ map Just ["executeReplace", "1", "1234",
+ "Foo"]))
+ sFetchRow sth >>= (assertEqual "r2"
+ (Just [Just "executeReplace", Just "2", Nothing,
+ Just "Bar"]))
+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)
+ )
+
+testExecuteMany = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('multi',?,?,?)"
+ sExecuteMany sth rows
+ commit dbh
+ sth <- prepare dbh "SELECT testid, testint, testtext FROM hdbctest1
WHERE testname = 'multi'"
+ sExecute sth []
+ mapM_ (\r -> sFetchRow sth >>= (assertEqual "" (Just r))) rows
+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)
+ )
+ where rows = [map Just ["1", "1234", "foo"],
+ map Just ["2", "1341", "bar"],
+ [Just "3", Nothing, Nothing]]
+
+testsFetchAllRows = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('sFetchAllRows', ?,
NULL, NULL)"
+ sExecuteMany sth rows
+ commit dbh
+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'sFetchAllRows' ORDER BY testid"
+ sExecute sth []
+ results <- sFetchAllRows sth
+ assertEqual "" rows results
+ )
+ where rows = map (\x -> [Just . show $ x]) [1..9]
+
+basicTransactions = dbTestCase (\dbh ->
+ do assertBool "Connected database does not support transactions; skipping
transaction test" (dbTransactionSupport dbh)
+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('basicTransactions',
?, NULL, NULL)"
+ sExecute sth [Just "0"]
+ commit dbh
+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'basicTransactions' ORDER BY testid"
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])
+
+ -- Now try a rollback
+ sExecuteMany sth rows
+ rollback dbh
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])
+
+ -- Now try another commit
+ sExecuteMany sth rows
+ commit dbh
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))
+ )
+ where rows = map (\x -> [Just . show $ x]) [1..9]
+
+testWithTransaction = dbTestCase (\dbh ->
+ do assertBool "Connected database does not support transactions; skipping
transaction test" (dbTransactionSupport dbh)
+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('withTransaction', ?,
NULL, NULL)"
+ sExecute sth [Just "0"]
+ commit dbh
+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'withTransaction' ORDER BY testid"
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])
+
+ -- Let's try a rollback.
+ catch (withTransaction dbh (\_ -> do sExecuteMany sth rows
+ fail "Foo"))
+ (\SomeException{} -> return ())
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])
+
+ -- And now a commit.
+ withTransaction dbh (\_ -> sExecuteMany sth rows)
+ sExecute qrysth []
+ sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))
+ )
+ where rows = map (\x -> [Just . show $ x]) [1..9]
+
+tests = TestList
+ [
+ TestLabel "openClosedb" openClosedb,
+ TestLabel "multiFinish" multiFinish,
+ TestLabel "runRawTest" runRawTest,
+ TestLabel "runRawErrorTest" runRawErrorTest,
+ TestLabel "basicQueries" basicQueries,
+ TestLabel "createTable" createTable,
+ TestLabel "runReplace" runReplace,
+ TestLabel "executeReplace" executeReplace,
+ TestLabel "executeMany" testExecuteMany,
+ TestLabel "sFetchAllRows" testsFetchAllRows,
+ TestLabel "basicTransactions" basicTransactions,
+ TestLabel "withTransaction" testWithTransaction,
+ TestLabel "dropTable" dropTable
+ ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/TestTime.hs
new/postgresql-typed-0.5.1/test/hdbc/TestTime.hs
--- old/postgresql-typed-0.5.0/test/hdbc/TestTime.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/TestTime.hs 2016-08-05
04:03:58.000000000 +0200
@@ -0,0 +1,97 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module TestTime(tests) where
+import Test.HUnit
+import Database.HDBC
+import TestUtils
+import Control.Exception
+import Data.Time (UTCTime, Day, NominalDiffTime)
+import Data.Time.LocalTime
+import Data.Time.Clock.POSIX
+import Data.Maybe
+import Data.Convertible
+import SpecificDB
+import Data.Time (parseTimeM, defaultTimeLocale, TimeLocale)
+import Database.HDBC.Locale (iso8601DateFormat)
+
+instance Eq ZonedTime where
+ a == b = zonedTimeToUTC a == zonedTimeToUTC b
+
+testZonedTime :: ZonedTime
+testZonedTime = fromJust $ parseTime' defaultTimeLocale (iso8601DateFormat
(Just "%T %z"))
+ "1989-08-01 15:33:01 -0500"
+
+testZonedTimeFrac :: ZonedTime
+testZonedTimeFrac = fromJust $ parseTime' defaultTimeLocale (iso8601DateFormat
(Just "%T%Q %z"))
+ "1989-08-01 15:33:01.536 -0500"
+
+
+testDTType :: (Convertible SqlValue a, Show b, Eq b) =>
+ a
+ -> (a -> SqlValue)
+ -> (a -> b)
+ -> Test
+testDTType inputdata convToSqlValue toComparable = dbTestCase $ \dbh ->
+ do _ <- run dbh ("CREATE TABLE hdbctesttime (testid INTEGER PRIMARY KEY
NOT NULL, testvalue " ++ dateTimeTypeOfSqlValue value ++ ")") []
+ commit dbh
+ finally (testDT dbh) (do commit dbh
+ _ <- run dbh "DROP TABLE hdbctesttime" []
+ commit dbh
+ )
+ where testDT dbh =
+ do _ <- run dbh "INSERT INTO hdbctesttime (testid, testvalue)
VALUES (?, ?)"
+ [iToSql 5, value]
+ commit dbh
+ r <- quickQuery' dbh "SELECT testid, testvalue FROM
hdbctesttime" []
+ case r of
+ ~[[testidsv, testvaluesv]] ->
+ do assertEqual "testid" (5::Int) (fromSql testidsv)
+ assertEqual "testvalue"
+ (toComparable inputdata)
+ (toComparable$ fromSql testvaluesv)
+ value = convToSqlValue inputdata
+
+mkTest :: (Eq b, Show b, Convertible SqlValue a) => String -> a -> (a ->
SqlValue) -> (a -> b) -> Test
+mkTest label inputdata convfunc toComparable =
+ TestLabel label (testDTType inputdata convfunc toComparable)
+
+tests :: Test
+tests = TestList $
+ ((TestLabel "Non-frac" $ testIt testZonedTime) :
+ if supportsFracTime then [TestLabel "Frac" $ testIt testZonedTimeFrac]
else [])
+
+testIt :: ZonedTime -> Test
+testIt baseZonedTime =
+ TestList [ mkTest "Day" baseDay toSql id
+ , mkTest "TimeOfDay" baseTimeOfDay toSql id
+ , mkTest "ZonedTimeOfDay" baseZonedTimeOfDay toSql id
+ , mkTest "LocalTime" baseLocalTime toSql id
+ , mkTest "ZonedTime" baseZonedTime toSql id
+ , mkTest "UTCTime" baseUTCTime toSql id
+ , mkTest "DiffTime" baseDiffTime toSql id
+ , mkTest "POSIXTime" basePOSIXTime posixToSql id
+ ]
+ where
+ baseDay :: Day
+ baseDay = localDay baseLocalTime
+
+ baseTimeOfDay :: TimeOfDay
+ baseTimeOfDay = localTimeOfDay baseLocalTime
+
+ baseZonedTimeOfDay :: (TimeOfDay, TimeZone)
+ baseZonedTimeOfDay = fromSql (SqlZonedTime baseZonedTime)
+
+ baseLocalTime :: LocalTime
+ baseLocalTime = zonedTimeToLocalTime baseZonedTime
+
+ baseUTCTime :: UTCTime
+ baseUTCTime = convert baseZonedTime
+
+ baseDiffTime :: NominalDiffTime
+ baseDiffTime = basePOSIXTime
+
+ basePOSIXTime :: POSIXTime
+ basePOSIXTime = convert baseZonedTime
+
+parseTime' :: TimeLocale -> String -> String -> Maybe ZonedTime
+parseTime' = parseTimeM True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/TestUtils.hs
new/postgresql-typed-0.5.1/test/hdbc/TestUtils.hs
--- old/postgresql-typed-0.5.0/test/hdbc/TestUtils.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/TestUtils.hs 2016-08-05
03:06:00.000000000 +0200
@@ -0,0 +1,29 @@
+module TestUtils(connectDB, sqlTestCase, dbTestCase, printDBInfo) where
+import Database.HDBC
+import Database.PostgreSQL.Typed.HDBC
+import Test.HUnit
+import Control.Exception
+import SpecificDB(connectDB)
+
+sqlTestCase :: IO () -> Test
+sqlTestCase a =
+ TestCase (handleSqlError a)
+
+dbTestCase :: (Connection -> IO ()) -> Test
+dbTestCase a =
+ TestCase (do dbh <- connectDB
+ finally (handleSqlError (a dbh))
+ (handleSqlError (disconnect dbh))
+ )
+
+printDBInfo :: IO ()
+printDBInfo = handleSqlError $
+ do dbh <- connectDB
+ putStrLn
"+-------------------------------------------------------------------------"
+ putStrLn $ "| Testing HDBC database module: " ++ hdbcDriverName dbh ++
+ ", bound to client: " ++ hdbcClientVer dbh
+ putStrLn $ "| Proxied driver: " ++ proxiedClientName dbh ++
+ ", bound to version: " ++ proxiedClientVer dbh
+ putStrLn $ "| Connected to server version: " ++ dbServerVer dbh
+ putStrLn
"+-------------------------------------------------------------------------\n"
+ disconnect dbh
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/Testbasics.hs
new/postgresql-typed-0.5.1/test/hdbc/Testbasics.hs
--- old/postgresql-typed-0.5.0/test/hdbc/Testbasics.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/Testbasics.hs 2016-08-05
04:04:04.000000000 +0200
@@ -0,0 +1,168 @@
+module Testbasics(tests) where
+import Test.HUnit
+import Database.HDBC
+import TestUtils
+import System.IO
+import Control.Exception
+
+openClosedb = sqlTestCase $
+ do dbh <- connectDB
+ disconnect dbh
+
+multiFinish = dbTestCase (\dbh ->
+ do sth <- prepare dbh "SELECT 1 + 1"
+ r <- execute sth []
+ assertEqual "basic count" 0 r
+ finish sth
+ finish sth
+ finish sth
+ )
+
+basicQueries = dbTestCase (\dbh ->
+ do sth <- prepare dbh "SELECT 1 + 1"
+ execute sth [] >>= (0 @=?)
+ r <- fetchAllRows sth
+ assertEqual "converted from" [["2"]] (map (map fromSql) r)
+ assertEqual "int32 compare" [[SqlInt32 2]] r
+ assertEqual "iToSql compare" [[iToSql 2]] r
+ assertEqual "num compare" [[toSql (2::Int)]] r
+ assertEqual "nToSql compare" [[nToSql (2::Int)]] r
+ assertEqual "string compare" [[SqlString "2"]] r
+ )
+
+createTable = dbTestCase (\dbh ->
+ do run dbh "CREATE TABLE hdbctest1 (testname VARCHAR(20), testid INTEGER,
testint INTEGER, testtext TEXT)" []
+ commit dbh
+ )
+
+dropTable = dbTestCase (\dbh ->
+ do run dbh "DROP TABLE hdbctest1" []
+ commit dbh
+ )
+
+runReplace = dbTestCase (\dbh ->
+ do r <- run dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r1
+ assertEqual "insert retval" 1 r
+ run dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r2
+ commit dbh
+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname =
'runReplace' ORDER BY testid"
+ rv2 <- execute sth []
+ assertEqual "select retval" 0 rv2
+ r <- fetchAllRows sth
+ assertEqual "" [r1, r2] r
+ )
+ where r1 = [toSql "runReplace", iToSql 1, iToSql 1234, SqlString
"testdata"]
+ r2 = [toSql "runReplace", iToSql 2, iToSql 2, SqlNull]
+
+executeReplace = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES
('executeReplace',?,?,?)"
+ execute sth [iToSql 1, iToSql 1234, toSql "Foo"]
+ execute sth [SqlInt32 2, SqlNull, toSql "Bar"]
+ commit dbh
+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = ? ORDER BY
testid"
+ execute sth [SqlString "executeReplace"]
+ r <- fetchAllRows sth
+ assertEqual "result"
+ [[toSql "executeReplace", iToSql 1, toSql "1234",
+ toSql "Foo"],
+ [toSql "executeReplace", iToSql 2, SqlNull,
+ toSql "Bar"]]
+ r
+ )
+
+testExecuteMany = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('multi',?,?,?)"
+ executeMany sth rows
+ commit dbh
+ sth <- prepare dbh "SELECT testid, testint, testtext FROM hdbctest1
WHERE testname = 'multi'"
+ execute sth []
+ r <- fetchAllRows sth
+ assertEqual "" rows r
+ )
+ where rows = [map toSql ["1", "1234", "foo"],
+ map toSql ["2", "1341", "bar"],
+ [toSql "3", SqlNull, SqlNull]]
+
+testFetchAllRows = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('sFetchAllRows', ?,
NULL, NULL)"
+ executeMany sth rows
+ commit dbh
+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'sFetchAllRows' ORDER BY testid"
+ execute sth []
+ results <- fetchAllRows sth
+ assertEqual "" rows results
+ )
+ where rows = map (\x -> [iToSql x]) [1..9]
+
+testFetchAllRows' = dbTestCase (\dbh ->
+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('sFetchAllRows2', ?,
NULL, NULL)"
+ executeMany sth rows
+ commit dbh
+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'sFetchAllRows2' ORDER BY testid"
+ execute sth []
+ results <- fetchAllRows' sth
+ assertEqual "" rows results
+ )
+ where rows = map (\x -> [iToSql x]) [1..9]
+
+basicTransactions = dbTestCase (\dbh ->
+ do assertBool "Connected database does not support transactions; skipping
transaction test" (dbTransactionSupport dbh)
+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('basicTransactions',
?, NULL, NULL)"
+ execute sth [iToSql 0]
+ commit dbh
+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'basicTransactions' ORDER BY testid"
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "initial commit" [[toSql "0"]])
+
+ -- Now try a rollback
+ executeMany sth rows
+ rollback dbh
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "rollback" [[toSql "0"]])
+
+ -- Now try another commit
+ executeMany sth rows
+ commit dbh
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "final commit" ([SqlString
"0"]:rows))
+ )
+ where rows = map (\x -> [iToSql $ x]) [1..9]
+
+testWithTransaction = dbTestCase (\dbh ->
+ do assertBool "Connected database does not support transactions; skipping
transaction test" (dbTransactionSupport dbh)
+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('withTransaction', ?,
NULL, NULL)"
+ execute sth [toSql "0"]
+ commit dbh
+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname =
'withTransaction' ORDER BY testid"
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "initial commit" [[toSql "0"]])
+
+ -- Let's try a rollback.
+ catch (withTransaction dbh (\_ -> do executeMany sth rows
+ fail "Foo"))
+ (\SomeException{} -> return ())
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "rollback" [[SqlString "0"]])
+
+ -- And now a commit.
+ withTransaction dbh (\_ -> executeMany sth rows)
+ execute qrysth []
+ fetchAllRows qrysth >>= (assertEqual "final commit" ([iToSql 0]:rows))
+ )
+ where rows = map (\x -> [iToSql x]) [1..9]
+
+tests = TestList
+ [
+ TestLabel "openClosedb" openClosedb,
+ TestLabel "multiFinish" multiFinish,
+ TestLabel "basicQueries" basicQueries,
+ TestLabel "createTable" createTable,
+ TestLabel "runReplace" runReplace,
+ TestLabel "executeReplace" executeReplace,
+ TestLabel "executeMany" testExecuteMany,
+ TestLabel "fetchAllRows" testFetchAllRows,
+ TestLabel "fetchAllRows'" testFetchAllRows',
+ TestLabel "basicTransactions" basicTransactions,
+ TestLabel "withTransaction" testWithTransaction,
+ TestLabel "dropTable" dropTable
+ ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-typed-0.5.0/test/hdbc/Tests.hs
new/postgresql-typed-0.5.1/test/hdbc/Tests.hs
--- old/postgresql-typed-0.5.0/test/hdbc/Tests.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/postgresql-typed-0.5.1/test/hdbc/Tests.hs 2016-08-05
05:26:10.000000000 +0200
@@ -0,0 +1,19 @@
+{- arch-tag: Tests main file
+-}
+
+module Tests(tests) where
+import Test.HUnit
+import qualified Testbasics
+import qualified TestSbasics
+import qualified TestMisc
+import qualified TestTime
+
+test1 = TestCase ("x" @=? "x")
+
+tests = TestList
+ [ TestLabel "test1" test1
+ , TestLabel "String basics" TestSbasics.tests
+ , TestLabel "SqlValue basics" Testbasics.tests
+ , TestLabel "Misc tests" TestMisc.tests
+ , TestLabel "Time tests" TestTime.tests
+ ]
