diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Localize.hsc | 85 | ||||
| -rw-r--r-- | src/Plugins/DateZone.hs | 50 | 
2 files changed, 124 insertions, 11 deletions
| diff --git a/src/Localize.hsc b/src/Localize.hsc new file mode 100644 index 0000000..b302cd4 --- /dev/null +++ b/src/Localize.hsc @@ -0,0 +1,85 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- | +-- Module      :  Localize +-- Copyright   :  (C) 2011 Martin Perner +-- License     :  BSD-style (see LICENSE) +-- +-- Maintainer  :  Martin Perner <martin@perner.cc> +-- Stability   :  unstable +-- Portability :  unportable +-- +-- This module provides an interface to locale information e.g. for DateL +-- +----------------------------------------------------------------------------- + +module Localize +    ( setupTimeLocale, +      getTimeLocale +    ) where + +import Foreign.C +import qualified System.Locale as L + +#ifdef UTF8 +import Codec.Binary.UTF8.String +#endif + +--  get localized strings +type NlItem = CInt + +#include <langinfo.h> +foreign import ccall unsafe "langinfo.h nl_langinfo" +  nl_langinfo :: NlItem -> IO CString + +#{enum NlItem, +  , AM_STR , PM_STR \ +  , D_T_FMT , D_FMT , T_FMT , T_FMT_AMPM \ +  , ABDAY_1, ABDAY_7 \ +  , DAY_1, DAY_7 \ +  , ABMON_1, ABMON_12 \ +  , MON_1, MON_12\ + } + +getLangInfo :: NlItem -> IO String +getLangInfo item = do +  itemStr <- nl_langinfo item +#ifdef UTF8 +  str <- peekCString itemStr +  return $ decodeString str +#else +  peekCString itemStr +#endif + +#include <locale.h> +foreign import ccall unsafe "locale.h setlocale" +    setlocale :: CInt -> CString -> IO CString + +setupTimeLocale :: String -> IO () +setupTimeLocale l = withCString l (setlocale #const LC_TIME) >> return () + +getTimeLocale :: IO L.TimeLocale +getTimeLocale = do +  -- assumes that the defined values are increasing by exactly one. +  -- as they are defined consecutive in an enum this is reasonable +  days   <- mapM getLangInfo [day1 .. day7] +  abdays <- mapM getLangInfo [abday1 .. abday7] + +  mons   <- mapM getLangInfo [mon1 .. mon12] +  abmons <- mapM getLangInfo [abmon1 .. abmon12] + +  amstr <- getLangInfo amStr +  pmstr <- getLangInfo pmStr +  dtfmt <- getLangInfo dTFmt +  dfmt  <- getLangInfo dFmt +  tfmt  <- getLangInfo tFmt +  tfmta <- getLangInfo tFmtAmpm + +  let t =  L.defaultTimeLocale {L.wDays  = zip days abdays +                               ,L.months = zip mons abmons +                               ,L.amPm = (amstr, pmstr) +                               ,L.dateTimeFmt = dtfmt +                               ,L.dateFmt = dfmt +                               ,L.timeFmt = tfmt +                               ,L.time12Fmt = tfmta} +  return t diff --git a/src/Plugins/DateZone.hs b/src/Plugins/DateZone.hs index 4d5ce6a..86114bb 100644 --- a/src/Plugins/DateZone.hs +++ b/src/Plugins/DateZone.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DoAndIfThenElse #-}  -----------------------------------------------------------------------------  -- |  -- Module      :  Plugins.DateZone @@ -8,13 +9,13 @@  -- Stability   :  unstable  -- Portability :  unportable  -- --- A date plugin with localization support for Xmobar +-- A date plugin with localization and location support for Xmobar  --  -- Based on Plugins.Date  --  -- Usage example: in template put  -- --- > Run DateZone "%H:%M:%S" "utcDate" "UTC" 10 +-- > Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "UTC" "utcDate" 10  --  ----------------------------------------------------------------------------- @@ -22,23 +23,50 @@ module Plugins.DateZone (DateZone(..)) where  import Plugins -import System.Locale +import Localize + +import Control.Concurrent.STM  import Data.Time.LocalTime  import Data.Time.Format  import Data.Time.LocalTime.TimeZone.Olson  import Data.Time.LocalTime.TimeZone.Series -data DateZone = DateZone String String String Int +import System.IO.Unsafe +import System.Locale (TimeLocale) +import System.Time + + + +{-# NOINLINE localeLock #-} +-- ensures that only one plugin instance sets the locale +localeLock :: TMVar Bool +localeLock = unsafePerformIO (newTMVarIO False) + +data DateZone = DateZone String String String String Int      deriving (Read, Show)  instance Exec DateZone where -    alias (DateZone _ a _ _) = a -    run   (DateZone f _ z _) = date f z -    rate  (DateZone _ _ _ r) = r +    alias (DateZone _ _ _ a _) = a +    start (DateZone f l z _ r) cb = do +      lock <- atomically $ takeTMVar localeLock +      setupTimeLocale l +      locale <- getTimeLocale +      atomically $ putTMVar localeLock lock +      if z /= "" then do +        timeZone <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ z) +        go (dateZone f locale timeZone) +       else +        go (date f locale) + +      where go func = func >>= cb >> tenthSeconds r >> go func + +date :: String -> TimeLocale -> IO String +date format loc = do +  t <- toCalendarTime =<< getClockTime +  return $ formatCalendarTime loc format t -date :: String -> String -> IO String -date format zone = do -  timeZone <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ zone) +dateZone :: String -> TimeLocale -> TimeZoneSeries -> IO String +dateZone format loc timeZone = do    zonedTime <- getZonedTime -  return $ formatTime defaultTimeLocale format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime +  return $ formatTime loc format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime | 
