ed4b1c5...master · typeable/postgresql-simple

.github/workflows/haskell-ci.yml+22−15

since splitsnapshots

unifiedsplit

@@ -8,9 +8,9 @@

8#

9# For more information, see https://github.com/haskell-CI/haskell-ci

10#

11−# version: 0.16.6

11+# version: 0.17.20231110

12#

13−# REGENDATA ("0.16.6",["github","cabal.project"])

13+# REGENDATA ("0.17.20231110",["github","cabal.project"])

14#

15name: Haskell-CI

16on:

@@ -38,14 +38,19 @@ jobs:

38 strategy:

39 matrix:

40 include:

41− - compiler: ghc-9.6.2

41+ - compiler: ghc-9.8.1

42 compilerKind: ghc

43− compilerVersion: 9.6.2

43+ compilerVersion: 9.8.1

44 setup-method: ghcup

45 allow-failure: false

46− - compiler: ghc-9.4.5

46+ - compiler: ghc-9.6.3

47 compilerKind: ghc

48− compilerVersion: 9.4.5

48+ compilerVersion: 9.6.3

49+ setup-method: ghcup

50+ allow-failure: false

51+ - compiler: ghc-9.4.8

52+ compilerKind: ghc

53+ compilerVersion: 9.4.8

49 setup-method: ghcup

54 setup-method: ghcup

50 allow-failure: false

55 allow-failure: false

51 - compiler: ghc-9.2.8

56 - compiler: ghc-9.2.8

@@ -81,18 +86,18 @@ jobs:

81 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

86 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

82 if [ "${{ matrix.setup-method }}" = ghcup ]; then

87 if [ "${{ matrix.setup-method }}" = ghcup ]; then

83 mkdir -p "$HOME/.ghcup/bin"

88 mkdir -p "$HOME/.ghcup/bin"

84− curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"

89+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

85 chmod a+x "$HOME/.ghcup/bin/ghcup"

90 chmod a+x "$HOME/.ghcup/bin/ghcup"

86 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

91 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

87− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

92+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

88 else

93 else

89 apt-add-repository -y 'ppa:hvr/ghc'

94 apt-add-repository -y 'ppa:hvr/ghc'

90 apt-get update

95 apt-get update

91 apt-get install -y "$HCNAME"

96 apt-get install -y "$HCNAME"

92 mkdir -p "$HOME/.ghcup/bin"

97 mkdir -p "$HOME/.ghcup/bin"

93− curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"

98+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

94 chmod a+x "$HOME/.ghcup/bin/ghcup"

99 chmod a+x "$HOME/.ghcup/bin/ghcup"

95− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

100+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

96 fi

101 fi

97 env:

102 env:

98 HCKIND: ${{ matrix.compilerKind }}

103 HCKIND: ${{ matrix.compilerKind }}

@@ -106,17 +111,19 @@ jobs:

106 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

111 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

107 HCDIR=/opt/$HCKIND/$HCVER

112 HCDIR=/opt/$HCKIND/$HCVER

108 if [ "${{ matrix.setup-method }}" = ghcup ]; then

113 if [ "${{ matrix.setup-method }}" = ghcup ]; then

109− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER

114+ HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

115+ HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

116+ HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

110 echo "HC=$HC" >> "$GITHUB_ENV"

117 echo "HC=$HC" >> "$GITHUB_ENV"

111− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

118+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

112− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

119+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

113− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

120+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

114 else

121 else

115 HC=$HCDIR/bin/$HCKIND

122 HC=$HCDIR/bin/$HCKIND

116 echo "HC=$HC" >> "$GITHUB_ENV"

123 echo "HC=$HC" >> "$GITHUB_ENV"

117 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

124 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

118 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

125 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

119− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

126+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

120 fi

127 fi

121

128

122 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

129 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

.github/workflows/simple.yml+2−2

@@ -14,7 +14,7 @@ jobs:

14 strategy:

15 matrix:

16 os: [macos-latest, windows-latest]

17− ghc: ['8.10','9.0','9.2','9.4.5','9.6.2']

17+ ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']

18 fail-fast: false

19 timeout-minutes:

20 60

@@ -29,7 +29,7 @@ jobs:

29 uses: haskell/actions/setup@v2

30 with:

31 ghc-version: ${{ matrix.ghc }}

32− cabal-version: '3.10.1.0'

32+ cabal-version: '3.10.2.0'

33

34 - name: Set up PostgreSQL

35 uses: ikalnytskyi/action-setup-postgres@v3

CHANGES.md+3

@@ -4,6 +4,9 @@

4 * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,

5 by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.

6 * Drop support for GHC prior 8.6

7+ * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.

8+ This allows to catch all `postgresql-simple` exceptions at once.

9+ (c.f. `AsyncException` in `base).

7

10

8### Version 0.6.5.1 (2023-07-09)

11### Version 0.6.5.1 (2023-07-09)

9

12

postgresql-simple.cabal+19−16

@@ -1,6 +1,7 @@

1cabal-version: 1.12

2name: postgresql-simple

3version: 0.7.0.0

4+x-revision: 1

4synopsis: Mid-Level PostgreSQL client library

5synopsis: Mid-Level PostgreSQL client library

5description:

6description:

6 Mid-Level PostgreSQL client library, forked from mysql-simple.

7 Mid-Level PostgreSQL client library, forked from mysql-simple.

@@ -28,8 +29,9 @@ tested-with:

28 || ==8.10.7

29 || ==8.10.7

29 || ==9.0.2

30 || ==9.0.2

30 || ==9.2.8

31 || ==9.2.8

31− || ==9.4.5

32+ || ==9.4.8

32− || ==9.6.2

33+ || ==9.6.3

34+ || ==9.8.1

33

35

34library

36library

35 default-language: Haskell2010

37 default-language: Haskell2010

@@ -75,25 +77,25 @@ library

75

77

76 -- GHC bundled libs

78 -- GHC bundled libs

77 build-depends:

79 build-depends:

78− base >=4.12.0.0 && <4.19

80+ base >=4.12.0.0 && <4.20

79− , bytestring >=0.10.8.2 && <0.12

81+ , bytestring >=0.10.8.2 && <0.13

80 , containers >=0.6.0.1 && <0.7

82 , containers >=0.6.0.1 && <0.7

81− , template-haskell >=2.14.0.0 && <2.21

83+ , template-haskell >=2.14.0.0 && <2.22

82− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1

84+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

83 , time-compat >=1.9.5 && <1.12

85 , time-compat >=1.9.5 && <1.12

84 , transformers >=0.5.6.2 && <0.7

86 , transformers >=0.5.6.2 && <0.7

85

87

86 -- Other dependencies

88 -- Other dependencies

87 build-depends:

89 build-depends:

88− aeson >=1.4.1.0 && <1.6 || >=2.0.0.0 && <2.3

90+ aeson >=2.1.2.1 && <2.3

89− , attoparsec >=0.13.2.2 && <0.15

91+ , attoparsec >=0.14.4 && <0.15

90− , case-insensitive >=1.2.0.11 && <1.3

92+ , case-insensitive >=1.2.1.0 && <1.3

91− , hashable >=1.2.7.0 && <1.5

93+ , hashable >=1.4.3.0 && <1.5

92− , Only >=0.1 && <0.1.1

94+ , Only >=0.1 && <0.1.1

93− , postgresql-libpq >=0.10.0.0 && <0.11

95+ , postgresql-libpq >=0.10.0.0 && <0.11

94− , scientific >=0.3.6.2 && <0.4

96+ , scientific >=0.3.7.0 && <0.4

95− , uuid-types >=1.0.3 && <1.1

97+ , uuid-types >=1.0.5 && <1.1

96− , vector >=0.12.0.1 && <0.14

98+ , vector >=0.13.0.0 && <0.14

97

99

98 default-extensions:

100 default-extensions:

99 BangPatterns

101 BangPatterns

@@ -128,10 +130,11 @@ test-suite test

128 main-is: Main.hs

130 main-is: Main.hs

129 other-modules:

131 other-modules:

130 Common

132 Common

133+ Exception

134+ Interval

131 Notify

135 Notify

132 Serializable

136 Serializable

133 Time

137 Time

134− Interval

135

138

136 ghc-options: -threaded

139 ghc-options: -threaded

137 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

140 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

src/Database/PostgreSQL/Simple.hs+1

@@ -64,6 +64,7 @@ module Database.PostgreSQL.Simple

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67+ , SomePostgreSqlException(..)

67 , SqlError(..)

68 , SqlError(..)

68 , PQ.ExecStatus(..)

69 , PQ.ExecStatus(..)

69 , FormatError(..)

70 , FormatError(..)

src/Database/PostgreSQL/Simple/Errors.hs+3−1

@@ -59,7 +59,9 @@ data ConstraintViolation

59 deriving (Show, Eq, Ord, Typeable)

60

61-- Default instance should be enough

62−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

63

65

64

66

65-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

67-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

src/Database/PostgreSQL/Simple/FromField.hs+4−6

@@ -118,7 +118,7 @@ module Database.PostgreSQL.Simple.FromField

118

119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )

120import Control.Concurrent.MVar (MVar, newMVar)

121−import Control.Exception (Exception)

121+import Control.Exception (Exception (toException, fromException))

122import qualified Data.Aeson as JSON

123import Data.Attoparsec.ByteString.Char8 hiding (Result)

124import Data.ByteString (ByteString)

@@ -154,11 +154,7 @@ import qualified Data.UUID.Types as UUID

154import Data.Scientific (Scientific)

155import GHC.Real (infinity, notANumber)

156

157−#if MIN_VERSION_aeson(2,1,2)

158import qualified Data.Aeson.Types as JSON

157import qualified Data.Aeson.Types as JSON

159−#else

160−import qualified Data.Aeson.Internal as JSON

161−#endif

162

158

163-- | Exception thrown if conversion from a SQL value to a Haskell

159-- | Exception thrown if conversion from a SQL value to a Haskell

164-- value fails.

160-- value fails.

@@ -186,7 +182,9 @@ data ResultError = Incompatible { errSQLType :: String

186 -- between metadata and actual data in a row).

182 -- between metadata and actual data in a row).

187 deriving (Eq, Show, Typeable)

183 deriving (Eq, Show, Typeable)

188

184

189−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

190

188

191left :: Exception a => a -> Conversion b

189left :: Exception a => a -> Conversion b

192left = conversionError

190left = conversionError

src/Database/PostgreSQL/Simple/Internal.hs+31−3

@@ -1,6 +1,8 @@

1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}

2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

4

6

5------------------------------------------------------------------------------

7------------------------------------------------------------------------------

6-- |

8-- |

@@ -81,6 +83,25 @@ data Connection = Connection {

81instance Eq Connection where

83instance Eq Connection where

82 x == y = connectionHandle x == connectionHandle y

84 x == y = connectionHandle x == connectionHandle y

83

85

86+-- | Superclass for postgresql exceptions

87+data SomePostgreSqlException = forall e. Exception e => SomePostgreSqlException e

88+ deriving Typeable

89+

90+postgresqlExceptionToException :: Exception e => e -> SomeException

91+postgresqlExceptionToException = toException . SomePostgreSqlException

92+

93+postgresqlExceptionFromException :: Exception e => SomeException -> Maybe e

94+postgresqlExceptionFromException x = do

95+ SomePostgreSqlException a <- fromException x

96+ cast a

97+

98+instance Show SomePostgreSqlException where

99+ showsPrec :: Int -> SomePostgreSqlException -> ShowS

100+ showsPrec p (SomePostgreSqlException e) = showsPrec p e

101+

102+instance Exception SomePostgreSqlException where

103+ displayException (SomePostgreSqlException e) = displayException e

104+

84data SqlError = SqlError {

105data SqlError = SqlError {

85 sqlState :: ByteString

106 sqlState :: ByteString

86 , sqlExecStatus :: ExecStatus

107 , sqlExecStatus :: ExecStatus

@@ -92,7 +113,10 @@ data SqlError = SqlError {

92fatalError :: ByteString -> SqlError

113fatalError :: ByteString -> SqlError

93fatalError msg = SqlError "" FatalError msg "" ""

114fatalError msg = SqlError "" FatalError msg "" ""

94

115

95−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

96

120

97-- | Exception thrown if 'query' is used to perform an @INSERT@-like

121-- | Exception thrown if 'query' is used to perform an @INSERT@-like

98-- operation, or 'execute' is used to perform a @SELECT@-like operation.

122-- operation, or 'execute' is used to perform a @SELECT@-like operation.

@@ -101,7 +125,9 @@ data QueryError = QueryError {

101 , qeQuery :: Query

125 , qeQuery :: Query

102 } deriving (Eq, Show, Typeable)

126 } deriving (Eq, Show, Typeable)

103

127

104−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

105

131

106-- | Exception thrown if a 'Query' could not be formatted correctly.

132-- | Exception thrown if a 'Query' could not be formatted correctly.

107-- This may occur if the number of \'@?@\' characters in the query

133-- This may occur if the number of \'@?@\' characters in the query

@@ -112,7 +138,9 @@ data FormatError = FormatError {

112 , fmtParams :: [ByteString]

138 , fmtParams :: [ByteString]

113 } deriving (Eq, Show, Typeable)

139 } deriving (Eq, Show, Typeable)

114

140

115−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

116

144

117data ConnectInfo = ConnectInfo {

145data ConnectInfo = ConnectInfo {

118 connectHost :: String

146 connectHost :: String

test/Exception.hsnew file+70

@@ -0,0 +1,70 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

4+

5+module Exception (testExceptions) where

6+

7+import Database.PostgreSQL.Simple

8+import Test.Tasty.HUnit (Assertion, assertBool)

9+import Common (TestEnv)

10+import Control.Exception (Exception (..), SomeException)

11+import Data.Maybe (isJust)

12+import Data.Either (isLeft)

13+import Control.Exception (throwIO, try)

14+

15+testExceptions :: TestEnv -> Assertion

16+testExceptions _ = do

17+ let sqlError = SqlError

18+ { sqlState = ""

19+ , sqlExecStatus = FatalError

20+ , sqlErrorMsg = ""

21+ , sqlErrorDetail = ""

22+ , sqlErrorHint = ""

23+ }

24+ let sqlEx :: SomeException = toException sqlError

25+ assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)

26+ assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)

27+ eSqlError :: Either SqlError () <- try $ throwIO sqlEx

28+ assertBool "Can catch SqlError" $ isLeft eSqlError

29+ eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx

30+ assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx

31+

32+ let formatError = FormatError

33+ { fmtMessage = ""

34+ , fmtQuery = ""

35+ , fmtParams = []

36+ }

37+ let formatEx :: SomeException = toException formatError

38+ assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)

39+ assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)

40+ eFormatError :: Either FormatError () <- try $ throwIO formatEx

41+ assertBool "Can catch FormatError" $ isLeft eFormatError

42+ eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx

43+ assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx

44+

45+ let queryError = QueryError

46+ { qeMessage = ""

47+ , qeQuery = ""

48+ }

49+ let queryEx :: SomeException = toException queryError

50+ assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)

51+ assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)

52+ eQueryError :: Either QueryError () <- try $ throwIO queryEx

53+ assertBool "Can catch QueryError" $ isLeft eQueryError

54+ eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx

55+ assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx

56+

57+ let resultError = Incompatible

58+ { errSQLType = ""

59+ , errSQLTableOid = Nothing

60+ , errSQLField = ""

61+ , errHaskellType = ""

62+ , errMessage = ""

63+ }

64+ let resultEx :: SomeException = toException resultError

65+ assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)

66+ assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)

67+ eResultEx :: Either ResultError () <- try $ throwIO resultEx

68+ assertBool "Can catch ResultError" $ isLeft eResultEx

69+ eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx

70+ assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx

test/Main.hs+2

@@ -55,6 +55,7 @@ import Notify

55import Serializable

56import Time

57import Interval

58+import Exception (testExceptions)

58

59

59tests :: TestEnv -> TestTree

60tests :: TestEnv -> TestTree

60tests env = testGroup "tests"

61tests env = testGroup "tests"

@@ -84,6 +85,7 @@ tests env = testGroup "tests"

84 , testCase "2-ary generic" . testGeneric2

85 , testCase "2-ary generic" . testGeneric2

85 , testCase "3-ary generic" . testGeneric3

86 , testCase "3-ary generic" . testGeneric3

86 , testCase "Timeout" . testTimeout

87 , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

87 ]

89 ]

88

90

89testBytea :: TestEnv -> TestTree

91testBytea :: TestEnv -> TestTree