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