Skip to content

Commit 11da8a7

Browse files
tfausaktfausak
authored
Change render format (#11)
* Add integration tests * Add warning about broken interval parser * Set the PostgreSQL password * Test against more versions of Postgres * Only build documentation once Also fix artifact names. * Update build job name * Render intervals using more compatible format * Allow failures on older versions of Postgres * Don't fail on pending tests * Update ci.yml
1 parent a53a4ed commit 11da8a7

File tree

4 files changed

+125
-37
lines changed

4 files changed

+125
-37
lines changed

‎.github/workflows/ci.yml‎

Lines changed: 62 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -51,9 +51,9 @@ jobs:
5151
- uses: actions/checkout@v4
5252
- uses: haskell-actions/run-ormolu@v17
5353
build:
54-
name: GHC ${{ matrix.ghc }} on ${{ matrix.os }}
54+
name: GHC ${{ matrix.ghc }} on ${{ matrix.os }} with PostgreSQL ${{ matrix.postgres }}
5555
needs: meta
56-
runs-on: ${{ matrix.os }}
56+
runs-on: ${{ matrix.os }}-latest
5757
steps:
5858
- uses: actions/checkout@v4
5959
- run: mkdir artifact
@@ -63,7 +63,7 @@ jobs:
6363
cabal: latest
6464
- run: ghc-pkg list
6565
- run: cabal sdist --output-dir artifact
66-
- run: echo DOCUMENTATION=${{ matrix.ghc == '9.12' && '--enable-documentation --haddock-for-hackage' || '' }} >> $GITHUB_ENV
66+
- run: echo DOCUMENTATION=${{ matrix.documentation && '--enable-documentation --haddock-for-hackage' || '' }} >> $GITHUB_ENV
6767
- run: cabal configure $DOCUMENTATION --enable-tests --flags=pedantic --jobs
6868
- run: cat cabal.project.local
6969
- run: cp cabal.project.local artifact
@@ -79,41 +79,75 @@ jobs:
7979
restore-keys: ${{ matrix.os }}-${{ matrix.ghc }}-
8080
- run: cabal build --only-download
8181
- uses: ikalnytskyi/action-setup-postgres@v7
82+
with:
83+
postgres-version: ${{ matrix.postgres }}
8284
- run: cabal build --only-dependencies
8385
- run: cabal build
8486
- if: ${{ env.DOCUMENTATION }}
8587
run: cp dist-newstyle/${{ needs.meta.outputs.name }}-${{ needs.meta.outputs.version }}-docs.tar.gz artifact
8688
- run: tar --create --file artifact.tar --verbose artifact
8789
- uses: actions/upload-artifact@v4
8890
with:
89-
name: postgresql-simple-interval-${{ github.sha }}-${{ matrix.os }}-${{ matrix.ghc }}
91+
name: postgresql-simple-interval-${{ github.sha }}-${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.postgres }}
9092
path: artifact.tar
91-
- run: cabal run -- postgresql-simple-interval-test-suite --randomize --strict
93+
- env:
94+
PGPASSWORD: postgres
95+
run: cabal run -- postgresql-simple-interval-test-suite --randomize
9296
strategy:
9397
matrix:
9498
include:
95-
- ghc: '9.12'
96-
os: macos-13
97-
- ghc: '9.12'
98-
os: macos-latest
99-
- ghc: '8.8'
100-
os: ubuntu-latest
101-
- ghc: '8.10'
102-
os: ubuntu-latest
103-
- ghc: '9.0'
104-
os: ubuntu-latest
105-
- ghc: '9.2'
106-
os: ubuntu-latest
107-
- ghc: '9.4'
108-
os: ubuntu-latest
109-
- ghc: '9.6'
110-
os: ubuntu-latest
111-
- ghc: '9.8'
112-
os: ubuntu-latest
113-
- ghc: '9.10'
114-
os: ubuntu-latest
115-
- ghc: '9.12'
116-
os: ubuntu-latest
99+
- documentation: false
100+
ghc: '9.12'
101+
postgres: 17
102+
os: macos
103+
- documentation: false
104+
ghc: '8.8'
105+
postgres: 17
106+
os: ubuntu
107+
- documentation: false
108+
ghc: '8.10'
109+
postgres: 17
110+
os: ubuntu
111+
- documentation: false
112+
ghc: '9.0'
113+
postgres: 17
114+
os: ubuntu
115+
- documentation: false
116+
ghc: '9.2'
117+
postgres: 17
118+
os: ubuntu
119+
- documentation: false
120+
ghc: '9.4'
121+
postgres: 17
122+
os: ubuntu
123+
- documentation: false
124+
ghc: '9.6'
125+
postgres: 17
126+
os: ubuntu
127+
- documentation: false
128+
ghc: '9.8'
129+
postgres: 17
130+
os: ubuntu
131+
- documentation: false
132+
ghc: '9.10'
133+
postgres: 17
134+
os: ubuntu
135+
- documentation: false
136+
ghc: '9.12'
137+
postgres: 14
138+
os: ubuntu
139+
- documentation: false
140+
ghc: '9.12'
141+
postgres: 15
142+
os: ubuntu
143+
- documentation: false
144+
ghc: '9.12'
145+
postgres: 16
146+
os: ubuntu
147+
- documentation: true
148+
ghc: '9.12'
149+
postgres: 17
150+
os: ubuntu
117151
release:
118152
if: ${{ github.event_name == 'release' }}
119153
name: Release
@@ -126,7 +160,7 @@ jobs:
126160
steps:
127161
- uses: actions/download-artifact@v4
128162
with:
129-
name: postgresql-simple-interval-${{ github.sha }}-ubuntu-latest-9.12
163+
name: postgresql-simple-interval-${{ github.sha }}-ubuntu-9.12-17
130164
- run: tar --extract --file artifact.tar --verbose
131165
- uses: softprops/action-gh-release@v2
132166
with:

‎postgresql-simple-interval.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ common library
2727
attoparsec ^>=0.14.4,
2828
base >=4.13 && <4.22,
2929
bytestring >=0.10.10 && <0.13,
30+
postgresql-simple ^>=0.7,
31+
text >=1.2.4 && <1.3 || >=2.0 && <2.2,
3032

3133
default-language: Haskell2010
3234
ghc-options:
@@ -61,9 +63,7 @@ library
6163
import: library
6264
build-depends:
6365
persistent ^>=2.17,
64-
postgresql-simple ^>=0.7,
6566
scientific ^>=0.3.8,
66-
text >=1.2.4 && <1.3 || >=2.0 && <2.2,
6767

6868
-- cabal-gild: discover source/library
6969
exposed-modules:

‎source/library/Database/PostgreSQL/Simple/Interval/Unstable.hs‎

Lines changed: 20 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,12 @@ import qualified Database.PostgreSQL.Simple.TypeInfo.Static as Postgres
3535
-- - 'Data.Time.CalendarDiffTime': Does not handle days. Embeds a
3636
-- @NominalDiffTime@. Is not bounded.
3737
-- - 'Data.Time.CalendarDiffDays': Does not handle seconds. Is not bounded.
38+
--
39+
-- WARNING: The PostgreSQL interval parser is broken in versions prior to 15.
40+
-- It is not possible to round trip all intervals through PostgreSQL on those
41+
-- versions. You should upgrade to at least PostgreSQL version 15. For more
42+
-- information, see this patch:
43+
-- <https://git.postgresql.org/gitweb/?p=postgresql.git;a=commitdiff;h=e39f99046>
3844
data Interval = MkInterval
3945
{ months :: !Int.Int32,
4046
days :: !Int.Int32,
@@ -47,7 +53,7 @@ instance Postgres.FromField Interval where
4753
fromField = Postgres.attoFieldParser (== Postgres.intervalOid) parse
4854

4955
-- | Uses 'render'. Always includes an @interval@ prefix, like
50-
-- @interval '\@ 0 mon -1 day +2 us'@.
56+
-- @interval '...'@.
5157
instance Postgres.ToField Interval where
5258
toField = Postgres.Plain . ("interval '" <>) . (<> "'") . render
5359

@@ -204,24 +210,34 @@ add x y =
204210
<*> Function.on safeAdd microseconds x y
205211

206212
-- | Renders an interval to a 'Builder'. This always has the same format:
207-
-- @"\@ X mon Y day Z us"@, where @X@, @Y@, and @Z@ are signed integers.
213+
-- @"\@ A mon B day C hour D min E sec F us"@, where @A@, @B@, @C@, @D@, @E@,
214+
-- and @F@ are signed integers.
208215
--
209216
-- This is not the most compact format, but it is very easy to interpret and
210217
-- does not require dealing with decimals (which could introduce precision
211218
-- problems).
212219
--
213220
-- >>> render MkInterval { months = 0, days = -1, microseconds = 2 }
214-
-- "@ 0 mon -1 day +2 us"
221+
-- "@ 0 mon -1 day 0 hour 0 min 0 sec +2 us"
215222
render :: Interval -> Builder.Builder
216223
render x =
217224
let signed :: (Num a, Ord a) => (a -> Builder.Builder) -> a -> Builder.Builder
218225
signed f n = (if n > 0 then "+" else "") <> f n
226+
(t1, u) = quotRem (microseconds x) 1000000
227+
(t2, s) = quotRem t1 60
228+
(h, m) = quotRem t2 60
219229
in "@ "
220230
<> signed Builder.int32Dec (months x)
221231
<> " mon "
222232
<> signed Builder.int32Dec (days x)
223233
<> " day "
224-
<> signed Builder.int64Dec (microseconds x)
234+
<> signed Builder.int64Dec h
235+
<> " hour "
236+
<> signed Builder.int64Dec m
237+
<> " min "
238+
<> signed Builder.int64Dec s
239+
<> " sec "
240+
<> signed Builder.int64Dec u
225241
<> " us"
226242

227243
-- | Parses an interval. This is not a general purpose parser. It only supports

‎source/test-suite/Main.hs‎

Lines changed: 41 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,19 @@
11
{-# LANGUAGE NumDecimals #-}
22
{-# LANGUAGE OverloadedStrings #-}
33

4+
import qualified Control.Exception as Exception
45
import qualified Control.Monad as Monad
56
import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
67
import qualified Data.ByteString as ByteString
78
import qualified Data.ByteString.Builder as Builder
89
import qualified Data.ByteString.Lazy as LazyByteString
910
import qualified Data.Int as Int
11+
import qualified Data.Text as Text
12+
import qualified Database.PostgreSQL.Simple as Postgres
1013
import qualified Database.PostgreSQL.Simple.Interval.Unstable as I
14+
import qualified Database.PostgreSQL.Simple.ToField as Postgres
1115
import qualified Test.Hspec as H
16+
import qualified Text.Read as Read
1217

1318
main :: IO ()
1419
main = H.hspec spec
@@ -105,15 +110,19 @@ spec = H.describe "Database.PostgreSQL.Simple.Interval" $ do
105110
H.describe "render" $ do
106111
H.it "works with zero" $ do
107112
let actual = Builder.toLazyByteString $ I.render I.zero
108-
actual `H.shouldBe` "@ 0 mon 0 day 0 us"
113+
actual `H.shouldBe` "@ 0 mon 0 day 0 hour 0 min 0 sec 0 us"
109114

110115
H.it "works with positive components" $ do
111116
let actual = Builder.toLazyByteString . I.render $ I.MkInterval 1 2 3
112-
actual `H.shouldBe` "@ +1 mon +2 day +3 us"
117+
actual `H.shouldBe` "@ +1 mon +2 day 0 hour 0 min 0 sec +3 us"
113118

114119
H.it "works with negative components" $ do
115120
let actual = Builder.toLazyByteString . I.render $ I.MkInterval (-3) (-2) (-1)
116-
actual `H.shouldBe` "@ -3 mon -2 day -1 us"
121+
actual `H.shouldBe` "@ -3 mon -2 day 0 hour 0 min 0 sec -1 us"
122+
123+
H.it "works with time components" $ do
124+
let actual = Builder.toLazyByteString . I.render $ I.MkInterval 0 0 3723000004
125+
actual `H.shouldBe` "@ 0 mon 0 day +1 hour +2 min +3 sec +4 us"
117126

118127
H.describe "parse" $ do
119128
H.it "fails with invalid input" $ do
@@ -143,13 +152,42 @@ spec = H.describe "Database.PostgreSQL.Simple.Interval" $ do
143152
let actual = Attoparsec.parseOnly I.parse input
144153
actual `H.shouldBe` Right interval
145154

155+
H.describe "integration" $ do
156+
Monad.forM_ intervalStyles $ \(style, field) -> do
157+
H.describe ("with style " <> show style) $ do
158+
Monad.forM_ examples $ \example -> do
159+
H.it ("round trips " <> show (field example)) $ do
160+
Postgres.withConnect Postgres.defaultConnectInfo $ \connection -> do
161+
let interval = exampleInterval example
162+
result <- Exception.try . Postgres.withTransaction connection $ do
163+
Monad.void $ Postgres.execute connection "set local intervalstyle = ?" [style]
164+
Postgres.query connection "select ?" [interval]
165+
case result of
166+
Right actual -> actual `H.shouldBe` [Postgres.Only interval]
167+
Left somePostgresqlException -> do
168+
rows <- Postgres.query_ connection "select version()"
169+
case rows of
170+
Postgres.Only text : _
171+
| _ : rawVersion : _ <- Text.words text,
172+
Just version <- Read.readMaybe (Text.unpack rawVersion),
173+
version < (15 :: Double) ->
174+
H.pendingWith $ "interval parsing broken with PostgreSQL version " <> show version
175+
_ -> Exception.throwIO (somePostgresqlException :: Postgres.SomePostgreSqlException)
176+
146177
data IntervalStyle
147178
= Iso8601
148179
| Postgres
149180
| PostgresVerbose
150181
| SqlStandard
151182
deriving (Eq, Show)
152183

184+
instance Postgres.ToField IntervalStyle where
185+
toField style = Postgres.Plain $ case style of
186+
Iso8601 -> "iso_8601"
187+
Postgres -> "postgres"
188+
PostgresVerbose -> "postgres_verbose"
189+
SqlStandard -> "sql_standard"
190+
153191
data Example = MkExample
154192
{ exampleInterval :: I.Interval,
155193
exampleIso8601 :: ByteString.ByteString,

0 commit comments

Comments
 (0)