module Data.HodaTime.TimeZone.Unix
(
   loadUTC
  ,loadLocalZone
  ,loadTimeZone
  ,loadAvailableZones
  ,defaultLoadZoneFromOlsonFile
)
where

import Data.HodaTime.TimeZone.Internal
import Data.HodaTime.TimeZone.Olson
import System.Directory (doesFileExist, getDirectoryContents)
import System.FilePath ((</>))
import qualified Data.ByteString.Lazy.Char8 as BS
import System.Posix.Files (readSymbolicLink, getFileStatus, isDirectory)
import System.FilePath.Posix (makeRelative)
import Data.List (intercalate)
import Control.Exception (Exception, throwIO)
import Control.Monad (unless, forM)
import Data.Typeable (Typeable)

-- exceptions

data TimeZoneDoesNotExistException = TimeZoneDoesNotExistException
  deriving (Typeable, Int -> TimeZoneDoesNotExistException -> ShowS
[TimeZoneDoesNotExistException] -> ShowS
TimeZoneDoesNotExistException -> String
(Int -> TimeZoneDoesNotExistException -> ShowS)
-> (TimeZoneDoesNotExistException -> String)
-> ([TimeZoneDoesNotExistException] -> ShowS)
-> Show TimeZoneDoesNotExistException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeZoneDoesNotExistException -> ShowS
showsPrec :: Int -> TimeZoneDoesNotExistException -> ShowS
$cshow :: TimeZoneDoesNotExistException -> String
show :: TimeZoneDoesNotExistException -> String
$cshowList :: [TimeZoneDoesNotExistException] -> ShowS
showList :: [TimeZoneDoesNotExistException] -> ShowS
Show)

instance Exception TimeZoneDoesNotExistException

data TZoneDBCorruptException = TZoneDBCorruptException
  deriving (Typeable, Int -> TZoneDBCorruptException -> ShowS
[TZoneDBCorruptException] -> ShowS
TZoneDBCorruptException -> String
(Int -> TZoneDBCorruptException -> ShowS)
-> (TZoneDBCorruptException -> String)
-> ([TZoneDBCorruptException] -> ShowS)
-> Show TZoneDBCorruptException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TZoneDBCorruptException -> ShowS
showsPrec :: Int -> TZoneDBCorruptException -> ShowS
$cshow :: TZoneDBCorruptException -> String
show :: TZoneDBCorruptException -> String
$cshowList :: [TZoneDBCorruptException] -> ShowS
showList :: [TZoneDBCorruptException] -> ShowS
Show)

instance Exception TZoneDBCorruptException

type LoadZoneFromOlsonFile = FilePath -> IO (UtcTransitionsMap, CalDateTransitionsMap)

-- interface

loadUTC :: LoadZoneFromOlsonFile -> IO (UtcTransitionsMap, CalDateTransitionsMap)
loadUTC :: LoadZoneFromOlsonFile
-> IO (UtcTransitionsMap, CalDateTransitionsMap)
loadUTC LoadZoneFromOlsonFile
loadZoneFromOlsonFile = LoadZoneFromOlsonFile -> LoadZoneFromOlsonFile
loadTimeZone LoadZoneFromOlsonFile
loadZoneFromOlsonFile String
"UTC"

loadTimeZone :: LoadZoneFromOlsonFile -> String -> IO (UtcTransitionsMap, CalDateTransitionsMap)
loadTimeZone :: LoadZoneFromOlsonFile -> LoadZoneFromOlsonFile
loadTimeZone LoadZoneFromOlsonFile
loadZoneFromOlsonFile String
tzName = do
  LoadZoneFromOlsonFile
loadZoneFromOlsonFile LoadZoneFromOlsonFile -> LoadZoneFromOlsonFile
forall a b. (a -> b) -> a -> b
$ String
tzdbDir String -> ShowS
</> String
tzName

loadLocalZone :: LoadZoneFromOlsonFile -> IO (UtcTransitionsMap, CalDateTransitionsMap, String)
loadLocalZone :: LoadZoneFromOlsonFile
-> IO (UtcTransitionsMap, CalDateTransitionsMap, String)
loadLocalZone LoadZoneFromOlsonFile
loadZoneFromOlsonFile = do
  let file :: String
file = String
"/etc" String -> ShowS
</> String
"localtime"
  String
tzPath <- String -> IO String
readSymbolicLink (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
file
  let tzName :: String
tzName = ShowS
timeZoneNameFromPath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
tzPath
  (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM)  <- LoadZoneFromOlsonFile
loadZoneFromOlsonFile String
file
  (UtcTransitionsMap, CalDateTransitionsMap, String)
-> IO (UtcTransitionsMap, CalDateTransitionsMap, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM, String
tzName)

loadAvailableZones :: IO [String]
loadAvailableZones :: IO [String]
loadAvailableZones = String -> IO [String]
traverseDir String
tzdbDir
  where
    toZoneName :: ShowS
toZoneName String
file = String -> ShowS
makeRelative String
tzdbDir String
file
    toResult :: String -> IO [String]
toResult String
file = do
      ByteString
bs <- String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String
file
      let valid :: Bool
valid = ByteString -> Bool
isOlsonFile ByteString
bs
      if Bool
valid
        then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ShowS
toZoneName String
file]
        else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    traverseDir :: String -> IO [String]
traverseDir String
top = do
      [String]
ds <- String -> IO [String]
getDirectoryContents String
top
      [[String]]
paths <- [String] -> (String -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String
".", String
".."]) [String]
ds) ((String -> IO [String]) -> IO [[String]])
-> (String -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \String
d -> do
        let path :: String
path = String
top String -> ShowS
</> String
d
        FileStatus
s <- String -> IO FileStatus
getFileStatus String
path
        if FileStatus -> Bool
isDirectory FileStatus
s
          then String -> IO [String]
traverseDir String
path
          else String -> IO [String]
toResult String
path
      [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
paths)

-- helper functions

tzdbDir :: FilePath
tzdbDir :: String
tzdbDir = String
"/usr" String -> ShowS
</> String
"share" String -> ShowS
</> String
"zoneinfo"

defaultLoadZoneFromOlsonFile :: LoadZoneFromOlsonFile
defaultLoadZoneFromOlsonFile :: LoadZoneFromOlsonFile
defaultLoadZoneFromOlsonFile String
file = do
  Bool
exists <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (TimeZoneDoesNotExistException -> IO ()
forall e a. Exception e => e -> IO a
throwIO TimeZoneDoesNotExistException
TimeZoneDoesNotExistException)
  ByteString
bs <- String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String
file
  (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM) <- ByteString -> IO (UtcTransitionsMap, CalDateTransitionsMap)
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m (UtcTransitionsMap, CalDateTransitionsMap)
getTransitions ByteString
bs
  (UtcTransitionsMap, CalDateTransitionsMap)
-> IO (UtcTransitionsMap, CalDateTransitionsMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM)

timeZoneNameFromPath :: FilePath -> String
timeZoneNameFromPath :: ShowS
timeZoneNameFromPath = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
drp ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [String] -> [String]) -> [String] -> String -> [String]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> [String] -> [String]
collect [[]]
  where
    drp :: [String] -> [String]
drp = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"zoneinfo")
    collect :: Char -> [String] -> [String]
collect Char
ch l :: [String]
l@(String
x:[String]
xs)
      | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = []String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
l
      | Bool
otherwise = (Char
chChar -> ShowS
forall a. a -> [a] -> [a]
:String
x)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs
    collect Char
_ [String]
_ = String -> [String]
forall a. HasCallStack => String -> a
error String
"impossible: only used to prove pattern is exhaustive"