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

import           Control.Monad.IO.Class
import           Data.Maybe
import qualified Data.Text as T
import qualified Data.Time.Clock as Clock
import           Data.Time.Format
import           Data.Time.LocalTime
import qualified Data.Time.Locale.Compat as L
import           GI.Gtk
import           System.Taffybar.Widget.Generic.PollingLabel

type ClockFormat = L.TimeLocale -> ZonedTime -> T.Text

-- | 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 -> ClockFormat -> Double -> m GI.Gtk.Widget
textClockNew userLocale format interval =
  textClockNewWith cfg
  where
    cfg = defaultClockConfig { clockTimeLocale = userLocale
                             , clockFormat = format
                             , clockUpdateStrategy = ConstantInterval interval
                             }

data ClockUpdateStrategy
  = ConstantInterval Double
  | RoundedTargetInterval Int Double
  deriving (Eq, Ord, Show)

data ClockConfig = ClockConfig
  { clockTimeZone :: Maybe TimeZone
  , clockTimeLocale :: Maybe L.TimeLocale
  , clockFormat :: ClockFormat
  , clockUpdateStrategy :: ClockUpdateStrategy
  }

-- | A clock configuration that defaults to the current locale
defaultClockConfig :: ClockConfig
defaultClockConfig = ClockConfig
  { clockTimeZone = Nothing
  , clockTimeLocale = Nothing
  , clockFormat = \locale zonedTime -> T.pack $ formatTime locale "%a %b %_d %r" zonedTime
  , clockUpdateStrategy = RoundedTargetInterval 5 0.0
  }

systemGetTZ :: IO TimeZone
systemGetTZ = getCurrentTimeZone

-- | 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 ClockConfig
                   { clockTimeZone = userZone
                   , clockTimeLocale = userLocale
                   , clockFormat = format
                   , clockUpdateStrategy = updateStrategy
                   } = liftIO $ do
  let getTZ = maybe systemGetTZ return userZone
      locale = fromMaybe L.defaultTimeLocale userLocale

  let getUserZonedTime =
        utcToZonedTime <$> getTZ <*> Clock.getCurrentTime

      doTimeFormat = format locale

      getRoundedTimeAndNextTarget = do
        zonedTime <- getUserZonedTime
        return $ case updateStrategy of
          ConstantInterval interval ->
            (doTimeFormat zonedTime, Nothing, interval)
          RoundedTargetInterval roundSeconds offset ->
            let roundSecondsDiffTime = fromIntegral roundSeconds
                addTheRound = addLocalTime roundSecondsDiffTime
                localTime = zonedTimeToLocalTime zonedTime
                ourLocalTimeOfDay = localTimeOfDay localTime
                seconds = round $ todSec ourLocalTimeOfDay
                secondsFactor = seconds `div` roundSeconds
                displaySeconds = secondsFactor * roundSeconds
                baseLocalTimeOfDay =
                  ourLocalTimeOfDay { todSec = fromIntegral displaySeconds }
                ourLocalTime =
                  localTime { localTimeOfDay = baseLocalTimeOfDay }
                roundedLocalTime =
                  if seconds `mod` roundSeconds > roundSeconds `div` 2
                  then addTheRound ourLocalTime
                  else ourLocalTime
                roundedZonedTime =
                  zonedTime { zonedTimeToLocalTime = roundedLocalTime }
                nextTarget = addTheRound ourLocalTime
                amountToWait = realToFrac $ diffLocalTime nextTarget localTime
            in (doTimeFormat roundedZonedTime, Nothing, amountToWait - offset)

  label <- pollingLabelWithVariableDelay getRoundedTimeAndNextTarget
  ebox <- eventBoxNew
  containerAdd ebox label
  eventBoxSetVisibleWindow ebox False
  widgetShowAll ebox
  toWidget ebox