[Haskell-cafe] Re: Working with multiple time zones

Don Stewart dons at galois.com
Sun Feb 17 14:37:17 EST 2008


beakerchu:
> Hurrah, I am now calling the C function tzset() from my Haskell code
> via FFI, and I'm getting the results I want.
> 
> $ cat hsc2now.hs
> {-# LANGUAGE ForeignFunctionInterface #-}
> import Data.Time
> import Data.Time.LocalTime
> import System.Environment
> import System.Posix.Env
> foreign import ccall "time.h tzset" tzset :: IO ()
> outTime utc tzName
>   = do putEnv ("TZ=" ++ tzName)
>        tzset
>        tz <- getTimeZone utc
>        putStrLn (tzName ++ "\t" ++ show (utcToLocalTime tz utc))
> main
>   = do utc <- getCurrentTime
>        mapM_ (outTime utc) =<< getArgs
> $ ghc --make hsc2now.hs -o hsc2now
> [1 of 1] Compiling Main             ( hsc2now.hs, hsc2now.o )
> Linking hsc2now ...
> $ ./hsc2now Europe/Moscow Europe/Paris Europe/London
> Europe/Moscow   2008-02-17 22:06:44.770153
> Europe/Paris    2008-02-17 20:06:44.770153
> Europe/London   2008-02-17 19:06:44.770153
> 
> Thank you everyone for your help :-)

Perhaps we should get a binding to tzset in the unix library?


More information about the Haskell-Cafe mailing list