@@ -0,0 +1,67 @@
1+{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
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+
22+module Time (testTime) where
23+
24+import Common
25+import Control.Monad(forM_, replicateM_)
26+import Data.Time
27+import Data.ByteString(ByteString)
28+import Database.PostgreSQL.Simple.SqlQQ
29+
30+numTests :: Int
31+numTests = 200
32+
33+testTime :: TestEnv -> Test
34+testTime env@TestEnv{..} = TestCase $ do
35+ initializeTable env
36+ execute_ conn "SET timezone TO 'UTC'"
37+ checkRoundTrips env
38+ execute_ conn "SET timezone TO 'America/Chicago'"
39+ checkRoundTrips env
40+ execute_ conn "SET timezone TO 'Asia/Tokyo'"
41+ checkRoundTrips env
42+
43+initializeTable :: TestEnv -> IO ()
44+initializeTable TestEnv{..} = withTransaction conn $ do
45+ execute_ conn
46+ [sql| CREATE TEMPORARY TABLE testtime
47+ ( x serial, y timestamptz, PRIMARY KEY(x) ) |]
48+ let pop :: ByteString -> Double -> IO () = \x y ->
49+ replicateM_ numTests $ execute conn
50+ [sql| INSERT INTO testtime (y) VALUES
51+ ('1900-01-01 00:00:00+00'::timestamptz
52+ + ?::interval * ROUND(RANDOM() * ?)) |] (x,y)
53+ pop "1 microsecond" 6.3113904e15
54+ pop "10 microseconds" 6.3113904e14
55+ pop "100 microseconds" 6.3113904e13
56+ pop "1 millisecond" 6.3113904e12
57+ pop "10 milliseconds" 6.3113904e11
58+ pop "100 milliseconds" 6.3113904e10
59+ pop "1 second" 6.3113904e9
60+
61+checkRoundTrips :: TestEnv -> IO ()
62+checkRoundTrips TestEnv{..} = do
63+ yxs :: [(UTCTime, Int)] <- query_ conn [sql| SELECT y, x FROM testtime |]
64+ forM_ yxs $ \yx -> do
65+ res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx
66+ assertBool "UTCTime did not round-trip from SQL to Haskell and back" $
67+ res == [Only True]