module Data.Time.LocalTime.TimeZone.Unix
(
getCurrentTimeZoneSeries,
getTimeZoneSeriesForZone,
CountryCode,
getCountryCodes,
TimeZoneSpec,
ZoneDescription(..),
getZoneDescriptions,
getCurrentOlsonData,
getOlsonDataForZone,
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 :: Char -> String -> [String]
separate Char
sep String
s = let
{
(String
val,String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
sep) String
s;
vals :: [String]
vals = case String
rest of
{
[] -> [];
Char
_:String
s' -> Char -> String -> [String]
separate Char
sep String
s';
};
} in String
val String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
vals;
findPath :: [FilePath] -> IO (Maybe FilePath);
findPath :: [String] -> IO (Maybe String)
findPath [] = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing;
findPath (String
path:[String]
paths) = do
{
Bool
exists <- String -> IO Bool
doesFileExist String
path;
if Bool
exists then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
path) else [String] -> IO (Maybe String)
findPath [String]
paths;
};
zoneFilePath :: String -> FilePath;
zoneFilePath :: String -> String
zoneFilePath String
filename = String
"/usr/share/zoneinfo" String -> String -> String
</> String
filename;
readZoneInfoFile :: ([String] -> Maybe a) -> [String] -> IO [a];
readZoneInfoFile :: forall a. ([String] -> Maybe a) -> [String] -> IO [a]
readZoneInfoFile [String] -> Maybe a
toValues [String]
filenames = do
{
let
{
filepaths :: [String]
filepaths = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
zoneFilePath [String]
filenames;
};
Maybe String
mfilepath <- [String] -> IO (Maybe String)
findPath [String]
filepaths;
String
filepath <- case Maybe String
mfilepath of
{
Just String
path -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path;
Maybe String
Nothing -> String -> IO String
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"could not find " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String]
filepaths;
};
String
text <- String -> IO String
readFile String
filepath;
let
{
readLine :: String -> m (Maybe a)
readLine (Char
'#':String
_) = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing;
readLine String
"" = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing;
readLine String
s = case [String] -> Maybe a
toValues ([String] -> Maybe a) -> [String] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
separate Char
'\t' String
s of
{
Just a
a -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a;
Maybe a
Nothing -> String -> m (Maybe a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Maybe a)) -> String -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ String
"unexpected line in "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
filepathString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s;
};
};
[Maybe a]
mstrs <- (String -> IO (Maybe a)) -> [String] -> IO [Maybe a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> IO (Maybe a)
forall {m :: * -> *}. MonadFail m => String -> m (Maybe a)
readLine ([String] -> IO [Maybe a]) -> [String] -> IO [Maybe a]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
text;
[a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
mstrs;
};
;
type CountryCode = String;
;
getCountryCodes :: IO [(CountryCode,String)];
getCountryCodes :: IO [(String, String)]
getCountryCodes = let
{
toCountryCode :: [b] -> Maybe (b, b)
toCountryCode [b
code,b
country] = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
code,b
country);
toCountryCode [b]
_ = Maybe (b, b)
forall a. Maybe a
Nothing;
} in ([String] -> Maybe (String, String))
-> [String] -> IO [(String, String)]
forall a. ([String] -> Maybe a) -> [String] -> IO [a]
readZoneInfoFile [String] -> Maybe (String, String)
forall {b}. [b] -> Maybe (b, b)
toCountryCode [String
"iso3166.tab"];
;
type TimeZoneSpec = String;
;
data ZoneDescription = MkZoneDescription
{
ZoneDescription -> [String]
zoneCountries :: [CountryCode],
ZoneDescription -> (Rational, Rational, Bool)
zoneLocation :: (Rational,Rational,Bool),
ZoneDescription -> String
zoneName :: TimeZoneSpec,
:: String
};
getSign :: Char -> Maybe Rational;
getSign :: Char -> Maybe Rational
getSign Char
'+' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
1;
getSign Char
'-' = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (-Rational
1);
getSign Char
_ = Maybe Rational
forall a. Maybe a
Nothing;
getDigit :: Char -> Maybe Rational;
getDigit :: Char -> Maybe Rational
getDigit Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'0' = Maybe Rational
forall a. Maybe a
Nothing;
getDigit Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'9' = Maybe Rational
forall a. Maybe a
Nothing;
getDigit Char
c = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> Rational) -> Int -> Rational
forall a b. (a -> b) -> a -> b
$ (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0');
getDigit2 :: Char -> Char -> Maybe Rational;
getDigit2 :: Char -> Char -> Maybe Rational
getDigit2 Char
c1 Char
c2 = do
{
Rational
r1 <- Char -> Maybe Rational
getDigit Char
c1;
Rational
r2 <- Char -> Maybe Rational
getDigit Char
c2;
Rational -> Maybe Rational
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2;
};
getDigit3 :: Char -> Char -> Char -> Maybe Rational;
getDigit3 :: Char -> Char -> Char -> Maybe Rational
getDigit3 Char
c1 Char
c2 Char
c3 = do
{
Rational
r1 <- Char -> Char -> Maybe Rational
getDigit2 Char
c1 Char
c2;
Rational
r2 <- Char -> Maybe Rational
getDigit Char
c3;
Rational -> Maybe Rational
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
10 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r2;
};
parseISO6709 :: String -> Maybe (Rational,Rational,Bool);
parseISO6709 :: String -> Maybe (Rational, Rational, Bool)
parseISO6709 [Char
xsn,Char
xd1,Char
xd2,Char
xm1,Char
xm2,Char
ysn,Char
yd1,Char
yd2,Char
yd3,Char
ym1,Char
ym2] = do
{
Rational
xsgn <- Char -> Maybe Rational
getSign Char
xsn;
Rational
xdeg <- Char -> Char -> Maybe Rational
getDigit2 Char
xd1 Char
xd2;
Rational
xmin <- Char -> Char -> Maybe Rational
getDigit2 Char
xm1 Char
xm2;
Rational
ysgn <- Char -> Maybe Rational
getSign Char
ysn;
Rational
ydeg <- Char -> Char -> Char -> Maybe Rational
getDigit3 Char
yd1 Char
yd2 Char
yd3;
Rational
ymin <- Char -> Char -> Maybe Rational
getDigit2 Char
ym1 Char
ym2;
(Rational, Rational, Bool) -> Maybe (Rational, Rational, Bool)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational
xsgn Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
xdeg Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
xmin Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
60),Rational
ysgn Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
ydeg Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
ymin Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
60),Bool
False);
};
parseISO6709 [Char
xsn,Char
xd1,Char
xd2,Char
xm1,Char
xm2,Char
xs1,Char
xs2,Char
ysn,Char
yd1,Char
yd2,Char
yd3,Char
ym1,Char
ym2,Char
ys1,Char
ys2] = do
{
Rational
xsgn <- Char -> Maybe Rational
getSign Char
xsn;
Rational
xdeg <- Char -> Char -> Maybe Rational
getDigit2 Char
xd1 Char
xd2;
Rational
xmin <- Char -> Char -> Maybe Rational
getDigit2 Char
xm1 Char
xm2;
Rational
xsec <- Char -> Char -> Maybe Rational
getDigit2 Char
xs1 Char
xs2;
Rational
ysgn <- Char -> Maybe Rational
getSign Char
ysn;
Rational
ydeg <- Char -> Char -> Char -> Maybe Rational
getDigit3 Char
yd1 Char
yd2 Char
yd3;
Rational
ymin <- Char -> Char -> Maybe Rational
getDigit2 Char
ym1 Char
ym2;
Rational
ysec <- Char -> Char -> Maybe Rational
getDigit2 Char
ys1 Char
ys2;
(Rational, Rational, Bool) -> Maybe (Rational, Rational, Bool)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational
xsgn Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
xdeg Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
xmin Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
xsec Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
3600),Rational
ysgn Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
ydeg Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
ymin Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
ysec Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
3600),Bool
True);
};
parseISO6709 String
_ = Maybe (Rational, Rational, Bool)
forall a. Maybe a
Nothing;
getISO6709 :: String -> (Rational,Rational,Bool);
getISO6709 :: String -> (Rational, Rational, Bool)
getISO6709 String
location = case String -> Maybe (Rational, Rational, Bool)
parseISO6709 String
location of
{
Just (Rational, Rational, Bool)
loc -> (Rational, Rational, Bool)
loc;
Maybe (Rational, Rational, Bool)
Nothing -> String -> (Rational, Rational, Bool)
forall a. HasCallStack => String -> a
error (String -> (Rational, Rational, Bool))
-> String -> (Rational, Rational, Bool)
forall a b. (a -> b) -> a -> b
$ String
"bad IS06709: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
location;
};
;
getZoneDescriptions :: IO [ZoneDescription];
getZoneDescriptions :: IO [ZoneDescription]
getZoneDescriptions = let
{
toZoneDescription :: [String] -> Maybe ZoneDescription
toZoneDescription [String
countries,String
location,String
name] = ZoneDescription -> Maybe ZoneDescription
forall a. a -> Maybe a
Just (ZoneDescription -> Maybe ZoneDescription)
-> ZoneDescription -> Maybe ZoneDescription
forall a b. (a -> b) -> a -> b
$ MkZoneDescription
{
zoneCountries :: [String]
zoneCountries = Char -> String -> [String]
separate Char
',' String
countries,
zoneLocation :: (Rational, Rational, Bool)
zoneLocation = String -> (Rational, Rational, Bool)
getISO6709 String
location,
zoneName :: String
zoneName = String
name,
zoneComment :: String
zoneComment = String
""
};
toZoneDescription [String
countries,String
location,String
name,String
comment] = ZoneDescription -> Maybe ZoneDescription
forall a. a -> Maybe a
Just (ZoneDescription -> Maybe ZoneDescription)
-> ZoneDescription -> Maybe ZoneDescription
forall a b. (a -> b) -> a -> b
$ MkZoneDescription
{
zoneCountries :: [String]
zoneCountries = Char -> String -> [String]
separate Char
',' String
countries,
zoneLocation :: (Rational, Rational, Bool)
zoneLocation = String -> (Rational, Rational, Bool)
getISO6709 String
location,
zoneName :: String
zoneName = String
name,
zoneComment :: String
zoneComment = String
comment
};
toZoneDescription [String]
_ = Maybe ZoneDescription
forall a. Maybe a
Nothing;
} in ([String] -> Maybe ZoneDescription)
-> [String] -> IO [ZoneDescription]
forall a. ([String] -> Maybe a) -> [String] -> IO [a]
readZoneInfoFile [String] -> Maybe ZoneDescription
toZoneDescription [String
"zone1970.tab",String
"zone.tab"];
existingZoneNamePath :: String -> IO (Maybe FilePath);
existingZoneNamePath :: String -> IO (Maybe String)
existingZoneNamePath String
name = do
{
let
{
path :: String
path = String -> String
zoneFilePath String
name;
};
Bool
exists <- String -> IO Bool
doesFileExist String
path;
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then String -> Maybe String
forall a. a -> Maybe a
Just String
path else Maybe String
forall a. Maybe a
Nothing;
};
getZoneNamePath :: Maybe TimeZoneSpec -> IO (Maybe FilePath);
getZoneNamePath :: Maybe String -> IO (Maybe String)
getZoneNamePath Maybe String
Nothing = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"/etc/localtime";
getZoneNamePath (Just (Char
':':String
name)) = String -> IO (Maybe String)
existingZoneNamePath String
name;
getZoneNamePath (Just String
name) = String -> IO (Maybe String)
existingZoneNamePath String
name;
defaultTimeZoneSeries :: TimeZoneSeries;
defaultTimeZoneSeries :: TimeZoneSeries
defaultTimeZoneSeries = TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries
TimeZoneSeries TimeZone
utc [];
;
getTimeZoneSeriesForZone :: Maybe TimeZoneSpec -> IO TimeZoneSeries;
getTimeZoneSeriesForZone :: Maybe String -> IO TimeZoneSeries
getTimeZoneSeriesForZone Maybe String
mname = do
{
Maybe String
mpath <- Maybe String -> IO (Maybe String)
getZoneNamePath Maybe String
mname;
case Maybe String
mpath of
{
Just String
path -> String -> IO TimeZoneSeries
getTimeZoneSeriesFromOlsonFile String
path;
Maybe String
Nothing -> TimeZoneSeries -> IO TimeZoneSeries
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZoneSeries -> IO TimeZoneSeries)
-> TimeZoneSeries -> IO TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ TimeZoneSeries -> Maybe TimeZoneSeries -> TimeZoneSeries
forall a. a -> Maybe a -> a
fromMaybe TimeZoneSeries
defaultTimeZoneSeries (Maybe TimeZoneSeries -> TimeZoneSeries)
-> Maybe TimeZoneSeries -> TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ OlsonData -> Maybe TimeZoneSeries
olsonToTimeZoneSeries (OlsonData -> Maybe TimeZoneSeries)
-> OlsonData -> Maybe TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ OlsonData
forall a. Monoid a => a
mempty {olsonPosixTZ=mname};
};
};
;
getCurrentTimeZoneSeries :: IO TimeZoneSeries;
getCurrentTimeZoneSeries :: IO TimeZoneSeries
getCurrentTimeZoneSeries = do
{
Maybe String
mtzvar <- String -> IO (Maybe String)
lookupEnv String
"TZ";
Maybe String -> IO TimeZoneSeries
getTimeZoneSeriesForZone Maybe String
mtzvar;
};
;
getOlsonDataForZone :: Maybe TimeZoneSpec -> IO OlsonData;
getOlsonDataForZone :: Maybe String -> IO OlsonData
getOlsonDataForZone Maybe String
mname = do
{
Maybe String
mpath <- Maybe String -> IO (Maybe String)
getZoneNamePath Maybe String
mname;
case Maybe String
mpath of
{
Just String
path -> String -> IO OlsonData
getOlsonFromFile String
path;
Maybe String
Nothing -> OlsonData -> IO OlsonData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OlsonData -> IO OlsonData) -> OlsonData -> IO OlsonData
forall a b. (a -> b) -> a -> b
$ OlsonData
forall a. Monoid a => a
mempty {olsonPosixTZ=mname};
};
};
;
getCurrentOlsonData :: IO OlsonData;
getCurrentOlsonData :: IO OlsonData
getCurrentOlsonData = do
{
Maybe String
mtzvar <- String -> IO (Maybe String)
lookupEnv String
"TZ";
Maybe String -> IO OlsonData
getOlsonDataForZone Maybe String
mtzvar;
};
;
getLeapSecondList :: IO LeapSecondList;
getLeapSecondList :: IO LeapSecondList
getLeapSecondList = do
{
let
{
filepath :: String
filepath = String -> String
zoneFilePath String
"leap-seconds.list";
};
String
text <- String -> IO String
readFile String
filepath;
case String -> Maybe LeapSecondList
parseNISTLeapSecondList String
text of
{
Just LeapSecondList
lsl -> LeapSecondList -> IO LeapSecondList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LeapSecondList
lsl;
Maybe LeapSecondList
Nothing -> String -> IO LeapSecondList
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO LeapSecondList) -> String -> IO LeapSecondList
forall a b. (a -> b) -> a -> b
$ String
"failed to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filepath;
};
};
}