File: Format.hs

package info (click to toggle)
haskell-time-compat 1.9.8-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 504 kB
  • sloc: haskell: 7,036; makefile: 3
file content (224 lines) | stat: -rw-r--r-- 9,136 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
module Test.Format.Format (
    testFormat,
) where

import Data.Proxy
import Data.Time.Compat
import Test.Tasty
import Test.Tasty.HUnit
import Test.TestUtil

-- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
-- plus FgGklz
-- f not supported
-- P not always supported
-- s time-zone dependent
chars :: [Char]
chars = "aAbBcCdDeFgGhHIjklmMnprRStTuUVwWxXyYzZ%"

-- as found in "man strftime" on a glibc system. '#' is different, though
modifiers :: [Char]
modifiers = "_-0^"

widths :: [String]
widths = ["", "1", "2", "9", "12"]

formats :: [String]
formats =
    ["%G-W%V-%u", "%U-%w", "%W-%u"]
        ++ (fmap (\char -> '%' : [char]) chars)
        ++ ( concat $
                fmap
                    (\char -> concat $ fmap (\width -> fmap (\modifier -> "%" ++ [modifier] ++ width ++ [char]) modifiers) widths)
                    chars
           )

somestrings :: [String]
somestrings = ["", " ", "-", "\n"]

compareExpected :: (Eq t, Show t, ParseTime t) => String -> String -> String -> Proxy t -> TestTree
compareExpected testname fmt str proxy =
    testCase testname $ do
        let
            found :: ParseTime t => Proxy t -> Maybe t
            found _ = parseTimeM False defaultTimeLocale fmt str
        assertEqual "" Nothing $ found proxy

checkParse :: String -> String -> [TestTree]
checkParse fmt str =
    [ compareExpected "Day" fmt str (Proxy :: Proxy Day)
    , compareExpected "TimeOfDay" fmt str (Proxy :: Proxy TimeOfDay)
    , compareExpected "LocalTime" fmt str (Proxy :: Proxy LocalTime)
    , compareExpected "TimeZone" fmt str (Proxy :: Proxy TimeZone)
    , compareExpected "UTCTime" fmt str (Proxy :: Proxy UTCTime)
    ]

testCheckParse :: TestTree
testCheckParse = testGroup "checkParse" $ tgroup formats $ \fmt -> tgroup somestrings $ \str -> checkParse fmt str

days :: [Day]
days = [(fromGregorian 2018 1 5) .. (fromGregorian 2018 1 26)]

testDayOfWeek :: TestTree
testDayOfWeek =
    testGroup "DayOfWeek" $
        tgroup "uwaA" $ \fmt ->
            tgroup days $ \day ->
                let
                    dayFormat = formatTime defaultTimeLocale ['%', fmt] day
                    dowFormat = formatTime defaultTimeLocale ['%', fmt] $ dayOfWeek day
                in
                    assertEqual "" dayFormat dowFormat

testZone :: String -> String -> Int -> TestTree
testZone fmt expected minutes =
    testCase (show fmt) $ assertEqual "" expected $ formatTime defaultTimeLocale fmt $ TimeZone minutes False ""

testZonePair :: String -> String -> Int -> TestTree
testZonePair mods expected minutes =
    testGroup
        (show mods ++ " " ++ show minutes)
        [testZone ("%" ++ mods ++ "z") expected minutes, testZone ("%" ++ mods ++ "Z") expected minutes]

testTimeZone :: TestTree
testTimeZone =
    testGroup
        "TimeZone"
        [ testZonePair "" "+0000" 0
        , testZonePair "E" "+00:00" 0
        , testZonePair "" "+0500" 300
        , testZonePair "E" "+05:00" 300
        , testZonePair "3" "+0500" 300
        , testZonePair "4E" "+05:00" 300
        , testZonePair "4" "+0500" 300
        , testZonePair "5E" "+05:00" 300
        , testZonePair "5" "+00500" 300
        , testZonePair "6E" "+005:00" 300
        , testZonePair "" "-0700" (-420)
        , testZonePair "E" "-07:00" (-420)
        , testZonePair "" "+1015" 615
        , testZonePair "E" "+10:15" 615
        , testZonePair "3" "+1015" 615
        , testZonePair "4E" "+10:15" 615
        , testZonePair "4" "+1015" 615
        , testZonePair "5E" "+10:15" 615
        , testZonePair "5" "+01015" 615
        , testZonePair "6E" "+010:15" 615
        , testZonePair "" "-1130" (-690)
        , testZonePair "E" "-11:30" (-690)
        ]

testAFormat :: FormatTime t => String -> String -> t -> TestTree
testAFormat fmt expected t = testCase fmt $ assertEqual "" expected $ formatTime defaultTimeLocale fmt t

testNominalDiffTime :: TestTree
testNominalDiffTime =
    testGroup
        "NominalDiffTime"
        []
{-
        [ testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: NominalDiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: NominalDiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $
            (fromRational $ 23 * 86400 + 8528.21 :: NominalDiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $
            (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $
            (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $
            (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $
            (fromRational $ negate $ 23 * 86400 + 8520.21 :: NominalDiffTime)
        , testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $
            (fromRational $ negate $ 23 * 86400 + 8528.21 :: NominalDiffTime)
        , testAFormat "%3Es" "1.200" (1.2 :: NominalDiffTime)
        , testAFormat "%3ES" "01.200" (1.2 :: NominalDiffTime)
        , testAFormat "%3ES" "01.200" (61.2 :: NominalDiffTime)
        , testAFormat "%3Es" "1.245" (1.24582 :: NominalDiffTime)
        , testAFormat "%3ES" "01.245" (1.24582 :: NominalDiffTime)
        , testAFormat "%3ES" "01.245" (61.24582 :: NominalDiffTime)
        ]
-}

testDiffTime :: TestTree
testDiffTime =
    testGroup
        "DiffTime"
        []
{-
        [ testAFormat "%ww%Dd%Hh%Mm%ESs" "3w2d2h22m8.21s" $ (fromRational $ 23 * 86400 + 8528.21 :: DiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s 0.74s" $ (fromRational $ 0.74 :: DiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess" "0d 0h 0m 0s -0.74s" $ (fromRational $ negate $ 0.74 :: DiffTime)
        , testAFormat "%dd %hh %mm %ss %Ess %0Ess" "23d 554h 33262m 1995728s 1995728.21s 1995728.210000000000s" $
            (fromRational $ 23 * 86400 + 8528.21 :: DiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m-8s" $ (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-8.21s" $
            (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%Ss" "-3w-2d-2h-22m0s" $ (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime)
        , testAFormat "%ww%Dd%Hh%Mm%ESs" "-3w-2d-2h-22m-0.21s" $
            (fromRational $ negate $ 23 * 86400 + 8520.21 :: DiffTime)
        , testAFormat "%dd %hh %mm %Ess" "-23d -554h -33262m -1995728.21s" $
            (fromRational $ negate $ 23 * 86400 + 8528.21 :: DiffTime)
        , testAFormat "%3Es" "1.200" (1.2 :: DiffTime)
        , testAFormat "%3ES" "01.200" (1.2 :: DiffTime)
        , testAFormat "%3ES" "01.200" (61.2 :: DiffTime)
        , testAFormat "%3Es" "1.245" (1.24582 :: DiffTime)
        , testAFormat "%3ES" "01.245" (1.24582 :: DiffTime)
        , testAFormat "%3ES" "01.245" (61.24582 :: DiffTime)
        ]
-}

testCalenderDiffDays :: TestTree
testCalenderDiffDays =
    testGroup
        "CalenderDiffDays"
        []
{-
        [ testAFormat "%yy%Bm%ww%Dd" "5y4m3w2d" $ CalendarDiffDays 64 23
        , testAFormat "%bm %dd" "64m 23d" $ CalendarDiffDays 64 23
        , testAFormat "%yy%Bm%ww%Dd" "-5y-4m-3w-2d" $ CalendarDiffDays (-64) (-23)
        , testAFormat "%bm %dd" "-64m -23d" $ CalendarDiffDays (-64) (-23)
        ]
-}

testCalenderDiffTime :: TestTree
testCalenderDiffTime =
    testGroup
        "CalenderDiffTime"
        []
{-
        [ testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "5y4m3w2d2h22m8s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21
        , testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "5y4m3w2d2h22m8.21s" $ CalendarDiffTime 64 $ 23 * 86400 + 8528.21
        , testAFormat "%yy%Bm%ww%Dd%Hh%Mm%0ESs" "5y4m3w2d2h22m08.210000000000s" $
            CalendarDiffTime 64 $
                23 * 86400 + 8528.21
        , testAFormat "%bm %dd %hh %mm %Ess" "64m 23d 554h 33262m 1995728.21s" $
            CalendarDiffTime 64 $
                23 * 86400 + 8528.21
        , testAFormat "%yy%Bm%ww%Dd%Hh%Mm%Ss" "-5y-4m-3w-2d-2h-22m-8s" $
            CalendarDiffTime (-64) $
                negate $
                    23 * 86400 + 8528.21
        , testAFormat "%yy%Bm%ww%Dd%Hh%Mm%ESs" "-5y-4m-3w-2d-2h-22m-8.21s" $
            CalendarDiffTime (-64) $
                negate $
                    23 * 86400 + 8528.21
        , testAFormat "%bm %dd %hh %mm %Ess" "-64m -23d -554h -33262m -1995728.21s" $
            CalendarDiffTime (-64) $
                negate $
                    23 * 86400 + 8528.21
        ]
-}

testFormat :: TestTree
testFormat =
    testGroup "testFormat" $
        [ testCheckParse
        , testDayOfWeek
        , testTimeZone
        , testNominalDiffTime
        , testDiffTime
        , testCalenderDiffDays
        , testCalenderDiffTime
        ]