git.iko.soy/typeable/timezone-olson
on master help sign in
typeable/timezone-olson/hzdump.hs
118 lines 4.7 kB history raw
1-- | A clone in Haskell of the zdump(8) command, including most of
2-- the bugs, that takes paths to Olson files instead of timezone
3-- names. This is useful for testing the Haskell implementation
4-- of the Olson timezone parser and renderer against the reference
5-- implementation in C. But less useful than it might seem at first,
6-- because Haskell rounds historical solar mean timezones to the
7-- nearest minute, whereas the C implementation rounds to the nearest
8-- second.
9module Main where
11import Data.Time.LocalTime.TimeZone.Series
12import Data.Time.LocalTime.TimeZone.Olson
13import Data.Time
14import Data.Maybe (listToMaybe)
15import System.Environment (getArgs)
16import System.Exit (exitWith, exitSuccess, ExitCode(ExitFailure))
17import System.Locale (defaultTimeLocale)
18import Control.Monad (guard)
20version :: IO a
21version = do
22 putStrLn "hzdump version 0.1, clone of zdump 1.7 -c option fixed,"
23 putStrLn "takes zone file paths instead of zone specifications"
24 exitSuccess
26usage :: IO a
27usage = do
28 putStrLn "usage: hzdump [--version] [-v] [-c cutoff] zone-file-path ..."
29 putStrLn " where cutoff is lo-year,hi-year or hi-year"
30 exitWith $ ExitFailure 1
32illegalOpt :: Char -> IO a -- sic
33illegalOpt opt = do
34 putStrLn $ "hzdump: illegal option -- " ++ [opt]
35 usage
37data Option = Version | Illegal Char |
38 Verbose (Maybe Integer, Maybe Integer) | Now
39 deriving (Eq, Ord, Show)
41main = do
42 (opts, zones) <- fmap parseArgs getArgs
43 (getTimes, displayTime) <- case opts of
44 Version -> version
45 Illegal opt -> illegalOpt opt
46 Verbose rng -> return (transitionTimes rng, displayVerbose)
47 _ -> do now <- getCurrentTime
48 return (const [now], displayConcise)
49 tzss <- mapM getZone zones
50 putStr . unlines . concat $
51 zipWith (displayZone getTimes displayTime) zones tzss
52 where
53 getZone "-" = return utcTZ -- sic
54 getZone z = getTimeZoneSeriesFromOlsonFile z
56 displayZone getTimes displayTime zone tzs =
57 map ((zone ++) . (" " ++) . displayTime tzs) $ getTimes tzs
59parseArgs :: [String] -> (Option, [FilePath])
60parseArgs args | "--version" `elem` args = (Version, [])
61parseArgs args = getOpts False (Nothing, Nothing) args
62 where
63 getOpts _ cutoff ("-v":args) = getOpts True cutoff args
64 getOpts v _ ("-c":c:args) = maybe (Illegal 'c', [])
65 (\y -> getOpts v y args) $
66 parseCutoff c
67 getOpts v cutoff ("--":zones ) = (opts v cutoff, zones)
68 getOpts _ _ (('-':x:_):_) = (Illegal x, [])
69 getOpts v cutoff zones = (opts v cutoff, zones)
71 opts v cutoff = if v then Verbose cutoff else Now
73 parseCutoff c = let p0 = listToMaybe $ reads c
74 los = fmap fst p0
75 his = do str <- fmap snd p0
76 let (comma, str1) = splitAt 1 str
77 guard $ comma == ","
78 maybeRead str1
79 in los >> Just (maybe (Nothing, los) ((,) los . Just) his)
81displayConcise :: TimeZoneSeries -> UTCTime -> String
82displayConcise tzs t = formatTime defaultTimeLocale format $
83 ZoneSeriesTime t tzs
84 where
85 format = "%a %b %e %T %Y %Z"
87displayVerbose :: TimeZoneSeries -> UTCTime -> String
88displayVerbose tzs t = concat [displayConcise utcTZ t, " = ",
89 displayConcise tzs t, " isdst=", if isdst then "1" else "0"]
90 where
91 isdst = timeZoneSummerOnly $ timeZoneFromSeries tzs t
93transitionTimes :: (Maybe Integer, Maybe Integer) -> TimeZoneSeries ->
94 [UTCTime]
95transitionTimes (lo, hi) =
96 maybe id (takeWhile . (>)) (fmap happyNewYear hi) .
97 maybe id (dropWhile . (>)) (fmap happyNewYear lo) .
98 addBugs . addPrevSecond . actualTransitions
99 where
100 happyNewYear y = UTCTime (fromGregorian y 1 1) 0
101 actualTransitions (TimeZoneSeries d cs) =
102 let rs = reverse cs
103 in map snd . filter fst $
104 zipWith (\(t, tz) prevTz -> (tz /= prevTz, t))
105 rs
106 (d : map snd rs)
107 addPrevSecond = concatMap (\t -> [(-1) `addUTCTime` t, t])
108 addBugs = (bug0 ++) . (++ bug1) -- sic
109 bug0 = [UTCTime (fromGregorian 1901 12 13) (20*3600+45*60+52),
110 UTCTime (fromGregorian 1901 12 14) (20*3600+45*60+52)]
111 bug1 = [UTCTime (fromGregorian 2038 1 18) ( 3*3600+14*60+ 7),
112 UTCTime (fromGregorian 2038 1 19) ( 3*3600+14*60+ 7)]
114utcTZ :: TimeZoneSeries
115utcTZ = TimeZoneSeries utc []
117maybeRead :: Read a => String -> Maybe a
118maybeRead = fmap fst . listToMaybe . filter (null . snd) . reads