Core is independent of X11 now

4 files changed, 92 insertions, 84 deletions

diff --git a/lib/Phi/Widgets/AlphaBox.hs b/lib/Phi/Widgets/AlphaBox.hs
index 6f989ea..59f8aea 100644
--- a/lib/Phi/Widgets/AlphaBox.hs
+++ b/lib/Phi/Widgets/AlphaBox.hs
@@ -13,11 +13,11 @@ import Control.Monad.State.Strict
 import Graphics.Rendering.Cairo
 
 
-data AlphaBox w s c = (Widget w s c) => AlphaBox !Double !w
+data AlphaBox w s c d = (Widget w s c d) => AlphaBox !Double !w
 
-data AlphaBoxCache w s c = (Widget w s c) => AlphaBoxCache !c
+data AlphaBoxCache w s c d = (Widget w s c d) => AlphaBoxCache !c
 
-instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
+instance (Eq s, Display d) => Widget (AlphaBox w s c d) s (AlphaBoxCache w s c d) d where
   initWidget (AlphaBox _ w) = initWidget w
   initCache (AlphaBox _ w) = AlphaBoxCache $ initCache w
   
@@ -47,6 +47,6 @@ instance Eq s => Widget (AlphaBox w s c) s (AlphaBoxCache w s c) where
   handleMessage (AlphaBox _ w) = handleMessage w
 
 
-alphaBox :: (Widget w s c) => Double -> w -> AlphaBox w s c
+alphaBox :: (Widget w s c d) => Double -> w -> AlphaBox w s c d
 alphaBox = AlphaBox
 
diff --git a/lib/Phi/Widgets/Clock.hs b/lib/Phi/Widgets/Clock.hs
index 9282432..26b777f 100644
--- a/lib/Phi/Widgets/Clock.hs
+++ b/lib/Phi/Widgets/Clock.hs
@@ -34,7 +34,7 @@ data ClockConfig = ClockConfig { clockFormat :: !String
 defaultClockConfig :: ClockConfig
 defaultClockConfig = ClockConfig "%R" (0, 0, 0, 1) 0 50
 
-data Clock = Clock !ClockConfig deriving (Show, Eq)
+data Clock d = Clock !ClockConfig deriving (Show, Eq)
 
 deriving instance Eq ZonedTime
 
@@ -42,7 +42,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
 
 data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
 
-instance Widget Clock ClockState (RenderCache ClockState) where
+instance Display d => Widget (Clock d) ClockState (RenderCache ClockState) d where
   initWidget (Clock _) phi _ _ = do
     forkIO $ forever $ do
       time <- getZonedTime
@@ -85,6 +85,6 @@ instance Widget Clock ClockState (RenderCache ClockState) where
     _ -> priv
 
 
-clock :: ClockConfig -> Clock
+clock :: ClockConfig -> Clock d
 clock config = do
-  Clock config
\ No newline at end of file
+  Clock config
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/X11/Systray.hs
index 27a5e34..fffb181 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/X11/Systray.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
 
-module Phi.Widgets.Systray ( systray
-                           ) where
+module Phi.Widgets.X11.Systray ( systray
+                               ) where
 
 import Control.Concurrent
 import Control.Monad
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/X11/Taskbar.hs
index f0a8196..07a7292 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/X11/Taskbar.hs
@@ -1,15 +1,15 @@
 {-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
 
-module Phi.Widgets.Taskbar ( IconStyle
-                           , idIconStyle
-                           , desaturateIconStyle
-                           , TaskStyle(..)
-                           , DesktopStyle(..)
-                           , TaskbarConfig(..)
-                           , defaultTaskbarConfig
-                           , Taskbar
-                           , taskbar
-                           ) where
+module Phi.Widgets.X11.Taskbar ( IconStyle
+                               , idIconStyle
+                               , desaturateIconStyle
+                               , TaskStyle(..)
+                               , DesktopStyle(..)
+                               , TaskbarConfig(..)
+                               , defaultTaskbarConfig
+                               , Taskbar
+                               , taskbar
+                               ) where
 
 import Control.Arrow
 import Control.Concurrent
@@ -48,6 +48,7 @@ import Phi.Phi
 import Phi.Types
 import Phi.Border
 import Phi.Widget
+import Phi.X11
 import Phi.X11.Atoms
 import Phi.X11.Util
 
@@ -138,7 +139,7 @@ defaultTaskbarConfig = TaskbarConfig { taskMaxSize = 200
 
 data Taskbar = Taskbar TaskbarConfig
 
-data TaskbarState = TaskbarState { taskbarScreens           :: ![RECTANGLE]
+data TaskbarState = TaskbarState { taskbarScreens           :: ![Rectangle]
                                  , taskbarActiveWindow      :: !WINDOW
                                  , taskbarDesktopCount      :: !Int
                                  , taskbarCurrentDesktop    :: !Int
@@ -161,7 +162,7 @@ data WindowState = WindowState { windowTitle    :: !String
                                , windowDesktop  :: !Int
                                , windowVisible  :: !Bool
                                , windowIcons    :: ![Icon]
-                               , windowGeometry :: !RECTANGLE
+                               , windowGeometry :: !Rectangle
                                } deriving (Eq, Show)
 
 data WindowCache = WindowCache { createScaledIconCached :: !(IOCache ([Icon], Int) (Maybe Icon))
@@ -208,7 +209,7 @@ data TaskbarMessage = WindowListUpdate ![WINDOW] !(M.Map WINDOW WindowState)
                     | ActiveWindowUpdate !WINDOW
                     deriving (Typeable, Show)
 
-instance Widget Taskbar TaskbarState (M.Map WINDOW WindowCache) where
+instance Widget Taskbar TaskbarState (M.Map WINDOW WindowCache) X11 where
   initWidget (Taskbar _) phi dispvar screens = do
     phi' <- dupPhi phi
     forkIO $ taskbarRunner phi' dispvar
@@ -398,14 +399,14 @@ windowOnDesktop :: Int -> WindowState -> Bool
 windowOnDesktop desktop state = (windowVisible state) && (desktop == windowDesktop state)
 
 
-taskbarRunner :: Phi -> Display -> IO ()
-taskbarRunner phi dispvar = do
-  (windows, states) <- liftIO $ withDisplay dispvar $ \disp -> do
-    (windows, states) <- getWindowStates disp (getAtoms dispvar) M.empty
-    desktopCount <- getDesktopCount disp (getAtoms dispvar) 
-    current <- getCurrentDesktop disp (getAtoms dispvar) 
-    names <- getDesktopNames disp (getAtoms dispvar)
-    activeWindow <- getActiveWindow disp (getAtoms dispvar) 
+taskbarRunner :: Phi -> X11 -> IO ()
+taskbarRunner phi x11 = do
+  (windows, states) <- liftIO $ do
+    (windows, states) <- getWindowStates x11 M.empty
+    desktopCount <- getDesktopCount x11
+    current <- getCurrentDesktop x11
+    names <- getDesktopNames x11
+    activeWindow <- getActiveWindow x11
     sendMessage phi $ WindowListUpdate windows states
     sendMessage phi $ DesktopCountUpdate desktopCount
     sendMessage phi $ CurrentDesktopUpdate current
@@ -418,23 +419,24 @@ taskbarRunner phi dispvar = do
     m <- receiveMessage phi
     case (fromMessage m) of
       Just (XEvent event) ->
-        handleEvent phi dispvar event
+        handleEvent phi x11 event
       _ ->
         return ()
 
 
-handleEvent :: Phi -> Display -> SomeEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
-handleEvent phi dispvar event =
+handleEvent :: Phi -> X11 -> SomeEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handleEvent phi x11 event =
   case (fromEvent event) of
-    Just e -> handlePropertyNotifyEvent phi dispvar e
+    Just e -> handlePropertyNotifyEvent phi x11 e
     Nothing -> case (fromEvent event) of
-      Just e -> handleConfigureNotifyEvent phi dispvar e
+      Just e -> handleConfigureNotifyEvent phi x11 e
       Nothing -> return ()
 
-handlePropertyNotifyEvent :: Phi -> Display -> PropertyNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
-handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotifyEvent = atom, window_PropertyNotifyEvent = window} = do
-  let atoms = getAtoms dispvar
-  
+handlePropertyNotifyEvent :: Phi -> X11 -> PropertyNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handlePropertyNotifyEvent phi x11 MkPropertyNotifyEvent {atom_PropertyNotifyEvent = atom, window_PropertyNotifyEvent = window} = do
+  let atoms = x11Atoms x11
+      rootwin = root_SCREEN . x11Screen $ x11
+      
   when (elem atom $ map ($ atoms) [ atom_NET_ACTIVE_WINDOW
                                   , atom_NET_NUMBER_OF_DESKTOPS
                                   , atom_NET_CURRENT_DESKTOP
@@ -445,29 +447,28 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
                                   , atom_NET_WM_NAME
                                   , atom_NET_WM_DESKTOP
                                   , atom_NET_WM_STATE
-                                  ]) $ withDisplay dispvar $ \conn -> do
-    let rootwin = getRoot conn
+                                  ]) $ do
     if (window == rootwin)
       then do
       when (atom == atom_NET_ACTIVE_WINDOW atoms) $ do
-        activeWindow <- liftIO $ getActiveWindow conn atoms
+        activeWindow <- liftIO $ getActiveWindow x11
         sendMessage phi $ ActiveWindowUpdate activeWindow
         sendMessage phi Repaint
       when (atom == atom_NET_NUMBER_OF_DESKTOPS atoms) $ do
-        desktopCount <- liftIO $ getDesktopCount conn atoms
+        desktopCount <- liftIO $ getDesktopCount x11
         sendMessage phi $ DesktopCountUpdate desktopCount
         sendMessage phi Repaint
       when (atom == atom_NET_CURRENT_DESKTOP atoms) $ do
-        current <- liftIO $ getCurrentDesktop conn atoms
+        current <- liftIO $ getCurrentDesktop x11
         sendMessage phi $ CurrentDesktopUpdate current
         sendMessage phi Repaint
       when (atom == atom_NET_DESKTOP_NAMES atoms) $ do
-        names <- liftIO $ getDesktopNames conn atoms
+        names <- liftIO $ getDesktopNames x11
         sendMessage phi $ DesktopNamesUpdate names
         sendMessage phi Repaint
       when (atom == atom_NET_CLIENT_LIST atoms) $ do
         (windows, windowStates) <- get
-        (windows', windowStates') <- liftIO $ getWindowStates conn atoms windowStates
+        (windows', windowStates') <- liftIO $ getWindowStates x11 windowStates
         
         when (windows /= windows') $ do
           sendMessage phi $ WindowListUpdate windows' windowStates'
@@ -479,14 +480,14 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
       when (elem window windows) $ do
         case () of
           _ | (atom == atom_NET_WM_ICON atoms) -> do
-            icons <- liftIO $ getWindowIcons conn atoms window
+            icons <- liftIO $ getWindowIcons x11 window
             let windowStates' = M.update (\state -> Just state {windowIcons = icons}) window windowStates
             sendMessage phi $ WindowListUpdate windows windowStates'
             sendMessage phi Repaint
             put (windows, windowStates')
         
             | otherwise -> do
-            (name, desktop, visible) <- liftIO $ getWindowInfo conn atoms window
+            (name, desktop, visible) <- liftIO $ getWindowInfo x11 window
             let mwindowState = M.lookup window windowStates
             case mwindowState of
               Just windowState -> do
@@ -501,12 +502,13 @@ handlePropertyNotifyEvent phi dispvar MkPropertyNotifyEvent {atom_PropertyNotify
                 return ()
 
 
-handleConfigureNotifyEvent :: Phi -> Display -> ConfigureNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
-handleConfigureNotifyEvent phi dispvar MkConfigureNotifyEvent {window_ConfigureNotifyEvent = window} = do
+handleConfigureNotifyEvent :: Phi -> X11 -> ConfigureNotifyEvent -> StateT ([WINDOW], M.Map WINDOW WindowState) IO ()
+handleConfigureNotifyEvent phi x11 MkConfigureNotifyEvent {window_ConfigureNotifyEvent = window} = do
+  let conn = x11Connection x11
   (windows, windowStates) <- get
-  when (elem window windows) $ withDisplay dispvar $ \conn -> do
+  when (elem window windows) $  do
     let geom = fmap windowGeometry . M.lookup window $ windowStates
-    geom' <- liftIO $ getWindowGeometry conn window
+    geom' <- liftIO $ getWindowGeometry x11 window
     when (geom /= (Just geom')) $ do
       let windowStates' = M.update (\state -> Just state {windowGeometry = geom'}) window windowStates
       sendMessage phi $ WindowListUpdate windows windowStates'
@@ -514,30 +516,30 @@ handleConfigureNotifyEvent phi dispvar MkConfigureNotifyEvent {window_ConfigureN
       put (windows, windowStates')
 
 
-getDesktopCount :: Connection -> Atoms -> IO Int
-getDesktopCount conn atoms =
-  liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_NUMBER_OF_DESKTOPS atoms)
+getDesktopCount :: X11 -> IO Int
+getDesktopCount x11 =
+  liftM (fromIntegral . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_NUMBER_OF_DESKTOPS . x11Atoms $ x11)
 
-getCurrentDesktop :: Connection -> Atoms -> IO Int
-getCurrentDesktop conn atoms =
-  liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_CURRENT_DESKTOP atoms)
+getCurrentDesktop :: X11 -> IO Int
+getCurrentDesktop x11 =
+  liftM (fromIntegral . fromMaybe (-1) . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_CURRENT_DESKTOP . x11Atoms $ x11)
 
-getDesktopNames :: Connection -> Atoms -> IO [String]
-getDesktopNames conn atoms =
-  liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ getProperty8 conn (getRoot conn) (atom_NET_DESKTOP_NAMES atoms)
+getDesktopNames :: X11 -> IO [String]
+getDesktopNames x11 =
+  liftM (map (decode . map fromIntegral) . break' . fromMaybe []) $ getProperty8 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_DESKTOP_NAMES . x11Atoms $ x11)
   where
     break' l = case dropWhile (== 0) l of
       [] -> []
       l' -> w : break' l''
         where (w, l'') = break (== 0) l'
 
-getActiveWindow :: Connection -> Atoms -> IO WINDOW
-getActiveWindow conn atoms =
-  liftM (fromXid . toXid . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 conn (getRoot conn) (atom_NET_ACTIVE_WINDOW atoms)
+getActiveWindow :: X11 -> IO WINDOW
+getActiveWindow x11 =
+  liftM (fromXid . toXid . fromMaybe 0 . join . fmap listToMaybe) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_ACTIVE_WINDOW . x11Atoms $ x11)
 
-getWindowStates :: Connection -> Atoms -> M.Map WINDOW WindowState -> IO ([WINDOW], M.Map WINDOW WindowState)
-getWindowStates conn atoms windowStates = do
-  windows <- getWindowList conn atoms
+getWindowStates :: X11 -> M.Map WINDOW WindowState -> IO ([WINDOW], M.Map WINDOW WindowState)
+getWindowStates x11 windowStates = do
+  windows <- getWindowList x11
   
   let windowStates' = map (\w -> (w, M.lookup w windowStates)) windows
   
@@ -547,15 +549,15 @@ getWindowStates conn atoms windowStates = do
     where
       getWindowState' (window, Just windowState) = return (window, windowState) 
       getWindowState' (window, Nothing) = do
-        changeWindowAttributes conn window $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
-        windowState <- getWindowState conn atoms window
+        changeWindowAttributes (x11Connection x11) window $ toValueParam [(CWEventMask, toMask [EventMaskPropertyChange, EventMaskStructureNotify])]
+        windowState <- getWindowState x11 window
         return (window, windowState)
 
-getWindowState :: Connection -> Atoms -> WINDOW -> IO WindowState
-getWindowState conn atoms window = do
-  (name, workspace, visible) <- getWindowInfo conn atoms window
-  icons <- getWindowIcons conn atoms window
-  geom <- getWindowGeometry conn window
+getWindowState :: X11 -> WINDOW -> IO WindowState
+getWindowState x11 window = do
+  (name, workspace, visible) <- getWindowInfo x11 window
+  icons <- getWindowIcons x11 window
+  geom <- getWindowGeometry x11 window
   
   return $ WindowState { windowTitle = name 
                        , windowDesktop = workspace 
@@ -564,8 +566,10 @@ getWindowState conn atoms window = do
                        , windowGeometry = geom
                        }
 
-getWindowInfo :: Connection -> Atoms -> WINDOW -> IO (String, Int, Bool)
-getWindowInfo conn atoms window = do
+getWindowInfo :: X11 -> WINDOW -> IO (String, Int, Bool)
+getWindowInfo x11 window = do
+  let conn = x11Connection x11
+      atoms = x11Atoms x11
   netwmname <- liftM (fmap (decode . map fromIntegral)) $ getProperty8 conn window (atom_NET_WM_NAME atoms)
   wmname <- case netwmname of
     Just name -> return name
@@ -578,8 +582,8 @@ getWindowInfo conn atoms window = do
     where
       unsignedChr = chr . fromIntegral
 
-getWindowIcons :: Connection -> Atoms -> WINDOW -> IO [Icon]
-getWindowIcons conn atoms window = getProperty32 conn window (atom_NET_WM_ICON atoms) >>= readIcons . fromMaybe []
+getWindowIcons :: X11 -> WINDOW -> IO [Icon]
+getWindowIcons x11 window = getProperty32 (x11Connection x11) window (atom_NET_WM_ICON . x11Atoms $ x11) >>= readIcons . fromMaybe []
 
 
 readIcons :: [Word32] -> IO [Icon]
@@ -612,9 +616,13 @@ premultiply c = a .|. r .|. g .|. b
     b = pm bmask
 
 
-getWindowGeometry :: Connection -> WINDOW -> IO RECTANGLE
-getWindowGeometry conn window =
-  getGeometry conn (fromXid . toXid $ window) >>= getReply >>= return . ((const $ MkRECTANGLE 0 0 0 0) ||| (\(MkGetGeometryReply _ _ x y width height _) -> MkRECTANGLE x y width height))
+getWindowGeometry :: X11 -> WINDOW -> IO Rectangle
+getWindowGeometry x11 window =
+  getGeometry (x11Connection x11) (fromXid . toXid $ window) >>= getReply >>=
+  return . ((const $ Rectangle 0 0 0 0) ||| (\(MkGetGeometryReply _ _ x y width height _) -> Rectangle (fi x) (fi y) (fi width) (fi height)))
+    where
+      fi :: (Integral a, Num b) => a -> b
+      fi = fromIntegral
 
 showWindow :: Connection -> Atoms -> WINDOW -> IO Bool
 showWindow conn atoms window = do
@@ -634,8 +642,8 @@ showWindow conn atoms window = do
                     ]
 
 
-getWindowList :: Connection -> Atoms -> IO [WINDOW]
-getWindowList conn atoms = liftM (map (fromXid . toXid) . join . maybeToList) $ getProperty32 conn (getRoot conn) (atom_NET_CLIENT_LIST atoms)
+getWindowList :: X11 -> IO [WINDOW]
+getWindowList x11 = liftM (map (fromXid . toXid) . join . maybeToList) $ getProperty32 (x11Connection x11) (root_SCREEN . x11Screen $ x11) (atom_NET_CLIENT_LIST . x11Atoms $ x11)
 
 taskbar :: TaskbarConfig -> Taskbar
 taskbar = Taskbar