Status.hs

-- | Uses the status icon's tooltip and image to show the current status
module Controller.Conditions.Status where

import Control.Arrow
import Control.Monad
import Control.Monad.IfElse
import Data.Maybe
import Graphics.UI.Gtk
import Hails.MVC.Model.ProtectedModel.UpdatableModel
import Hails.MVC.Model.ProtectedModel.VersionedModel

import CombinedEnvironment
import Model.Model (Status(..))
import Hails.MVC.Model.ProtectedModel.Reactive
import Paths
import I18N.Strings

-- | Detect when the status must be updated, and installs the icon in the traybar.
installHandlers :: CEnv -> IO()
installHandlers cenv = void $ do
  -- Detect status changes
  onEvents pm evs $ condition cenv

  -- It tries to embed the icon every two secons until it is embedded
  flip timeoutAdd 2000 $ do
     condition cenv
     fmap not $ statusIconIsEmbedded =<< (trayIcon . mainWindowBuilder . view) cenv

  where pm  = model cenv
        evs = [ Initialised, StatusChanged, CameraStatusChanged 
              , NotificationEnabledChanged, updateNotificationEvent
              ]
              ++ events notificationEnabledField
              ++ events notificationIconEnabledField

-- | Refresh the status icon
--
-- Model => View
condition :: CEnv -> IO()
condition cenv = onViewAsync $ do
  let (vw, pm) = (view &&& model) cenv
  -- View
  icon          <- trayIcon $ mainWindowBuilder vw 

  -- Model
  status        <- getStatus pm
  notifyEnabled <- getter notificationEnabledField pm
  iconEnabled   <- getter notificationIconEnabledField pm

  newV <- getMaxVersionAvail pm
  curV <- getVersion pm
  let updateFound = isJust newV && curV < fromJust newV

  -- Get new icon value
  let stView = getStatusIcon iconEnabled notifyEnabled status updateFound

  -- Condition
  awhen stView $ \(imgFn, tooltip) -> do
    getDataFileName imgFn >>= statusIconSetFromFile icon
    statusIconSetTooltip icon tooltip
    statusIconSetVisible icon True

-- | Table that determines the status image to be used depeding on the internal
-- status of the program.
-- 
-- getStatusIcon <IconNotificationEnabled> <NotificationEnabled> <Status> <UpdateFound>
--
getStatusIcon :: Bool -> Bool -> Status -> Bool -> Maybe (String, String)
getStatusIcon  _      _      StatusDisabled     False  = Just (statusImages!!1)
getStatusIcon  _      True   StatusFinding      False  = Just (statusImages!!6)
getStatusIcon  _      False  StatusFinding      False  = Just (statusImages!!1)
getStatusIcon  _      True   StatusIdle         False  = Just (statusImages!!0)
getStatusIcon  _      False  StatusIdle         False  = Just (statusImages!!1)
getStatusIcon  True   True   StatusNotifying    False  = Just (statusImages!!2)
getStatusIcon  False  True   StatusNotifying    False  = Just (statusImages!!0)
getStatusIcon  _      False  StatusCallibrating False  = Just (statusImages!!9)
getStatusIcon  _      _      StatusDisabled     True   = Just (statusImages!!4)
getStatusIcon  _      True   StatusFinding      True   = Just (statusImages!!7)
getStatusIcon  _      False  StatusFinding      True   = Just (statusImages!!4)
getStatusIcon  _      True   StatusIdle         True   = Just (statusImages!!3)
getStatusIcon  _      False  StatusIdle         True   = Just (statusImages!!4)
getStatusIcon  True   True   StatusNotifying    True   = Just (statusImages!!5)
getStatusIcon  False  True   StatusNotifying    True   = Just (statusImages!!3)
getStatusIcon  _      False  StatusCallibrating True   = Just (statusImages!!10)
getStatusIcon  _      _      _                  _      = Nothing

  -- Patterns not matched: _    True  StatusCallibrating _
  --                       True True  StatusDisabled     False
  --                       True False StatusNotifying    _

-- | Table with all the possible statuses and tooltips
statusImages :: [(String, String)]
statusImages =
  [ ("icon-good-posture.png",           kpost)
  , ("icon-disabled.png",               kpost ++ disabled)
  , ("icon-bad-posture.png",            wpost)
  , ("icon-good-posture-update.png",    kpost ++ update)
  , ("icon-disabled-update.png",        kpost ++ disabled ++ update)
  , ("icon-bad-posture-update.png",     wpost ++ update)
  , ("icon-unknown-posture.png",        kpost ++ finding)
  , ("icon-unknown-posture-update.png", kpost ++ finding ++ update)
  , ("icon-calibrating.png",            kpost ++ calib)
  , ("icon-calibrating-update.png",     kpost ++ calib ++ update)
  ]
 where update   = sep ++ strUpdateAvailable
       disabled = sep ++ strDisabled
       finding  = sep ++ strFinding
       calib    = sep ++ strCalibrating
       kpost    = "Keera Posture"
       wpost    = strWrongPosture
       sep      = " - "