git.iko.soy/typeable/postgresql-simple
on 592fe13 help sign in
71 lines 2.3 kB history raw
1{-# LANGUAGE QuasiQuotes #-}
3{-
5Testing strategies:
7fromString . toString == id ** Todo?
9toString . fromString == almost id ** Todo?
11postgresql -> haskell -> postgresql * Done
13haskell -> postgresql -> haskell ** Todo?
15But still, what we really want to establish is that the two values
16correspond; for example, a conversion that consistently added hour
17when printed to a string and subtracted an hour when parsed from string
18would still pass these tests.
20-}
22module Time (testTime) where
24import Common
25import Control.Monad(forM_, replicateM_)
26import Data.Time
27import Data.ByteString(ByteString)
28import Database.PostgreSQL.Simple.SqlQQ
30numTests :: Int
31numTests = 200
33testTime :: TestEnv -> Test
34testTime 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 execute_ conn "SET timezone TO 'Asia/Kathmandu'"
43 checkRoundTrips env
44 execute_ conn "SET timezone TO 'America/St_Johns'"
45 checkRoundTrips env
47initializeTable :: TestEnv -> IO ()
48initializeTable TestEnv{..} = withTransaction conn $ do
49 execute_ conn
50 [sql| CREATE TEMPORARY TABLE testtime
51 ( x serial, y timestamptz, PRIMARY KEY(x) ) |]
52 let pop :: ByteString -> Double -> IO () = \x y ->
53 replicateM_ numTests $ execute conn
54 [sql| INSERT INTO testtime (y) VALUES
55 ('1936-01-01 00:00:00+00'::timestamptz
56 + ?::interval * ROUND(RANDOM() * ?)) |] (x,y)
57 pop "1 microsecond" 6.3113904e15
58 pop "10 microseconds" 6.3113904e14
59 pop "100 microseconds" 6.3113904e13
60 pop "1 millisecond" 6.3113904e12
61 pop "10 milliseconds" 6.3113904e11
62 pop "100 milliseconds" 6.3113904e10
63 pop "1 second" 6.3113904e9
65checkRoundTrips :: TestEnv -> IO ()
66checkRoundTrips TestEnv{..} = do
67 yxs :: [(UTCTime, Int)] <- query_ conn [sql| SELECT y, x FROM testtime |]
68 forM_ yxs $ \yx -> do
69 res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx
70 assertBool "UTCTime did not round-trip from SQL to Haskell and back" $
71 res == [Only True]