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 |