{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module System.Taffybar.Widget.SimpleClock
  ( textClockNew
  , textClockNewWith
  , defaultClockConfig
  , ClockConfig(..)
  , ClockUpdateStrategy(..)
  ) where

import           Control.Monad.IO.Class
import           Data.Default ( Default(..) )
import           Data.Maybe
import qualified Data.Text as T
import           Data.Time.Calendar ( toGregorian )
import qualified Data.Time.Clock as Clock
import           Data.Time.Format
import           Data.Time.LocalTime
import qualified Data.Time.Locale.Compat as L
import qualified GI.Gdk as Gdk
import           GI.Gtk
import           System.Taffybar.Widget.Generic.PollingLabel
import           System.Taffybar.Widget.Util

-- | This module implements a very simple text-based clock widget. The widget
-- also toggles a calendar widget when clicked. This calendar is not fancy at
-- all and has no data backend.

makeCalendar :: IO TimeZone -> IO Window
makeCalendar :: IO TimeZone -> IO Window
makeCalendar IO TimeZone
tzfn = do
  Window
container <- WindowType -> IO Window
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WindowType -> m Window
windowNew WindowType
WindowTypeToplevel
  Calendar
cal <- IO Calendar
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Calendar
calendarNew
  Window -> Calendar -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd Window
container Calendar
cal
  SignalHandlerId
_ <- Window -> ((?self::Window) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onWidgetShow Window
container (((?self::Window) => IO ()) -> IO SignalHandlerId)
-> ((?self::Window) => IO ()) -> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ Calendar -> IO TimeZone -> IO ()
resetCalendarDate Calendar
cal IO TimeZone
tzfn
  -- Hide the calendar instead of destroying it
  SignalHandlerId
_ <- Window
-> ((?self::Window) => WidgetDeleteEventCallback)
-> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => WidgetDeleteEventCallback) -> m SignalHandlerId
onWidgetDeleteEvent Window
container (((?self::Window) => WidgetDeleteEventCallback)
 -> IO SignalHandlerId)
-> ((?self::Window) => WidgetDeleteEventCallback)
-> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ \Event
_ -> Window -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetHide Window
container IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  Window -> IO Window
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Window
container

resetCalendarDate :: Calendar -> IO TimeZone -> IO ()
resetCalendarDate :: Calendar -> IO TimeZone -> IO ()
resetCalendarDate Calendar
cal IO TimeZone
tzfn = do
  TimeZone
tz <- IO TimeZone
tzfn
  UTCTime
current <- IO UTCTime
Clock.getCurrentTime
  let (Year
y,MonthOfYear
m,MonthOfYear
d) = Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian (Day -> (Year, MonthOfYear, MonthOfYear))
-> Day -> (Year, MonthOfYear, MonthOfYear)
forall a b. (a -> b) -> a -> b
$ LocalTime -> Day
localDay (LocalTime -> Day) -> LocalTime -> Day
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz UTCTime
current
  Calendar -> Word32 -> Word32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCalendar a) =>
a -> Word32 -> Word32 -> m ()
calendarSelectMonth Calendar
cal (MonthOfYear -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
m Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1) (Year -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
y)
  Calendar -> Word32 -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCalendar a) =>
a -> Word32 -> m ()
calendarSelectDay Calendar
cal (MonthOfYear -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
d)

toggleCalendar :: IsWidget w => w -> Window -> IO Bool
toggleCalendar :: forall w. IsWidget w => w -> Window -> IO Bool
toggleCalendar w
w Window
c = do
  Bool
isVis <- Window -> IO Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m Bool
widgetGetVisible Window
c
  if Bool
isVis
    then Window -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetHide Window
c
    else do
      w -> Text -> Window -> IO ()
forall w wnd.
(IsWidget w, IsWindow wnd) =>
w -> Text -> wnd -> IO ()
attachPopup w
w Text
"Calendar" Window
c
      w -> Window -> IO ()
forall w wnd.
(IsWidget w, IsWidget wnd, IsWindow wnd) =>
w -> wnd -> IO ()
displayPopup w
w Window
c
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Create the widget. I recommend passing @Nothing@ for the TimeLocale
-- parameter. The format string can include Pango markup
-- (<http://developer.gnome.org/pango/stable/PangoMarkupFormat.html>).
textClockNew ::
  MonadIO m => Maybe L.TimeLocale -> String -> Double -> m GI.Gtk.Widget
textClockNew :: forall (m :: * -> *).
MonadIO m =>
Maybe TimeLocale -> String -> Double -> m Widget
textClockNew Maybe TimeLocale
userLocale String
format Double
interval =
  ClockConfig -> m Widget
forall (m :: * -> *). MonadIO m => ClockConfig -> m Widget
textClockNewWith ClockConfig
cfg
  where
    cfg :: ClockConfig
cfg = ClockConfig
forall a. Default a => a
def { clockTimeLocale :: Maybe TimeLocale
clockTimeLocale = Maybe TimeLocale
userLocale
              , clockFormatString :: String
clockFormatString = String
format
              , clockUpdateStrategy :: ClockUpdateStrategy
clockUpdateStrategy = Double -> ClockUpdateStrategy
ConstantInterval Double
interval
              }

data ClockUpdateStrategy
  = ConstantInterval Double
  | RoundedTargetInterval Int Double
  deriving (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
(ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> Eq ClockUpdateStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
== :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
$c/= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
/= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
Eq, Eq ClockUpdateStrategy
Eq ClockUpdateStrategy
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Ordering)
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> (ClockUpdateStrategy -> ClockUpdateStrategy -> Bool)
-> (ClockUpdateStrategy
    -> ClockUpdateStrategy -> ClockUpdateStrategy)
-> (ClockUpdateStrategy
    -> ClockUpdateStrategy -> ClockUpdateStrategy)
-> Ord ClockUpdateStrategy
ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
ClockUpdateStrategy -> ClockUpdateStrategy -> Ordering
ClockUpdateStrategy -> ClockUpdateStrategy -> ClockUpdateStrategy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClockUpdateStrategy -> ClockUpdateStrategy -> Ordering
compare :: ClockUpdateStrategy -> ClockUpdateStrategy -> Ordering
$c< :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
< :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
$c<= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
<= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
$c> :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
> :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
$c>= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
>= :: ClockUpdateStrategy -> ClockUpdateStrategy -> Bool
$cmax :: ClockUpdateStrategy -> ClockUpdateStrategy -> ClockUpdateStrategy
max :: ClockUpdateStrategy -> ClockUpdateStrategy -> ClockUpdateStrategy
$cmin :: ClockUpdateStrategy -> ClockUpdateStrategy -> ClockUpdateStrategy
min :: ClockUpdateStrategy -> ClockUpdateStrategy -> ClockUpdateStrategy
Ord, MonthOfYear -> ClockUpdateStrategy -> ShowS
[ClockUpdateStrategy] -> ShowS
ClockUpdateStrategy -> String
(MonthOfYear -> ClockUpdateStrategy -> ShowS)
-> (ClockUpdateStrategy -> String)
-> ([ClockUpdateStrategy] -> ShowS)
-> Show ClockUpdateStrategy
forall a.
(MonthOfYear -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MonthOfYear -> ClockUpdateStrategy -> ShowS
showsPrec :: MonthOfYear -> ClockUpdateStrategy -> ShowS
$cshow :: ClockUpdateStrategy -> String
show :: ClockUpdateStrategy -> String
$cshowList :: [ClockUpdateStrategy] -> ShowS
showList :: [ClockUpdateStrategy] -> ShowS
Show)

data ClockConfig = ClockConfig
  { ClockConfig -> Maybe TimeZone
clockTimeZone :: Maybe TimeZone
  , ClockConfig -> Maybe TimeLocale
clockTimeLocale :: Maybe L.TimeLocale
  , ClockConfig -> String
clockFormatString :: String
  , ClockConfig -> ClockUpdateStrategy
clockUpdateStrategy :: ClockUpdateStrategy
  } deriving (ClockConfig -> ClockConfig -> Bool
(ClockConfig -> ClockConfig -> Bool)
-> (ClockConfig -> ClockConfig -> Bool) -> Eq ClockConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClockConfig -> ClockConfig -> Bool
== :: ClockConfig -> ClockConfig -> Bool
$c/= :: ClockConfig -> ClockConfig -> Bool
/= :: ClockConfig -> ClockConfig -> Bool
Eq, Eq ClockConfig
Eq ClockConfig
-> (ClockConfig -> ClockConfig -> Ordering)
-> (ClockConfig -> ClockConfig -> Bool)
-> (ClockConfig -> ClockConfig -> Bool)
-> (ClockConfig -> ClockConfig -> Bool)
-> (ClockConfig -> ClockConfig -> Bool)
-> (ClockConfig -> ClockConfig -> ClockConfig)
-> (ClockConfig -> ClockConfig -> ClockConfig)
-> Ord ClockConfig
ClockConfig -> ClockConfig -> Bool
ClockConfig -> ClockConfig -> Ordering
ClockConfig -> ClockConfig -> ClockConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClockConfig -> ClockConfig -> Ordering
compare :: ClockConfig -> ClockConfig -> Ordering
$c< :: ClockConfig -> ClockConfig -> Bool
< :: ClockConfig -> ClockConfig -> Bool
$c<= :: ClockConfig -> ClockConfig -> Bool
<= :: ClockConfig -> ClockConfig -> Bool
$c> :: ClockConfig -> ClockConfig -> Bool
> :: ClockConfig -> ClockConfig -> Bool
$c>= :: ClockConfig -> ClockConfig -> Bool
>= :: ClockConfig -> ClockConfig -> Bool
$cmax :: ClockConfig -> ClockConfig -> ClockConfig
max :: ClockConfig -> ClockConfig -> ClockConfig
$cmin :: ClockConfig -> ClockConfig -> ClockConfig
min :: ClockConfig -> ClockConfig -> ClockConfig
Ord, MonthOfYear -> ClockConfig -> ShowS
[ClockConfig] -> ShowS
ClockConfig -> String
(MonthOfYear -> ClockConfig -> ShowS)
-> (ClockConfig -> String)
-> ([ClockConfig] -> ShowS)
-> Show ClockConfig
forall a.
(MonthOfYear -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MonthOfYear -> ClockConfig -> ShowS
showsPrec :: MonthOfYear -> ClockConfig -> ShowS
$cshow :: ClockConfig -> String
show :: ClockConfig -> String
$cshowList :: [ClockConfig] -> ShowS
showList :: [ClockConfig] -> ShowS
Show)

-- | A clock configuration that defaults to the current locale
defaultClockConfig :: ClockConfig
defaultClockConfig :: ClockConfig
defaultClockConfig = ClockConfig
  { clockTimeZone :: Maybe TimeZone
clockTimeZone = Maybe TimeZone
forall a. Maybe a
Nothing
  , clockTimeLocale :: Maybe TimeLocale
clockTimeLocale = Maybe TimeLocale
forall a. Maybe a
Nothing
  , clockFormatString :: String
clockFormatString = String
"%a %b %_d %r"
  , clockUpdateStrategy :: ClockUpdateStrategy
clockUpdateStrategy = MonthOfYear -> Double -> ClockUpdateStrategy
RoundedTargetInterval MonthOfYear
5 Double
0.0
  }

instance Default ClockConfig where
  def :: ClockConfig
def = ClockConfig
defaultClockConfig

systemGetTZ :: IO TimeZone
systemGetTZ :: IO TimeZone
systemGetTZ = IO ()
setTZ IO () -> IO TimeZone -> IO TimeZone
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO TimeZone
getCurrentTimeZone

-- | Old versions of time do not call localtime_r properly. We set the time zone
-- manually, if required.
setTZ :: IO ()
#if MIN_VERSION_time(1, 4, 2)
setTZ :: IO ()
setTZ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
setTZ = c_tzsetp

foreign import ccall unsafe "time.h tzset"
  c_tzset :: IO ()
#endif

-- | A configurable text-based clock widget.  It currently allows for
-- a configurable time zone through the 'ClockConfig'.
--
-- See also 'textClockNew'.
textClockNewWith :: MonadIO m => ClockConfig -> m Widget
textClockNewWith :: forall (m :: * -> *). MonadIO m => ClockConfig -> m Widget
textClockNewWith ClockConfig
                   { clockTimeZone :: ClockConfig -> Maybe TimeZone
clockTimeZone = Maybe TimeZone
userZone
                   , clockTimeLocale :: ClockConfig -> Maybe TimeLocale
clockTimeLocale = Maybe TimeLocale
userLocale
                   , clockFormatString :: ClockConfig -> String
clockFormatString = String
formatString
                   , clockUpdateStrategy :: ClockConfig -> ClockUpdateStrategy
clockUpdateStrategy = ClockUpdateStrategy
updateStrategy
                   } = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
  let getTZ :: IO TimeZone
getTZ = IO TimeZone
-> (TimeZone -> IO TimeZone) -> Maybe TimeZone -> IO TimeZone
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO TimeZone
systemGetTZ TimeZone -> IO TimeZone
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TimeZone
userZone
      locale :: TimeLocale
locale = TimeLocale -> Maybe TimeLocale -> TimeLocale
forall a. a -> Maybe a -> a
fromMaybe TimeLocale
L.defaultTimeLocale Maybe TimeLocale
userLocale

  let getUserZonedTime :: IO ZonedTime
getUserZonedTime =
        TimeZone -> UTCTime -> ZonedTime
utcToZonedTime (TimeZone -> UTCTime -> ZonedTime)
-> IO TimeZone -> IO (UTCTime -> ZonedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeZone
getTZ IO (UTCTime -> ZonedTime) -> IO UTCTime -> IO ZonedTime
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO UTCTime
Clock.getCurrentTime

      doTimeFormat :: ZonedTime -> Text
doTimeFormat ZonedTime
zonedTime = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
locale String
formatString ZonedTime
zonedTime

      getRoundedTimeAndNextTarget :: IO (Text, Maybe Text, Double)
getRoundedTimeAndNextTarget = do
        ZonedTime
zonedTime <- IO ZonedTime
getUserZonedTime
        (Text, Maybe Text, Double) -> IO (Text, Maybe Text, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Maybe Text, Double) -> IO (Text, Maybe Text, Double))
-> (Text, Maybe Text, Double) -> IO (Text, Maybe Text, Double)
forall a b. (a -> b) -> a -> b
$ case ClockUpdateStrategy
updateStrategy of
          ConstantInterval Double
interval ->
            (ZonedTime -> Text
doTimeFormat ZonedTime
zonedTime, Maybe Text
forall a. Maybe a
Nothing, Double
interval)
          RoundedTargetInterval MonthOfYear
roundSeconds Double
offset ->
            let roundSecondsDiffTime :: NominalDiffTime
roundSecondsDiffTime = MonthOfYear -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
roundSeconds
                addTheRound :: LocalTime -> LocalTime
addTheRound = NominalDiffTime -> LocalTime -> LocalTime
addLocalTime NominalDiffTime
roundSecondsDiffTime
                localTime :: LocalTime
localTime = ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
zonedTime
                ourLocalTimeOfDay :: TimeOfDay
ourLocalTimeOfDay = LocalTime -> TimeOfDay
localTimeOfDay LocalTime
localTime
                seconds :: MonthOfYear
seconds = Pico -> MonthOfYear
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico -> MonthOfYear) -> Pico -> MonthOfYear
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Pico
todSec TimeOfDay
ourLocalTimeOfDay
                secondsFactor :: MonthOfYear
secondsFactor = MonthOfYear
seconds MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Integral a => a -> a -> a
`div` MonthOfYear
roundSeconds
                displaySeconds :: MonthOfYear
displaySeconds = MonthOfYear
secondsFactor MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Num a => a -> a -> a
* MonthOfYear
roundSeconds
                baseLocalTimeOfDay :: TimeOfDay
baseLocalTimeOfDay =
                  TimeOfDay
ourLocalTimeOfDay { todSec :: Pico
todSec = MonthOfYear -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
displaySeconds }
                ourLocalTime :: LocalTime
ourLocalTime =
                  LocalTime
localTime { localTimeOfDay :: TimeOfDay
localTimeOfDay = TimeOfDay
baseLocalTimeOfDay }
                roundedLocalTime :: LocalTime
roundedLocalTime =
                  if MonthOfYear
seconds MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Integral a => a -> a -> a
`mod` MonthOfYear
roundSeconds MonthOfYear -> MonthOfYear -> Bool
forall a. Ord a => a -> a -> Bool
> MonthOfYear
roundSeconds MonthOfYear -> MonthOfYear -> MonthOfYear
forall a. Integral a => a -> a -> a
`div` MonthOfYear
2
                  then LocalTime -> LocalTime
addTheRound LocalTime
ourLocalTime
                  else LocalTime
ourLocalTime
                roundedZonedTime :: ZonedTime
roundedZonedTime =
                  ZonedTime
zonedTime { zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = LocalTime
roundedLocalTime }
                nextTarget :: LocalTime
nextTarget = LocalTime -> LocalTime
addTheRound LocalTime
ourLocalTime
                amountToWait :: Double
amountToWait = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ LocalTime -> LocalTime -> NominalDiffTime
diffLocalTime LocalTime
nextTarget LocalTime
localTime
            in (ZonedTime -> Text
doTimeFormat ZonedTime
roundedZonedTime, Maybe Text
forall a. Maybe a
Nothing, Double
amountToWait Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
offset)

  Widget
label <- IO (Text, Maybe Text, Double) -> IO Widget
forall (m :: * -> *).
MonadIO m =>
IO (Text, Maybe Text, Double) -> m Widget
pollingLabelWithVariableDelay IO (Text, Maybe Text, Double)
getRoundedTimeAndNextTarget
  EventBox
ebox <- IO EventBox
forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
eventBoxNew
  EventBox -> Widget -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
containerAdd EventBox
ebox Widget
label
  EventBox -> Bool -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEventBox a) =>
a -> Bool -> m ()
eventBoxSetVisibleWindow EventBox
ebox Bool
False
  Window
cal <- IO TimeZone -> IO Window
makeCalendar IO TimeZone
getTZ
  SignalHandlerId
_ <- EventBox
-> ((?self::EventBox) => WidgetButtonPressEventCallback)
-> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a
-> ((?self::a) => WidgetButtonPressEventCallback)
-> m SignalHandlerId
onWidgetButtonPressEvent EventBox
ebox (((?self::EventBox) => WidgetButtonPressEventCallback)
 -> IO SignalHandlerId)
-> ((?self::EventBox) => WidgetButtonPressEventCallback)
-> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ [EventType] -> IO Bool -> WidgetButtonPressEventCallback
forall a. [EventType] -> IO a -> WidgetButtonPressEventCallback
onClick [EventType
Gdk.EventTypeButtonPress] (IO Bool -> WidgetButtonPressEventCallback)
-> IO Bool -> WidgetButtonPressEventCallback
forall a b. (a -> b) -> a -> b
$
       Widget -> Window -> IO Bool
forall w. IsWidget w => w -> Window -> IO Bool
toggleCalendar Widget
label Window
cal
  EventBox -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
widgetShowAll EventBox
ebox
  EventBox -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget EventBox
ebox