1module Test.Format.Format(testFormat) where
2
3import Data.Time.Compat
4
5import Control.Monad (when)
6import Data.Proxy
7import Test.Tasty
8import Test.Tasty.HUnit
9import Test.TestUtil
10
11
12-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
13-- plus FgGklz
14-- f not supported
15-- P not always supported
16-- s time-zone dependent
17chars :: [Char]
18chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%"
19
20-- as found in "man strftime" on a glibc system. '#' is different, though
21modifiers :: [Char]
22modifiers = "_-0^"
23
24widths :: [String]
25widths = ["","1","2","9","12"]
26
27formats :: [String]
28formats =  ["%G-W%V-%u","%U-%w","%W-%u"] ++ (fmap (\char -> '%':[char]) chars)
29 ++ (concat $ fmap (\char -> concat $ fmap (\width -> fmap (\modifier -> "%" ++ [modifier] ++ width ++ [char]) modifiers) widths) chars)
30
31somestrings :: [String]
32somestrings = ["", " ", "-", "\n"]
33
34brokenFormats :: [String]
35brokenFormats =
36    [ "%Z","%_Z","%-Z","%0Z"
37    ,"%4Ez", "%4EZ"
38    ,"%5Ez", "%5EZ"
39    ,"%6Ez", "%6EZ"
40    ,"%Ez", "%EZ"
41    ]
42
43compareExpected :: (Eq t,Show t,ParseTime t) => String -> String -> String -> proxy t -> TestTree
44compareExpected testname fmt str proxy = testCase testname $
45    when (fmt `notElem` brokenFormats) $ do
46        let
47            found :: ParseTime t => proxy t -> Maybe t
48            found _ = parseTimeM False defaultTimeLocale fmt str
49        assertEqual "" Nothing $ found proxy
50
51checkParse :: String -> String -> [TestTree]
52checkParse fmt str = [
53    compareExpected "Day" fmt str (Proxy :: Proxy Day),
54    compareExpected "TimeOfDay" fmt str (Proxy :: Proxy TimeOfDay),
55    compareExpected "LocalTime" fmt str (Proxy :: Proxy LocalTime),
56    compareExpected "TimeZone" fmt str (Proxy :: Proxy TimeZone),
57    compareExpected "UTCTime" fmt str (Proxy :: Proxy UTCTime)
58    ]
59
60testCheckParse :: TestTree
61testCheckParse = testGroup "checkParse" $ tgroup formats $ \fmt -> tgroup somestrings $ \str -> checkParse fmt str
62
63days :: [Day]
64days = [(fromGregorian 2018 1 5) .. (fromGregorian 2018 1 26)]
65
66testDayOfWeek :: TestTree
67testDayOfWeek  = testGroup "DayOfWeek" $ tgroup "uwaA" $ \fmt -> tgroup days $ \day -> let
68    dayFormat = formatTime defaultTimeLocale ['%',fmt] day
69    dowFormat = formatTime defaultTimeLocale ['%',fmt] $ dayOfWeek day
70    in assertEqual "" dayFormat dowFormat
71
72{-
73testZone :: String -> String -> Int -> TestTree
74testZone fmt expected minutes = testCase (show fmt) $ assertEqual "" expected $ formatTime defaultTimeLocale fmt $ TimeZone minutes False ""
75
76testZonePair :: String -> String -> Int -> TestTree
77testZonePair mods expected minutes = testGroup (show mods ++ " " ++ show minutes)
78    [
79        testZone ("%" ++ mods ++ "z") expected minutes,
80        testZone ("%" ++ mods ++ "Z") expected minutes
81    ]
82
83testTimeZone :: TestTree
84testTimeZone = testGroup "TimeZone"
85    [
86    testZonePair "" "+0000" 0,
87    testZonePair "E" "+00:00" 0,
88    testZonePair "" "+0500" 300,
89    testZonePair "E" "+05:00" 300,
90    testZonePair "3" "+0500" 300,
91    testZonePair "4E" "+05:00" 300,
92    testZonePair "4" "+0500" 300,
93    testZonePair "5E" "+05:00" 300,
94    testZonePair "5" "+00500" 300,
95    testZonePair "6E" "+005:00" 300,
96    testZonePair "" "-0700" (-420),
97    testZonePair "E" "-07:00" (-420),
98    testZonePair "" "+1015" 615,
99    testZonePair "E" "+10:15" 615,
100    testZonePair "3" "+1015" 615,
101    testZonePair "4E" "+10:15" 615,
102    testZonePair "4" "+1015" 615,
103    testZonePair "5E" "+10:15" 615,
104    testZonePair "5" "+01015" 615,
105    testZonePair "6E" "+010:15" 615,
106    testZonePair "" "-1130" (-690),
107    testZonePair "E" "-11:30" (-690)
108    ]
109
110testAFormat :: FormatTime t => String -> String -> t -> TestTree
111testAFormat fmt expected t = testCase fmt $ assertEqual "" expected $ formatTime defaultTimeLocale fmt t
112
113testNominalDiffTime :: TestTree
114testNominalDiffTime = testGroup "NominalDiffTime"
115    [
116        testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime),
117        testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: NominalDiffTime),
118        testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: NominalDiffTime),
119        testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime),
120        testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime),
121        testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime),
122        testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime),
123        testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime),
124        testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)
125    ]
126
127testDiffTime :: TestTree
128testDiffTime = testGroup "DiffTime"
129    [
130        testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime),
131        testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: DiffTime),
132        testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: DiffTime),
133        testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime),
134        testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime),
135        testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime),
136        testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime),
137        testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime),
138        testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)
139    ]
140
141testCalenderDiffDays :: TestTree
142testCalenderDiffDays = testGroup "CalenderDiffDays"
143    [
144        testAFormat "%yy%Bm%ww%Dd" "5y4m3w2d" $ CalendarDiffDays 64 23,
145        testAFormat "%bm %dd" "64m 23d" $ CalendarDiffDays 64 23,
146        testAFormat "%yy%Bm%ww%Dd" "-5y-4m-3w-2d" $ CalendarDiffDays (-64) (-23),
147        testAFormat "%bm %dd" "-64m -23d" $ CalendarDiffDays (-64) (-23)
148    ]
149
150testCalenderDiffTime :: TestTree
151testCalenderDiffTime = testGroup "CalenderDiffTime"
152    [
153        testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "5y4m3w2d2h22m8s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
154        testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "5y4m3w2d2h22m8.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
155        testAFormat "%yy%Bm%ww%Dd%Hh%Mm%0ESs" "5y4m3w2d2h22m08.210000000000s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
156        testAFormat "%bm %dd %hh %mm %Ess" "64m 23d 554h 33262m 1995728.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21,
157        testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "-5y-4m-3w-2d-2h-22m-8s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21,
158        testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "-5y-4m-3w-2d-2h-22m-8.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21,
159        testAFormat "%bm %dd %hh %mm %Ess" "-64m -23d -554h -33262m -1995728.21s" $ CalendarDiffTime (-64) $ negate $ 23 * 86400 + 8528.21
160    ]
161-}
162
163testFormat :: TestTree
164testFormat = testGroup "testFormat" $ [
165    testCheckParse,
166    testDayOfWeek
167--    testTimeZone,
168--    testNominalDiffTime,
169--    testDiffTime,
170--    testCalenderDiffDays,
171--    testCalenderDiffTime
172    ]
173