{-# LANGUAGE CPP #-}
module IOUtil(-- ** Some utilities that are a little dirty, but not very
              getEnvi, progName, progArgs,
              -- ** Backward compatibility
              IOUtil.catch, try, getModificationTime) where

import qualified Control.Exception as E
import qualified System.Directory as D(getModificationTime)
import System.Environment(getEnv,getProgName,getArgs)
#ifdef VERSION_old_time
import Data.Time(UTCTime)
import Data.Time.Clock.POSIX(utcTimeToPOSIXSeconds)
import System.Time(ClockTime(..))
#endif
import UnsafePerformIO(unsafePerformIO)

getEnvi :: String -> Maybe String
getEnvi :: String -> Maybe String
getEnvi String
s = (IOError -> Maybe String)
-> (String -> Maybe String)
-> Either IOError String
-> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe String -> IOError -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) String -> Maybe String
forall a. a -> Maybe a
Just (Either IOError String -> Maybe String)
-> Either IOError String -> Maybe String
forall a b. (a -> b) -> a -> b
$ IO (Either IOError String) -> Either IOError String
forall a. IO a -> a
unsafePerformIO (IO (Either IOError String) -> Either IOError String)
-> IO (Either IOError String) -> Either IOError String
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either IOError String)
forall a. IO a -> IO (Either IOError a)
try (String -> IO String
getEnv String
s)

progName :: String
progName :: String
progName = IO String -> String
forall a. IO a -> a
unsafePerformIO IO String
getProgName

progArgs :: [String]
progArgs :: [String]
progArgs = IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO IO [String]
getArgs

-- * GHC 6.12-7.6 compatibility
catch :: IO a -> (IOError -> IO a) -> IO a
catch = forall a. IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch :: IO a -> (IOError -> IO a) -> IO a
try :: IO a -> IO (Either IOError a)
try   = forall a. IO a -> IO (Either IOError a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try   :: IO a -> IO (Either IOError a)

#ifdef VERSION_old_time
getModificationTime :: String -> IO ClockTime
getModificationTime String
path = UTCTime -> ClockTime
forall a. ToClockTime a => a -> ClockTime
toClockTime (UTCTime -> ClockTime) -> IO UTCTime -> IO ClockTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO UTCTime
D.getModificationTime String
path

class    ToClockTime a         where toClockTime :: a -> ClockTime
instance ToClockTime ClockTime where toClockTime :: ClockTime -> ClockTime
toClockTime = ClockTime -> ClockTime
forall a. a -> a
id
instance ToClockTime UTCTime   where 
    toClockTime :: UTCTime -> ClockTime
toClockTime = (Integer -> Integer -> ClockTime)
-> Integer -> Integer -> ClockTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> ClockTime
TOD Integer
0 (Integer -> ClockTime)
-> (UTCTime -> Integer) -> UTCTime -> ClockTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> (UTCTime -> Double) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (POSIXTime -> Double)
-> (UTCTime -> POSIXTime) -> UTCTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
#else
getModificationTime path = D.getModificationTime path
#endif