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"
  tzPath <- String -> IO String
readSymbolicLink (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
file
  let tzName = ShowS
timeZoneNameFromPath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
tzPath
  (utcM, calDateM)  <- loadZoneFromOlsonFile file
  return (utcM, calDateM, 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
      bs <- String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String
file
      let valid = ByteString -> Bool
isOlsonFile ByteString
bs
      if valid
        then return [toZoneName file]
        else return []
    traverseDir :: String -> IO [String]
traverseDir String
top = do
      ds <- String -> IO [String]
getDirectoryContents String
top
      paths <- forM (filter (not . flip elem [".", ".."]) ds) $ \String
d -> do
        let path :: String
path = String
top String -> ShowS
</> String
d
        s <- String -> IO FileStatus
getFileStatus String
path
        if isDirectory s
          then traverseDir path
          else toResult path
      return (concat 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
  exists <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
file
  unless exists (throwIO TimeZoneDoesNotExistException)
  bs <- BS.readFile $ file
  (utcM, calDateM) <- getTransitions bs
  return (utcM, 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"