@@ -0,0 +1,180 @@
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
40+import Data.Time.LocalTime (CalendarDiffTime(..))
41+import Data.Time.LocalTime (CalendarDiffTime(..))
42+import Data.ByteString(ByteString)
43+import Database.PostgreSQL.Simple.SqlQQ
44+
45+data IntervalTestCase = IntervalTestCase
46+ { label :: String
47+ , inputMonths :: Integer
48+ , inputSeconds :: NominalDiffTime
49+ , asText :: String
50+ }
51+ deriving (Eq, Show)
52+
53+testInterval :: TestEnv -> Assertion
54+testInterval env@TestEnv{..} = do
55+
56+ initializeTable env
57+
58+ -- currently required for interval to work
59+ execute_ conn "SET intervalstyle TO 'iso_8601'"
60+
61+ let milliseconds = 0.001
62+ seconds = 1
63+ minutes = 60 * seconds
64+ hours = 60 * minutes
65+ days = 24 * hours
66+ weeks = 7 * days
67+ months = 1
68+ years = 12 * months
69+
70+ mapM (checkRoundTrip env)
71+ [ IntervalTestCase
72+ { label = "zero"
73+ , inputMonths = 0
74+ , inputSeconds = 0
75+ , asText = "PT0"
76+ }
77+ , IntervalTestCase
78+ { label = "1 year"
79+ , inputMonths = 1 * years
80+ , inputSeconds = 0
81+ , asText = "P1Y"
82+ }
83+ , IntervalTestCase
84+ { label = "2 months"
85+ , inputMonths = 2 * months
86+ , inputSeconds = 0
87+ , asText = "P2M"
88+ }
89+ , IntervalTestCase
90+ { label = "3 weeks"
91+ , inputMonths = 0
92+ , inputSeconds = 3 * weeks
93+ , asText = "P3W"
94+ }
95+ , IntervalTestCase
96+ { label = "4 days"
97+ , inputMonths = 0
98+ , inputSeconds = 4 * days
99+ , asText = "P4D"
100+ }
101+ , IntervalTestCase
102+ { label = "5 hours"
103+ , inputMonths = 0
104+ , inputSeconds = 5 * hours
105+ , asText = "PT5H"
106+ }
107+ , IntervalTestCase
108+ { label = "6 minutes"
109+ , inputMonths = 0
110+ , inputSeconds = 6 * minutes
111+ , asText = "PT6M"
112+ }
113+ , IntervalTestCase
114+ { label = "7 seconds"
115+ , inputMonths = 0
116+ , inputSeconds = 7 * seconds
117+ , asText = "PT7S"
118+ }
119+ , IntervalTestCase
120+ { label = "8 milliseconds"
121+ , inputMonths = 0
122+ , inputSeconds = 8 * milliseconds
123+ , asText = "PT0.008S"
124+ }
125+ , IntervalTestCase
126+ { label = "combination of intervals (day-size or bigger)"
127+ , inputMonths = 2 * years + 4 * months
128+ , inputSeconds = 3 * weeks + 5 * days
129+ , asText = "P2Y4M3W5D"
130+ }
131+ , IntervalTestCase
132+ { label = "combination of intervals (smaller than day-size)"
133+ , inputMonths = 0
134+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
135+ , asText = "PT18H56M23.563S"
136+ }
137+ , IntervalTestCase
138+ { label = "full combination of intervals"
139+ , inputMonths = 2 * years + 4 * months
140+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
141+ , asText = "P2Y4M3W5DT18H56M23.563S"
142+ }
143+ ]
144+
145+ return ()
146+
147+initializeTable :: TestEnv -> IO ()
148+initializeTable TestEnv{..} = withTransaction conn $ do
149+ execute_ conn
150+ [sql| CREATE TEMPORARY TABLE testinterval
151+ ( id serial, sample interval, PRIMARY KEY(id) ) |]
152+
153+ return ()
154+
155+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()
156+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do
157+
158+ let input = CalendarDiffTime
159+ { ctMonths = inputMonths
160+ , ctTime = inputSeconds
161+ }
162+
163+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|
164+ INSERT INTO testinterval (sample)
165+ VALUES (?)
166+ RETURNING id, sample
167+ |] (Only input)
168+
169+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $
170+ output == input
171+
172+ [(Only isExpectedIso)] <- query conn [sql|
173+ SELECT sample = (?)::interval
174+ FROM testinterval
175+ WHERE id = ?
176+ |] (asText, returnedId)
177+
178+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")
179+ isExpectedIso
180+