VersionNumberTitleBar.hs

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
module Hails.Graphics.UI.Gtk.Simplify.VersionNumberTitleBar where

-- External imports
import Control.Arrow
import Control.Monad
import Control.Monad.Reader (liftIO)
import Data.ExtraVersion
import Graphics.UI.Gtk
-- import Graphics.UI.Gtk.GenericView ()
import Graphics.UI.Gtk.GtkView
import Graphics.UI.View
import Hails.MVC.GenericCombinedEnvironment
import Hails.MVC.Model.ReactiveModel (Event)
import Hails.MVC.Model.ProtectedModel

-- Internal imports
import Data.ReactiveValue
import Hails.MVC.Model.ProtectedModel.VersionedModel

installHandlers :: (GtkGUI a, VersionedBasicModel b, Event c) => CEnv a b c
                -> (ViewElementAccessorIO (GtkView a) Window)
                -> IO ()
installHandlers cenv wF = void $ do
  let (vw, pm) = (view &&& model) cenv
  w <- wF vw
  w `on` mapEvent $ liftIO (condition cenv wF) >> return False

  -- -- let l f = do _ <- w `on` mapEvent $ liftIO f >> return False
  -- --              return ()
  -- let -- v1 :: (GtkGUI a, VersionedBasicModel b) => TypedReactiveValue (ProtectedModelVersion a b) String
  --     v1 = TypedReactiveValue (ProtectedModelVersion pm w) (undefined :: String)
  --     -- v2 :: TypedReactiveValue Window String
  --     v2 = TypedReactiveValue w (undefined :: String)
  -- v1 =:> v2

-- type WindowTitle = TypedReactiveValue Window String
-- 
-- instance ReactiveValueWrite Window String where
--   reactiveValueWrite w v = do
--     t  <- windowGetTitle w
--     when (t /= v) $ windowSetTitle w v
-- 
-- data ProtectedModelVersion a b =
--   ProtectedModelVersion (ProtectedModel a b) Window
-- 
-- type ProgramVersion a b = TypedReactiveValue (ProtectedModelVersion a b) String
-- 
-- instance (VersionedBasicModel b, Event c) => ReactiveValueRead (ProtectedModelVersion b c) String where
--   reactiveValueOnCanRead (ProtectedModelVersion _ w) _ op = do
--     _ <- do w `on` mapEvent $ liftIO op >> return False
--     return ()
--   reactiveValueRead (ProtectedModelVersion pm _) = do
--     fmap versionToString $ getVersion pm

condition :: (GtkGUI a, VersionedBasicModel b, Event c) => CEnv a b c
          -> (ViewElementAccessorIO (GtkView a) Window)
          -> IO ()
condition cenv wF = do
  let (vw, pm) = (view &&& model) cenv
  w  <- wF vw
  vn <- fmap versionToString $ getVersion pm
  t  <- windowGetTitle w
  when (t /= vn) $ windowSetTitle w vn