{-# LANGUAGE CPP #-}
{-# LANGUAGE DoAndIfThenElse #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.DateZone
-- Copyright   :  (c) Martin Perner
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Martin Perner <martin@perner.cc>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A date plugin with localization and location support for Xmobar
--
-- Based on Plugins.Date
--
-- Usage example: in template put
--
-- > Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "UTC" "utcDate" 10
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.DateZone (DateZone(..)) where

import Xmobar.Run.Exec

#ifdef DATEZONE
import Control.Concurrent.STM

import System.IO.Unsafe
import System.Environment (lookupEnv)

import Data.Maybe (fromMaybe)

import Data.Time.Format
import Data.Time.LocalTime
import Data.Time.LocalTime.TimeZone.Olson
import Data.Time.LocalTime.TimeZone.Series

import Xmobar.System.Localize

#if ! MIN_VERSION_time(1,5,0)
import System.Locale (TimeLocale)
#endif
#else
import System.IO
import Xmobar.Plugins.Date
#endif



data DateZone = DateZone String String String String Int
    deriving (ReadPrec [DateZone]
ReadPrec DateZone
Int -> ReadS DateZone
ReadS [DateZone]
(Int -> ReadS DateZone)
-> ReadS [DateZone]
-> ReadPrec DateZone
-> ReadPrec [DateZone]
-> Read DateZone
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DateZone
readsPrec :: Int -> ReadS DateZone
$creadList :: ReadS [DateZone]
readList :: ReadS [DateZone]
$creadPrec :: ReadPrec DateZone
readPrec :: ReadPrec DateZone
$creadListPrec :: ReadPrec [DateZone]
readListPrec :: ReadPrec [DateZone]
Read, Int -> DateZone -> ShowS
[DateZone] -> ShowS
DateZone -> String
(Int -> DateZone -> ShowS)
-> (DateZone -> String) -> ([DateZone] -> ShowS) -> Show DateZone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DateZone -> ShowS
showsPrec :: Int -> DateZone -> ShowS
$cshow :: DateZone -> String
show :: DateZone -> String
$cshowList :: [DateZone] -> ShowS
showList :: [DateZone] -> ShowS
Show)

instance Exec DateZone where
    alias :: DateZone -> String
alias (DateZone String
_ String
_ String
_ String
a Int
_) = String
a
#ifndef DATEZONE
    start (DateZone f _ _ a r) cb = do
      hPutStrLn stderr $ "Warning: DateZone plugin needs -fwith_datezone."++
                  " Using Date plugin instead."
      start (Date f a r) cb
#else
    start :: DateZone -> (String -> IO ()) -> IO ()
start (DateZone String
f String
l String
z String
_ Int
r) String -> IO ()
cb = do
      lock <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar Bool -> STM Bool
forall a. TMVar a -> STM a
takeTMVar TMVar Bool
localeLock
      setupTimeLocale l
      locale <- getTimeLocale
      atomically $ putTMVar localeLock lock
      if z /= "" then do
        tzdir <- lookupEnv "TZDIR"
        timeZone <- getTimeZoneSeriesFromOlsonFile ((fromMaybe "/usr/share/zoneinfo" tzdir) ++ "/" ++ z)
        go (dateZone f locale timeZone)
       else
        go (date f locale)

      where go :: IO String -> IO ()
go IO String
func = Int -> IO () -> IO ()
doEveryTenthSeconds Int
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO String
func IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
cb

{-# NOINLINE localeLock #-}
-- ensures that only one plugin instance sets the locale
localeLock :: TMVar Bool
localeLock :: TMVar Bool
localeLock = IO (TMVar Bool) -> TMVar Bool
forall a. IO a -> a
unsafePerformIO (Bool -> IO (TMVar Bool)
forall a. a -> IO (TMVar a)
newTMVarIO Bool
False)

date :: String -> TimeLocale -> IO String
date :: String -> TimeLocale -> IO String
date String
format TimeLocale
loc = IO ZonedTime
getZonedTime IO ZonedTime -> (ZonedTime -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ZonedTime -> String) -> ZonedTime -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
loc String
format

dateZone :: String -> TimeLocale -> TimeZoneSeries -> IO String
dateZone :: String -> TimeLocale -> TimeZoneSeries -> IO String
dateZone String
format TimeLocale
loc TimeZoneSeries
timeZone = IO ZonedTime
getZonedTime IO ZonedTime -> (ZonedTime -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (ZonedTime -> String) -> ZonedTime -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
loc String
format (LocalTime -> String)
-> (ZonedTime -> LocalTime) -> ZonedTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZoneSeries -> UTCTime -> LocalTime
utcToLocalTime' TimeZoneSeries
timeZone (UTCTime -> LocalTime)
-> (ZonedTime -> UTCTime) -> ZonedTime -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC
--   zonedTime <- getZonedTime
--   return $ formatTime loc format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime
#endif