@@ -0,0 +1,176 @@
1+{-# LANGUAGE QuasiQuotes #-}
2+
3+{-
4+
5+Testing strategies:
6+
7+fromString . toString == id ** Todo?
8+
9+toString . fromString == almost id ** Todo?
10+
11+postgresql -> haskell -> postgresql * Done
12+
13+haskell -> postgresql -> haskell ** Todo?
14+
15+But still, what we really want to establish is that the two values
16+correspond; for example, a conversion that consistently added hour
17+when printed to a string and subtracted an hour when parsed from string
18+would still pass these tests.
19+
20+
21+Right now, we are checking that 1400+ timestamps in the range of 1860 to
22+2060 round trip from postgresql to haskell and back in 5 different timezones.
23+In addition to UTC, the four timezones were selected so that 2 have a positive
24+offset, and 2 have a negative offset, and that 2 have an offset of a
25+whole number of hours, while the other two do not.
26+
27+It may be worth adding a few more timezones to ensure better test coverage.
28+
29+We are checking a handful of selected timestamps to ensure we hit
30+various corner-cases in the code, in addition to 1400 timestamps randomly
31+generated with granularity of seconds down to microseconds in powers of ten.
32+
33+-}
34+
35+module Interval (testInterval) where
36+
37+import Common
38+import Control.Monad(forM_, replicateM_)
39+import Data.Time.Compat
40+import Data.Time.LocalTime.Compat (CalendarDiffTime(..))
41+import Data.ByteString(ByteString)
42+import Database.PostgreSQL.Simple.SqlQQ
43+
44+data IntervalTestCase = IntervalTestCase
45+ { label :: String
46+ , inputMonths :: Integer
47+ , inputSeconds :: NominalDiffTime
48+ , asText :: String
49+ }
50+ deriving (Eq, Show)
51+
52+testInterval :: TestEnv -> Assertion
53+testInterval env@TestEnv{..} = do
54+
55+ initializeTable env
56+
57+ let milliseconds = 0.001
58+ seconds = 1
59+ minutes = 60 * seconds
60+ hours = 60 * minutes
61+ days = 24 * hours
62+ weeks = 7 * days
63+ months = 1
64+ years = 12 * months
65+
66+ mapM (checkRoundTrip env)
67+ [ IntervalTestCase
68+ { label = "zero"
69+ , inputMonths = 0
70+ , inputSeconds = 0
71+ , asText = "PT0"
72+ }
73+ , IntervalTestCase
74+ { label = "1 year"
75+ , inputMonths = 1 * years
76+ , inputSeconds = 0
77+ , asText = "P1Y"
78+ }
79+ , IntervalTestCase
80+ { label = "2 months"
81+ , inputMonths = 2 * months
82+ , inputSeconds = 0
83+ , asText = "P2M"
84+ }
85+ , IntervalTestCase
86+ { label = "3 weeks"
87+ , inputMonths = 0
88+ , inputSeconds = 3 * weeks
89+ , asText = "P3W"
90+ }
91+ , IntervalTestCase
92+ { label = "4 days"
93+ , inputMonths = 0
94+ , inputSeconds = 4 * days
95+ , asText = "P4D"
96+ }
97+ , IntervalTestCase
98+ { label = "5 hours"
99+ , inputMonths = 0
100+ , inputSeconds = 5 * hours
101+ , asText = "PT5H"
102+ }
103+ , IntervalTestCase
104+ { label = "6 minutes"
105+ , inputMonths = 0
106+ , inputSeconds = 6 * minutes
107+ , asText = "PT6M"
108+ }
109+ , IntervalTestCase
110+ { label = "7 seconds"
111+ , inputMonths = 0
112+ , inputSeconds = 7 * seconds
113+ , asText = "PT7S"
114+ }
115+ , IntervalTestCase
116+ { label = "8 milliseconds"
117+ , inputMonths = 0
118+ , inputSeconds = 8 * milliseconds
119+ , asText = "PT0.008S"
120+ }
121+ , IntervalTestCase
122+ { label = "combination of intervals (day-size or bigger)"
123+ , inputMonths = 2 * years + 4 * months
124+ , inputSeconds = 3 * weeks + 5 * days
125+ , asText = "P2Y4M3W5D"
126+ }
127+ , IntervalTestCase
128+ { label = "combination of intervals (smaller than day-size)"
129+ , inputMonths = 0
130+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
131+ , asText = "PT18H56M23.563S"
132+ }
133+ , IntervalTestCase
134+ { label = "full combination of intervals"
135+ , inputMonths = 2 * years + 4 * months
136+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
137+ , asText = "P2Y4M3W5DT18H56M23.563S"
138+ }
139+ ]
140+
141+ return ()
142+
143+initializeTable :: TestEnv -> IO ()
144+initializeTable TestEnv{..} = withTransaction conn $ do
145+ execute_ conn
146+ [sql| CREATE TEMPORARY TABLE testinterval
147+ ( id serial, sample interval, PRIMARY KEY(id) ) |]
148+
149+ return ()
150+
151+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()
152+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do
153+
154+ let input = CalendarDiffTime
155+ { ctMonths = inputMonths
156+ , ctTime = inputSeconds
157+ }
158+
159+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|
160+ INSERT INTO testinterval (sample)
161+ VALUES (?)
162+ RETURNING id, sample
163+ |] (Only input)
164+
165+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $
166+ output == input
167+
168+ [(Only isExpectedIso)] <- query conn [sql|
169+ SELECT sample = (?)::interval
170+ FROM testinterval
171+ WHERE id = ?
172+ |] (asText, returnedId)
173+
174+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")
175+ isExpectedIso
176+