Get rid of existential Widget type and Widget lists

lib/Phi/Border.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, ExistentialQuantification, FlexibleInstances #-}
 
 module Phi.Border ( BorderWidth(..)
                   , simpleBorderWidth
@@ -8,6 +8,7 @@ module Phi.Border ( BorderWidth(..)
                   , defaultBorderConfig
                   , drawBorder
                   , roundRectangle
+                  , Border
                   , border
                   ) where
 
@@ -34,8 +35,6 @@ borderH bw = borderLeft bw + borderRight bw
 borderV :: BorderWidth -> Int
 borderV bw = borderTop bw + borderBottom bw
 
-data BorderState = BorderState ![WidgetState] deriving Eq
-
 data BorderConfig = BorderConfig { margin          :: !BorderWidth
                                  , borderWidth     :: !Int
                                  , padding         :: !BorderWidth
@@ -54,17 +53,19 @@ defaultBorderConfig = BorderConfig { margin = simpleBorderWidth 0
                                    , borderWeight = 1
                                    }
 
-data Border = Border !BorderConfig ![Widget] deriving (Show, Eq)
+data Border w d = (Widget w d) => Border !BorderConfig !w
+deriving instance Show (Border w d)
+deriving instance Eq (Border w d)
 
-instance WidgetClass Border BorderState where
+instance Eq d => Widget (Border w d) d where
-  initWidget (Border _ widgets) phi disp = liftM BorderState $ mapM (createWidgetState phi disp) widgets
+  initWidget (Border _ w) = initWidget w
   
-  minSize (Border config _) (BorderState widgetStates) height screen =
+  minSize (Border config w) d height screen =
     case True of
       _ | childSize == 0 -> 0
         | otherwise -> max (borderH m+2*(bw+cr)) (childSize + borderH p + 2*bw + borderH m)
     where
-      childSize = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height' screen) widgetStates
+      childSize = minSize w d height' screen
       
       m = margin config
       bw = borderWidth config
@@ -74,30 +75,34 @@ instance WidgetClass Border BorderState where
   
   weight (Border config _) = borderWeight config
   
-  layout (Border config _) (BorderState widgetStates) width height screen = case True of
+  layout (Border config w) d width height screen = case True of
-    _ | width' > 0 -> BorderState $ layoutWidgets widgetStates x y width' height' screen
+    _ | width' > 0 -> layout w d width' height' screen
-      | otherwise -> BorderState widgetStates
+      | otherwise -> d
     where
       m = margin config
       bw = borderWidth config
       p = padding config
 
-      x = borderLeft m + bw + borderLeft p
-      y = borderTop m + bw + borderTop p
       width' = width - borderH m - 2*bw - borderH p
       height' = height - borderV m - 2*bw - borderV p
 
-  render (Border config _) (BorderState widgetStates) x y w h screen = when (w > borderH m - 2*bw - borderH p) $ do
+  render (Border config w) d x y width height screen = when (width > borderH m - 2*bw - borderH p) $ do
-    drawBorder config 0 0 w h
+    drawBorder config 0 0 width height
     clip
-    renderWidgets widgetStates screen x y
+    translate (fromIntegral dx) (fromIntegral dy)
+    render w d (x+dx) (y+dy) width' height' screen
     return ()
     where
       m = margin config
       bw = borderWidth config
       p = padding config
       
-  handleMessage _ (BorderState widgetStates) m = BorderState $ handleMessageWidgets m widgetStates
+      dx = borderLeft m + bw + borderLeft p
+      dy = borderTop m + bw + borderTop p
+      width' = width - borderH m - 2*bw - borderH p
+      height' = height - borderV m - 2*bw - borderV p
+  
+  handleMessage (Border _ w) = handleMessage w
 
 drawBorder :: BorderConfig -> Int -> Int -> Int -> Int -> Render ()
 drawBorder config dx dy w h = do
@@ -134,5 +139,5 @@ roundRectangle x y width height radius = do
   arc (x + radius) (y + radius) radius  pi (pi*3/2)
   closePath
 
-border :: BorderConfig -> [Widget] -> Widget
+border :: (Widget w d) => BorderConfig -> w -> Border w d
-border config = Widget . Border config
+border = Border

lib/Phi/Widget.hs

@@ -7,13 +7,10 @@ module Phi.Widget ( Display(..)
                   , getScreens
                   , unionArea
                   , Widget(..)
-                  , WidgetClass(..)
+                  , CompoundWidget
-                  , WidgetState(..)
+                  , (<~>)
+                  , Separator
                   , separator
-                  , createWidgetState
-                  , layoutWidgets
-                  , renderWidgets
-                  , handleMessageWidgets
                   ) where
 
 import Control.Arrow
@@ -67,7 +64,7 @@ unionArea a b = fromIntegral $ uw*uh
     by2 = by1 + fromIntegral bh
 
 
-class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where
+class (Show a, Eq a, Eq d) => Widget a d | a -> d where
   initWidget :: a -> Phi -> Display -> IO d
   
   minSize :: a -> d -> Int -> Xlib.Rectangle -> Int
@@ -83,26 +80,7 @@ class (Show a, Eq a, Eq d) => WidgetClass a d | a -> d where
   handleMessage :: a -> d -> Message -> d
   handleMessage _ priv _ = priv
 
-data Widget = forall a d. WidgetClass a d => Widget !a
+{-createStateRender :: Widget a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface
-deriving instance Show Widget
-
-instance Eq Widget where
-  _ == _ = False
-
-data WidgetState = forall a d. WidgetClass a d =>
-                   WidgetState { stateWidget      :: !a
-                               , stateX           :: !Int
-                               , stateY           :: !Int
-                               , stateWidth       :: !Int
-                               , stateHeight      :: !Int
-                               , statePrivateData :: !d
-                               , stateRender      :: !(CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface)
-                               }
-
-instance Eq WidgetState where
-  _ == _ = False
-
-createStateRender :: WidgetClass a d => CacheArrow (Kleisli IO) (a, d, Int, Int, Int, Int, Xlib.Rectangle) Surface
 createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
   surface <- createImageSurface FormatARGB32 w h
   renderWith surface $ do
@@ -110,66 +88,59 @@ createStateRender = lift . Kleisli $ \(widget, state, x, y, w, h, screen) -> do
     paint
     setOperator OperatorOver
     render widget state x y w h screen
-  return surface
+  return surface-}
 
-createWidgetState :: Phi -> Display -> Widget -> IO WidgetState
+data CompoundWidget a da b db = (Widget a da, Widget b db) => CompoundWidget !a !b
-createWidgetState phi disp (Widget w) = do
+deriving instance Eq (CompoundWidget a da b db)
-  priv <- initWidget w phi disp
+deriving instance Show (CompoundWidget a da b db)
-  return WidgetState { stateWidget = w
-                     , stateX = 0
-                     , stateY = 0
-                     , stateWidth = 0
-                     , stateHeight = 0
-                     , statePrivateData = priv
-                     , stateRender = createStateRender
-                     }
 
-layoutWidgets :: [WidgetState] -> Int -> Int -> Int -> Int -> Xlib.Rectangle -> [WidgetState]
+data CompoundState a da b db = (Widget a da, Widget b db) => CompoundState !da !db !Int
-layoutWidgets widgets x y width height screen = snd $ mapAccumL layoutWidgetAndX x widgets
+deriving instance Eq (CompoundState a da b db)
+
+instance Widget (CompoundWidget a da b db) (CompoundState a da b db) where
+  initWidget (CompoundWidget a b) phi disp = liftM3 CompoundState (initWidget a phi disp) (initWidget b phi disp) (return 0)
+  
+  minSize (CompoundWidget a b) (CompoundState da db _) height screen = minSize a da height screen + minSize b db height screen
+  
+  weight (CompoundWidget a b) = weight' a + weight' b
+
+  layout c@(CompoundWidget a b) d@(CompoundState da db _) width height screen = CompoundState da' db' xb
     where
-    sizesum = sum $ map (\(WidgetState {stateWidget = w, statePrivateData = priv} ) -> nneg $ minSize w priv height screen) widgets
+      sizesum = minSize c d height screen
-    wsum = let wsum = sum $ map (\(WidgetState {stateWidget = w} ) ->  nneg . weight $ w) widgets
+      wsum = let wsum = weight c
              in if wsum > 0 then wsum else 1
     
       surplus = width - sizesum
       
-    layoutWidgetAndX wX state = let lw = layoutWidget wX state
+      (xb, da') = layoutWidget a da
-                                    in (wX + stateWidth lw, lw)
+      (_, db') = layoutWidget b db
       
-    layoutWidget wX state = case state of
+      layoutWidget w priv = let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(weight' w)/wsum
-      WidgetState {stateWidget = w, statePrivateData = priv, stateRender = render} ->
+                            in (wWidth, layout w priv wWidth height screen)
-        let wWidth = floor $ (fromIntegral $ minSize w priv height screen) + (fromIntegral surplus)*(nneg $ weight w)/wsum
-            priv' = layout w priv wWidth height screen
-        in WidgetState w wX y wWidth height priv' render
-    
-    nneg :: (Num a, Ord a) => a -> a
-    nneg x = max 0 x
-
-renderWidgets :: [WidgetState] -> Xlib.Rectangle -> Int -> Int -> Render [WidgetState]
-renderWidgets widgets screen winX winY = forM widgets $ \(WidgetState widget x y w h priv render) -> do
-  (surface, render') <- liftIO $ runKleisli (runCache render) (widget, priv, winX+x, winY+y, w, h, screen)
   
+  render (CompoundWidget a b) (CompoundState da db xb) x y w h screen = do
     save
-  translate (fromIntegral x) (fromIntegral y)
+    render a da x y xb h screen
-  withPatternForSurface surface setSource
-  paint
     restore
+    translate (fromIntegral xb) 0
+    render b db (x+xb) y (w-xb) h screen
     
-  return $ WidgetState widget x y w h priv render'
+  handleMessage (CompoundWidget a b) (CompoundState da db xb) message = CompoundState (handleMessage a da message) (handleMessage b db message) xb
 
-handleMessageWidgets :: Message -> [WidgetState] -> [WidgetState]
+weight' :: (Widget a da) => a -> Float
-handleMessageWidgets message = map handleMessageWidget
+weight' = max 0 . weight
-  where
-    handleMessageWidget (WidgetState w x y width height priv render) = WidgetState w x y width height (handleMessage w priv message) render
 
-data Separator = Separator Int Float deriving (Show, Eq)
+(<~>) :: (Widget a da, Widget b db) => a -> b -> CompoundWidget a da b db
+a <~> b = CompoundWidget a b
 
-instance WidgetClass Separator () where
+data Separator = Separator !Int !Float deriving (Show, Eq)
+
+instance Widget Separator () where
   initWidget _ _ _ = return ()
   
   minSize (Separator s _) _ _ _ = s
   weight (Separator _ w) = w
   render _ _ _ _ _ _ _ = return ()
 
-separator :: Int -> Float -> Widget
+separator :: Int -> Float -> Separator
-separator s w = Widget $ Separator s w
+separator = Separator

lib/Phi/Widgets/AlphaBox.hs

@@ -1,6 +1,7 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, ExistentialQuantification, FlexibleInstances #-}
 
-module Phi.Widgets.AlphaBox ( alphaBox
+module Phi.Widgets.AlphaBox ( AlphaBox
+                            , alphaBox
                             ) where
 
 import Phi.Types
@@ -11,25 +12,23 @@ import Control.Monad
 import Graphics.Rendering.Cairo
 
 
-data AlphaBoxState = AlphaBoxState ![WidgetState] deriving Eq
+data AlphaBox w d = (Widget w d) => AlphaBox !Double !w
+deriving instance Show (AlphaBox w d)
+deriving instance Eq (AlphaBox w d)
 
-data AlphaBox = AlphaBox !Double ![Widget] deriving (Show, Eq)
+instance Eq d => Widget (AlphaBox w d) d where
+  initWidget (AlphaBox _ w) = initWidget w
   
+  minSize (AlphaBox _ w) = minSize w
   
-instance WidgetClass AlphaBox AlphaBoxState where
+  weight (AlphaBox _ w) = weight w
-  initWidget (AlphaBox _ widgets) phi disp = liftM AlphaBoxState $ mapM (createWidgetState phi disp) widgets
   
-  minSize (AlphaBox _ _) (AlphaBoxState widgetStates) height screen =
+  layout (AlphaBox _ w) = layout w
-    sum (map (\(WidgetState {stateWidget = w, statePrivateData = priv}) -> minSize w priv height screen) widgetStates)
 
-  weight (AlphaBox _ widgets) = sum (map (\(Widget w) -> weight w) widgets)
+  render (AlphaBox alpha w) d x y width height screen = do
-  
+    renderWithSimilarSurface ContentColorAlpha width height $ \surface -> do
-  layout (AlphaBox _ _) (AlphaBoxState widgetStates) width height screen = AlphaBoxState $ layoutWidgets widgetStates 0 0 width height screen
-
-  render (AlphaBox alpha _) (AlphaBoxState widgetStates) x y w h screen = do
-    renderWithSimilarSurface ContentColorAlpha w h $ \surface -> do
       renderWith surface $ do
-        renderWidgets widgetStates screen x y
+        render w d x y width height screen
         
         setOperator OperatorDestIn
         setSourceRGBA 0 0 0 alpha
@@ -38,11 +37,9 @@ instance WidgetClass AlphaBox AlphaBoxState where
       withPatternForSurface surface setSource
       paint
   
+  handleMessage (AlphaBox _ w) = handleMessage w
 
 
-  handleMessage _ (AlphaBoxState widgetStates) m = AlphaBoxState $ handleMessageWidgets m widgetStates
+alphaBox :: (Widget w d) => Double -> w -> AlphaBox w d
-
+alphaBox = AlphaBox
-
-alphaBox :: Double -> [Widget] -> Widget
-alphaBox alpha = Widget . AlphaBox alpha
 

lib/Phi/Widgets/Clock.hs

@@ -43,7 +43,7 @@ data ClockState = ClockState !ZonedTime deriving (Show, Eq)
 
 data ClockMessage = UpdateTime !ZonedTime deriving (Show, Typeable)
 
-instance WidgetClass Clock ClockState where
+instance Widget Clock ClockState where
   initWidget (Clock _) phi _ = do
     forkIO $ forever $ do
       time <- getZonedTime
@@ -85,6 +85,6 @@ instance WidgetClass Clock ClockState where
     _ -> priv
 
 
-clock :: ClockConfig -> Widget
+clock :: ClockConfig -> Clock
 clock config = do
-  Widget $ Clock config
+  Clock config

lib/Phi/Widgets/Systray.hs

@@ -35,19 +35,9 @@ import Phi.Widget
 import Phi.X11.Atoms
 
 
-instance Show Display where
-  show _ = "Display <?>"
-
-instance Show Phi where
-  show _ = "Phi <?>"
-
-instance Show (IORef a) where
-  show _ = "IORef <?>"
-
-
 data SystrayIconState = SystrayIconState !Window !Window deriving Show
 
-data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState] deriving Show
+data SystrayState = SystrayState !Phi !Rectangle !Int !(IORef Int) ![SystrayIconState]
 instance Eq SystrayState where
   _ == _ = False
 
@@ -57,7 +47,7 @@ data SystrayMessage = AddIcon !Window !Window | RemoveIcon !Window | RenderIcon
                       deriving (Show, Typeable)
 
 
-instance WidgetClass Systray SystrayState where
+instance Widget Systray SystrayState where
   initWidget (Systray) phi dispvar = do
     phi' <- dupPhi phi
     forkIO $ systrayRunner phi' dispvar
@@ -298,5 +288,5 @@ removeIcon phi disp reparent window = do
       return ()
 
 
-systray :: Widget
+systray :: Systray
-systray = Widget $ Systray
+systray = Systray

lib/Phi/Widgets/Taskbar.hs

@@ -7,6 +7,7 @@ module Phi.Widgets.Taskbar ( IconStyle
                            , DesktopStyle(..)
                            , TaskbarConfig(..)
                            , defaultTaskbarConfig
+                           , Taskbar
                            , taskbar
                            ) where
 
@@ -165,7 +166,7 @@ data TaskbarMessage = WindowListUpdate ![Xlib.Window] !(M.Map Window WindowState
 instance Show (IORef a) where
   show _ = "IORef <?>"
 
-instance WidgetClass Taskbar TaskbarState where
+instance Widget Taskbar TaskbarState where
   initWidget (Taskbar _) phi dispvar = do
     phi' <- dupPhi phi
     forkIO $ taskbarRunner phi' dispvar
@@ -566,6 +567,5 @@ showWindow disp atoms window = do
 getWindowList :: Xlib.Display -> Atoms -> IO [Window]
 getWindowList disp atoms = liftM (map fromIntegral . join . maybeToList) $ XExtras.getWindowProperty32 disp (atom_NET_CLIENT_LIST atoms) $ Xlib.defaultRootWindow disp
 
-taskbar :: TaskbarConfig -> Widget
+taskbar :: TaskbarConfig -> Taskbar
-taskbar config = do
+taskbar = Taskbar
-  Widget $ Taskbar config

lib/Phi/X11.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, ExistentialQuantification #-}
 
 module Phi.X11 ( XConfig(..)
                , defaultXConfig
@@ -30,6 +30,7 @@ import Phi.Phi
 import qualified Phi.Types as Phi
 import qualified Phi.Panel as Panel
 import qualified Phi.Widget as Widget
+import Phi.Widget (Widget)
 import Phi.X11.Atoms
 import qualified Phi.Bindings.Util as Util
 
@@ -37,18 +38,19 @@ import qualified Phi.Bindings.Util as Util
 data XConfig = XConfig { phiXScreenInfo :: !(Display -> IO [Rectangle])
                        }
 
-data PhiState = PhiState { phiRootImage    :: !Surface
+data PhiState w d = (Widget.Widget w d) => PhiState { phiRootImage    :: !Surface
-                         , phiPanels       :: ![PanelState]
+                                                         , phiPanels       :: ![PanelState w d]
                                                          , phiRepaint      :: !Bool
                                                          , phiShutdown     :: !Bool
                                                          , phiShutdownHold :: !Int
                              }
 
-data PanelState = PanelState { panelWindow       :: !Window
+data PanelState w d = (Widget.Widget w d) => PanelState { panelWindow       :: !Window
                                                              , panelPixmap       :: !Pixmap
                                                              , panelArea         :: !Rectangle
                                                              , panelScreenArea   :: !Rectangle
-                             , panelWidgetStates :: ![Widget.WidgetState]
+                                                             , panelWidget       :: !w
+                                                             , panelWidgetState  :: !d
                                                              }
 
 data PhiConfig = PhiConfig { phiPhi         :: !Phi
@@ -63,18 +65,18 @@ newtype PhiReader a = PhiReader (ReaderT PhiConfig IO a)
 runPhiReader :: PhiConfig -> PhiReader a -> IO a
 runPhiReader config (PhiReader a) = runReaderT a config
 
-newtype PhiX a = PhiX (StateT PhiState PhiReader a)
+newtype PhiX w d a = PhiX (StateT (PhiState w d) PhiReader a)
-               deriving (Monad, MonadState PhiState, MonadReader PhiConfig, MonadIO)
+                   deriving (Monad, MonadState (PhiState w d), MonadReader PhiConfig, MonadIO)
 
-runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState)
+runPhiX :: PhiConfig -> PhiState w d -> PhiX w d a -> IO (a, PhiState w d)
 runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
 
 defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
                          }
 
 
-runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
+runPhi :: (Widget.Widget w d) => XConfig -> Panel.PanelConfig -> w -> IO ()
-runPhi xconfig config widgets = do
+runPhi xconfig config widget = do
   xSetErrorHandler
   
   phi <- initPhi
@@ -108,10 +110,10 @@ runPhi xconfig config widgets = do
     dispmvar <- liftIO $ newMVar disp
     let screenPanels = zip screens panelWindows
         dispvar = Widget.Display dispmvar atoms screenPanels
-    widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets
+    widgetState <- liftIO $ Widget.initWidget widget phi dispvar
     
     Widget.withDisplay dispvar $ \disp -> do
-      panels <- mapM (\(screen, window) -> createPanel disp window widgetStates screen) screenPanels
+      panels <- mapM (\(screen, window) -> createPanel disp window widget widgetState screen) screenPanels
       
       forM_ panels $ \panel -> do
         setPanelProperties disp panel
@@ -155,12 +157,12 @@ termHandler :: Phi -> Handler
 termHandler phi = Catch $ sendMessage phi Shutdown
 
 
-handlePanel :: Message -> PanelState -> PanelState
+handlePanel :: Message -> PanelState w d -> PanelState w d
-handlePanel message panel@PanelState {panelWidgetStates = widgets} = panel {panelWidgetStates = widgets'}
+handlePanel message panel@PanelState {panelWidget = widget, panelWidgetState = state} = panel {panelWidgetState = state'}
   where
-    widgets' = Widget.handleMessageWidgets message widgets
+    state' = Widget.handleMessage widget state message
 
-handleMessage :: Widget.Display -> Message -> PhiX ()
+handleMessage :: Widget.Display -> Message -> PhiX w d ()
 handleMessage dispvar m = do
   modify $ \state@PhiState {phiPanels = panels} -> state {phiPanels = map (handlePanel m) panels}
   
@@ -192,7 +194,7 @@ receiveEvents phi dispvar = do
       
     when (not handled) $ threadWaitRead connection
 
-updatePanels :: Widget.Display -> PhiX ()
+updatePanels :: (Widget w d) => Widget.Display -> PhiX w d ()
 updatePanels dispvar = do
   rootImage <- gets phiRootImage
   panels <- gets phiPanels
@@ -201,8 +203,8 @@ updatePanels dispvar = do
     let pixmap = panelPixmap panel
         area = panelArea panel
     
-    let layoutedWidgets = (withDimension area $ Widget.layoutWidgets (panelWidgetStates panel) 0 0) $ panelScreenArea panel
+    let layoutedWidget = (withDimension area $ Widget.layout (panelWidget panel) (panelWidgetState panel)) $ panelScreenArea panel
-        panel' = panel { panelWidgetStates = layoutedWidgets }
+        panel' = panel { panelWidgetState = layoutedWidget }
     
     Widget.withDisplay dispvar $ \disp -> do
       let screen = defaultScreen disp
@@ -218,13 +220,12 @@ updatePanels dispvar = do
             setSource pattern
             paint
             restore
-          Widget.renderWidgets layoutedWidgets (panelScreenArea panel) 0 0
+          (withDimension area $ Widget.render (panelWidget panel) layoutedWidget 0 0) (panelScreenArea panel)
         renderWith xbuffer $ do
           withPatternForSurface buffer $ \pattern -> do
             setSource pattern
             paint
       
-      surfaceFlush xbuffer
       surfaceFinish xbuffer
       
       -- copy buffer to window
@@ -237,7 +238,7 @@ updatePanels dispvar = do
   modify $ \state -> state { phiPanels = panels' }
 
 
-handlePropertyUpdate :: Display -> Event -> PhiX ()
+handlePropertyUpdate :: Display -> Event -> PhiX w d ()
 handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
   phi <- asks phiPhi
   atoms <- asks phiAtoms
@@ -249,7 +250,7 @@ handlePropertyUpdate disp PropertyEvent { ev_atom = atom } = do
     sendMessage phi Repaint
   
 
-updateRootImage :: Display -> PhiX ()
+updateRootImage :: Display -> PhiX w d ()
 updateRootImage disp = do
   atoms <- asks phiAtoms
   
@@ -287,8 +288,8 @@ updateRootImage disp = do
       surfaceFinish rootSurface
 
 
-createPanel :: Display -> Window -> [Widget.WidgetState] -> Rectangle -> PhiX PanelState
+createPanel :: (Widget w d) => Display -> Window -> w -> d -> Rectangle -> PhiX w d (PanelState w d)
-createPanel disp win widgets screenRect = do
+createPanel disp win w d screenRect = do
   config <- asks phiPanelConfig
   let rect = panelBounds config screenRect
   let screen = defaultScreen disp
@@ -301,10 +302,11 @@ createPanel disp win widgets screenRect = do
                     , panelPixmap = pixmap
                     , panelArea = rect
                     , panelScreenArea = screenRect
-                    , panelWidgetStates = widgets
+                    , panelWidget = w
+                    , panelWidgetState = d
                     }
 
-createPanelWindow :: Display -> Rectangle -> PhiX Window
+createPanelWindow :: Display -> Rectangle -> PhiX w d Window
 createPanelWindow disp screenRect = do
   config <- asks phiPanelConfig
   let rect = panelBounds config screenRect
@@ -323,7 +325,7 @@ createPanelWindow disp screenRect = do
     withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr
 
 
-setPanelProperties :: Display -> PanelState -> PhiX ()
+setPanelProperties :: Display -> PanelState w d -> PhiX w d ()
 setPanelProperties disp panel = do
   atoms <- asks phiAtoms
   liftIO $ do
@@ -354,7 +356,7 @@ setPanelProperties disp panel = do
   setStruts disp panel
 
 
-setStruts :: Display -> PanelState -> PhiX ()
+setStruts :: Display -> PanelState w d -> PhiX w d ()
 setStruts disp panel = do
   atoms <- asks phiAtoms
   config <- asks phiPanelConfig

src/Phi.hs

@@ -12,8 +12,7 @@ import Phi.Widgets.Systray
 
 main :: IO ()
 main = do
-  runPhi defaultXConfig defaultPanelConfig { panelPosition = Top }
+  runPhi defaultXConfig defaultPanelConfig { panelPosition = Top } $ alphaBox 0.9 $ theTaskbar <~> brightBorder theSystray <~> brightBorder theClock
-    [alphaBox 0.9 [theTaskbar, brightBorder [theSystray], brightBorder [theClock]]]
     where
       normalTaskBorder = BorderConfig (BorderWidth (-1) (-3) (-1) 7) 1 (BorderWidth 0 5 0 5) (0.9, 0.9, 0.9, 0.8) (0.45, 0.45, 0.45, 0.8) 5 0
       activeTaskBorder = normalTaskBorder { borderColor = (1, 1, 1, 0.8)
@@ -53,4 +52,5 @@ main = do
                                           , lineSpacing = (-3)
                                           , clockSize = 75
                                           }
+      brightBorder :: (Widget w d) => w -> Border w d
       brightBorder = border normalDesktopBorder