diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Ashley Yakeley (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ashley Yakeley nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Data/Time/LocalTime/TimeZone/Unix.hs b/src/Data/Time/LocalTime/TimeZone/Unix.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/LocalTime/TimeZone/Unix.hs @@ -0,0 +1,279 @@ +-- | UNIX-specific handling of time data. +module Data.Time.LocalTime.TimeZone.Unix +( + -- * Time Zone + getCurrentTimeZoneSeries, + getTimeZoneSeriesForZone, + -- * Country Information + CountryCode, + getCountryCodes, + -- * Zone Information + TimeZoneSpec, + ZoneDescription(..), + getZoneDescriptions, + -- * OlsonData + getCurrentOlsonData, + getOlsonDataForZone, + -- * Leap Seconds + getLeapSecondList, +) where +{ + import Data.Maybe; + import Data.List; + import System.Environment; + import System.Directory; + import System.FilePath.Posix; + import Data.Time; + import Data.Time.LocalTime.TimeZone.Series; + import Data.Time.LocalTime.TimeZone.Olson; + import Data.Time.Clock.LeapSeconds; + + + separate :: Char -> String -> [String]; + separate sep s = let + { + (val,rest) = break ((==) sep) s; + vals = case rest of + { + [] -> []; + _:s' -> separate sep s'; + }; + } in val : vals; + + findPath :: [FilePath] -> IO (Maybe FilePath); + findPath [] = return Nothing; + findPath (path:paths) = do + { + exists <- doesFileExist path; + if exists then return (Just path) else findPath paths; + }; + + -- http://www.pathname.com/fhs/pub/fhs-2.3.html#SPECIFICOPTIONS15 + -- http://askubuntu.com/questions/118015/where-is-usr-share-zoneinfo-specified + zoneFilePath :: String -> FilePath; + zoneFilePath filename = "/usr/share/zoneinfo" filename; + + readZoneInfoFile :: ([String] -> Maybe a) -> [String] -> IO [a]; + readZoneInfoFile toValues filenames = do + { + let + { + filepaths = fmap zoneFilePath filenames; + }; + mfilepath <- findPath filepaths; + filepath <- case mfilepath of + { + Just path -> return path; + Nothing -> fail $ "could not find " ++ intercalate " " filepaths; + }; + text <- readFile filepath; + let + { + readLine ('#':_) = return Nothing; + readLine "" = return Nothing; + readLine s = case toValues $ separate '\t' s of + { + Just a -> return $ Just a; + Nothing -> fail $ "unexpected line in "++filepath++": " ++ s; + }; + }; + mstrs <- traverse readLine $ lines text; + return $ catMaybes mstrs; + }; + + -- | ISO 3166 alpha-2 country code (i.e., two capital letters). + ; + type CountryCode = String; + + -- | Get the country codes and names found in @iso3166.tab@. + -- Note that earlier versions of zoneinfo don't include this file, in which case this will throw exception matching 'isDoesNotExistError'. + ; + getCountryCodes :: IO [(CountryCode,String)]; + getCountryCodes = let + { + toCountryCode [code,country] = Just (code,country); + toCountryCode _ = Nothing; + } in readZoneInfoFile toCountryCode ["iso3166.tab"]; + + + -- | Time-zone specification as used in the TZ environment variable, e.g. \"America/Los_Angeles\". + ; + type TimeZoneSpec = String; + + -- | Information about a zone. + ; + data ZoneDescription = MkZoneDescription + { + -- | The countries that overlap the zone. + zoneCountries :: [CountryCode], + -- | (Latitude, longitude, accuracy) of principal location in degrees, + is north, east. + -- Accuracy indicates that the location is specified to arcseconds rather than arcminutes. + zoneLocation :: (Rational,Rational,Bool), + -- | Zone name. + zoneName :: TimeZoneSpec, + -- | Comments; present if and only if a country has multiple zones. + zoneComment :: String + }; + + getSign :: Char -> Maybe Rational; + getSign '+' = Just 1; + getSign '-' = Just (-1); + getSign _ = Nothing; + + getDigit :: Char -> Maybe Rational; + getDigit c | c < '0' = Nothing; + getDigit c | c > '9' = Nothing; + getDigit c = Just $ toRational $ (fromEnum c) - (fromEnum '0'); + + getDigit2 :: Char -> Char -> Maybe Rational; + getDigit2 c1 c2 = do + { + r1 <- getDigit c1; + r2 <- getDigit c2; + return $ r1 * 10 + r2; + }; + + getDigit3 :: Char -> Char -> Char -> Maybe Rational; + getDigit3 c1 c2 c3 = do + { + r1 <- getDigit2 c1 c2; + r2 <- getDigit c3; + return $ r1 * 10 + r2; + }; + + parseISO6709 :: String -> Maybe (Rational,Rational,Bool); + parseISO6709 [xsn,xd1,xd2,xm1,xm2,ysn,yd1,yd2,yd3,ym1,ym2] = do + { + xsgn <- getSign xsn; + xdeg <- getDigit2 xd1 xd2; + xmin <- getDigit2 xm1 xm2; + ysgn <- getSign ysn; + ydeg <- getDigit3 yd1 yd2 yd3; + ymin <- getDigit2 ym1 ym2; + return (xsgn * (xdeg + xmin / 60),ysgn * (ydeg + ymin / 60),False); + }; + parseISO6709 [xsn,xd1,xd2,xm1,xm2,xs1,xs2,ysn,yd1,yd2,yd3,ym1,ym2,ys1,ys2] = do + { + xsgn <- getSign xsn; + xdeg <- getDigit2 xd1 xd2; + xmin <- getDigit2 xm1 xm2; + xsec <- getDigit2 xs1 xs2; + ysgn <- getSign ysn; + ydeg <- getDigit3 yd1 yd2 yd3; + ymin <- getDigit2 ym1 ym2; + ysec <- getDigit2 ys1 ys2; + return (xsgn * (xdeg + xmin / 60 + xsec / 3600),ysgn * (ydeg + ymin / 60 + ysec / 3600),True); + }; + parseISO6709 _ = Nothing; + + getISO6709 :: String -> (Rational,Rational,Bool); + getISO6709 location = case parseISO6709 location of + { + Just loc -> loc; + Nothing -> error $ "bad IS06709: " ++ location; + }; + + -- | Get the zone descriptions found in @zone1970.tab@ (or @zone.tab@). + ; + getZoneDescriptions :: IO [ZoneDescription]; + getZoneDescriptions = let + { + toZoneDescription [countries,location,name] = Just $ MkZoneDescription + { + zoneCountries = separate ',' countries, + zoneLocation = getISO6709 location, + zoneName = name, + zoneComment = "" + }; + toZoneDescription [countries,location,name,comment] = Just $ MkZoneDescription + { + zoneCountries = separate ',' countries, + zoneLocation = getISO6709 location, + zoneName = name, + zoneComment = comment + }; + toZoneDescription _ = Nothing; + } in readZoneInfoFile toZoneDescription ["zone1970.tab","zone.tab"]; + + existingZoneNamePath :: String -> IO (Maybe FilePath); + existingZoneNamePath name = do + { + let + { + path = zoneFilePath name; + }; + exists <- doesFileExist path; + return $ if exists then Just path else Nothing; + }; + + getZoneNamePath :: Maybe TimeZoneSpec -> IO (Maybe FilePath); + getZoneNamePath Nothing = return $ Just "/etc/localtime"; + getZoneNamePath (Just (':':name)) = existingZoneNamePath name; + getZoneNamePath (Just name) = existingZoneNamePath name; + + defaultTimeZoneSeries :: TimeZoneSeries; + defaultTimeZoneSeries = TimeZoneSeries utc []; + + -- | Get the 'TimeZoneSeries' for this 'TimeZoneSpec' (or for the system default), defaulting to UTC if the name is not found. + ; + getTimeZoneSeriesForZone :: Maybe TimeZoneSpec -> IO TimeZoneSeries; + getTimeZoneSeriesForZone mname = do + { + mpath <- getZoneNamePath mname; + case mpath of + { + Just path -> getTimeZoneSeriesFromOlsonFile path; + Nothing -> return $ fromMaybe defaultTimeZoneSeries $ olsonToTimeZoneSeries $ mempty {olsonPosixTZ=mname}; + }; + }; + + -- | Get the current 'TimeZoneSeries' (as specifed by @TZ@ env-var or else the system default). + ; + getCurrentTimeZoneSeries :: IO TimeZoneSeries; + getCurrentTimeZoneSeries = do + { + mtzvar <- lookupEnv "TZ"; + getTimeZoneSeriesForZone mtzvar; + }; + + -- | Obtain an 'OlsonData' file for this 'TimeZoneSpec' (or for the system default). + -- If the file is not in the database, return an empty 'OlsonData' with the name in 'olsonPosixTZ'. + ; + getOlsonDataForZone :: Maybe TimeZoneSpec -> IO OlsonData; + getOlsonDataForZone mname = do + { + mpath <- getZoneNamePath mname; + case mpath of + { + Just path -> getOlsonFromFile path; + Nothing -> return $ mempty {olsonPosixTZ=mname}; + }; + }; + + -- | Get the current 'OlsonData' (as specifed by @TZ@ env-var or else the system default). + ; + getCurrentOlsonData :: IO OlsonData; + getCurrentOlsonData = do + { + mtzvar <- lookupEnv "TZ"; + getOlsonDataForZone mtzvar; + }; + + -- | Get the leap-second list found in @leap-seconds.list@. + -- Note that earlier versions of zoneinfo don't include this file, in which case this will throw exception matching 'isDoesNotExistError'. + ; + getLeapSecondList :: IO LeapSecondList; + getLeapSecondList = do + { + let + { + filepath = zoneFilePath "leap-seconds.list"; + }; + text <- readFile filepath; + case parseNISTLeapSecondList text of + { + Just lsl -> return lsl; + Nothing -> fail $ "failed to parse " ++ filepath; + }; + }; +} diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,96 @@ +module Main(main) where +{ + import Data.Maybe; + import Data.Foldable; + import Control.Exception; + import System.Environment; + import System.Directory; + import Test.Tasty; + import Test.Tasty.HUnit; + import Test.Tasty.Golden; + import Data.Time; + import Data.Time.Clock.LeapSeconds; + import Data.Time.LocalTime.TimeZone.Series; + import Data.Time.LocalTime.TimeZone.Unix; + + + testCountryCodes :: TestTree; + testCountryCodes = testCase "getCountryCodes" $ do + { + codes <- getCountryCodes; + assertBool "at least 200 countries" $ length codes >= 200; + }; + + testZoneDescriptions :: [ZoneDescription] -> TestTree; + testZoneDescriptions zones = testCase "getZoneDescriptions" $ do + { + assertBool "at least 300 zones" $ length zones >= 300; + forM_ zones $ \MkZoneDescription{zoneLocation=(lat,long,acc),..} -> do + { + assertBool "zoneCountries length" $ length zoneCountries >= 1; + forM_ zoneCountries $ \zc -> assertEqual "zoneCountries member length" 2 $ length zc; + _ <- evaluate lat; + _ <- evaluate long; + _ <- evaluate acc; + _ <- evaluate zoneName; + _ <- evaluate zoneComment; + return (); + } + }; + + testGetTimeZoneSeries :: Maybe TimeZoneSpec -> TestTree; + testGetTimeZoneSeries mname = testCase "getTimeZoneSeriesForZone" $ getTimeZoneSeriesForZone mname >> return (); + + testGetOlsonData :: Maybe TimeZoneSpec -> TestTree; + testGetOlsonData mname = testCase "getOlsonDataForZone" $ getOlsonDataForZone mname >> return (); + + testLoadZones :: [TimeZoneSpec] -> TestTree; + testLoadZones names = testGroup "load" $ fmap (\mname -> testGroup (fromMaybe "default" mname) + [ + testGetTimeZoneSeries mname, + testGetOlsonData mname + ]) (Nothing : (fmap Just names)); + + testUnknownZoneName :: TestTree; + testUnknownZoneName = testCase "unknown TimeZoneSpec" $ do + { + setEnv "TZ" "unknown"; + tzs <- getCurrentTimeZoneSeries; + assertEqual "default TimeZoneSpec" (TimeZoneSeries utc []) tzs; + }; + + testGetLeapSecondList :: TestTree; + testGetLeapSecondList = testGroup "getLeapSecondList" [ + testCase "values" $ do + { + lsl <- getLeapSecondList; + assertBool "expiration is later than version" $ lslExpiration lsl > lslVersion lsl; + }, + goldenVsFile "leap-seconds" "test/leap-seconds.ref" "test/leap-seconds.out" $ do + { + lsl <- getLeapSecondList; + -- just look at the first 26, since the list will grow. + writeBinaryFile "test/leap-seconds.out" $ + concat $ fmap (\(d,n) -> show d ++ " " ++ show n ++ "\n") $ take 26 $ lslTransitions lsl; + } + ]; + + main :: IO (); + main = do + { + ls_exists <- doesFileExist "/usr/share/zoneinfo/leap-seconds.list"; -- workaround for Travis, which doesn't have this file + zones <- getZoneDescriptions; + let + { + names = fmap zoneName zones; + }; + defaultMain $ testGroup "timezone-unix" $ + [ + testCountryCodes, + testZoneDescriptions zones, + testLoadZones names, + testUnknownZoneName + ] ++ + if ls_exists then [testGetLeapSecondList] else []; + }; +} diff --git a/timezone-unix.cabal b/timezone-unix.cabal new file mode 100644 --- /dev/null +++ b/timezone-unix.cabal @@ -0,0 +1,52 @@ +cabal-version: >=1.10 +name: timezone-unix +version: 1.0 +category: Time +description: UNIX-specific handling of time data. +author: Ashley Yakeley +license: BSD3 +license-file: LICENSE +maintainer: ashley@semantic.org +copyright: 2016 Ashley Yakeley +build-type: Simple + +source-repository head + type: git + location: https://github.com/AshleyYakeley/timezone-unix + +library + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: + build-depends: + base >= 4.8 && < 5, + time >= 1.7, + unix, + filepath, + directory, + leapseconds, + timezone-series, + timezone-olson + exposed-modules: + Data.Time.LocalTime.TimeZone.Unix + ghc-options: -Wall + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + base >= 4.8 && < 5, + time >= 1.7, + directory, + leapseconds, + timezone-series, + tasty, + tasty-hunit, + tasty-golden, + timezone-unix + default-language: Haskell2010 + default-extensions: + RecordWildCards + ghc-options: -Wall + main-is: Test.hs + other-modules: