qualified imports

1 files changed, 105 insertions, 106 deletions

diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index aeaf38a..3c1a25c 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -19,159 +19,158 @@
 module Xmobar.X11.Loop (x11Loop) where
 
 import Prelude hiding (lookup)
-import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment, Button)
-import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xinerama
-import Graphics.X11.Xrandr
 
-import Control.Monad.Reader
-import Control.Concurrent
-import Control.Concurrent.STM
+import Control.Concurrent as Concurrent
+import Control.Concurrent.STM as STM
+import Control.Monad.Reader as MR
 
-import Data.Bits
+import Data.Bits (Bits((.|.)))
 import qualified Data.Map as Map
-import Data.List.NonEmpty (NonEmpty(..))
+import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NE
 
-import Xmobar.System.Signal
-import Xmobar.Config.Types ( persistent
-                           , alpha
-                           , font
-                           , additionalFonts
-                           , position
-                           , iconRoot
-                           , Config
-                           , XPosition(..))
-
-import Xmobar.Run.Actions
-import Xmobar.Run.Parsers
-import Xmobar.X11.Window
-import Xmobar.X11.Text
-import Xmobar.X11.Draw
-import Xmobar.X11.Bitmap as Bitmap
-import Xmobar.X11.Types
-import Xmobar.System.Utils (forkThread)
-
-import Xmobar.Run.Loop (loop)
+import qualified Graphics.X11.Xlib as X11
+import qualified Graphics.X11.Xlib.Extras as X11x
+import qualified Graphics.X11.Xinerama as Xinerama
+import qualified Graphics.X11.Xrandr as Xrandr
+
+import qualified Xmobar.Config.Types as C
+
+import qualified Xmobar.Run.Actions as A
+import qualified Xmobar.Run.Loop as L
+import qualified Xmobar.Run.Parsers as P
+
+import qualified Xmobar.System.Utils as U
+import qualified Xmobar.System.Signal as S
+
+import qualified Xmobar.X11.Types as T
+import qualified Xmobar.X11.Text as Text
+import qualified Xmobar.X11.Draw as Draw
+import qualified Xmobar.X11.Bitmap as Bitmap
+import qualified Xmobar.X11.Window as W
 
 #ifndef THREADED_RUNTIME
-import Xmobar.X11.Events(nextEvent')
+import qualified Xmobar.X11.Events as E
 #endif
 
-runX :: XConf -> X a -> IO a
-runX xc f = runReaderT f xc
+runX :: T.XConf -> T.X a -> IO a
+runX xc f = MR.runReaderT f xc
 
--- | Starts the main event loop and threads
-x11Loop :: Config -> IO ()
+-- | Starts the main event loop thread
+x11Loop :: C.Config -> IO ()
 x11Loop conf = do
-  initThreads
-  d <- openDisplay ""
-  fs <- initFont d (font conf)
-  fl <- mapM (initFont d) (additionalFonts conf)
-  (r,w) <- createWin d fs conf
-  loop conf (startLoop (XConf d r w (fs :| fl) Map.empty conf))
-
-startLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO ()
-startLoop xcfg@(XConf _ _ w _ _ _) sig tv = do
-    forkThread "X event handler" (x11EventLoop w sig)
-    signalLoop xcfg [] sig tv
+  X11.initThreads
+  d <- X11.openDisplay ""
+  fs <- Text.initFont d (C.font conf)
+  fl <- mapM (Text.initFont d) (C.additionalFonts conf)
+  (r,w) <- W.createWin d fs conf
+  L.loop conf (startLoop (T.XConf d r w (fs :| fl) Map.empty conf))
+
+startLoop :: T.XConf -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO ()
+startLoop xcfg sig tv = do
+  U.forkThread "X event handler" (eventLoop (T.display xcfg) (T.window xcfg) sig)
+  signalLoop xcfg [] sig tv
 
 -- | Translates X11 events received by w to signals handled by signalLoop
-x11EventLoop :: Window -> TMVar SignalType -> IO ()
-x11EventLoop w signal =
-  allocaXEvent $ \e -> do
-    dpy <- openDisplay ""
-    xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
-    selectInput dpy w (exposureMask .|. structureNotifyMask .|. buttonPressMask)
-
-    forever $ do
+eventLoop :: X11.Display -> X11.Window -> STM.TMVar S.SignalType -> IO ()
+eventLoop dpy w signalv =
+  X11.allocaXEvent $ \e -> do
+    let root = X11.defaultRootWindow dpy
+        m = X11.exposureMask .|. X11.structureNotifyMask .|. X11.buttonPressMask
+    Xrandr.xrrSelectInput dpy root X11.rrScreenChangeNotifyMask
+    X11.selectInput dpy w m
+
+    MR.forever $ do
 #ifdef THREADED_RUNTIME
-      nextEvent dpy e
+      X11.nextEvent dpy e
 #else
-      nextEvent' dpy e
+      E.nextEvent' dpy e
 #endif
-      ev <- getEvent e
+      ev <- X11x.getEvent e
+      let send s = STM.atomically (STM.putTMVar signalv s)
       case ev of
-        ConfigureEvent {} -> atomically $ putTMVar signal Reposition
-        ExposeEvent {} -> atomically $ putTMVar signal Wakeup
-        RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition
-        ButtonEvent {} -> atomically $
-               putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
+        X11x.ConfigureEvent {}            -> send S.Reposition
+        X11x.RRScreenChangeNotifyEvent {} -> send S.Reposition
+        X11x.ExposeEvent {}               -> send S.Wakeup
+        X11x.ButtonEvent {}               -> send (S.Action b p)
+           where (b, p) = (X11x.ev_button ev, fromIntegral $ X11x.ev_x ev)
         _ -> return ()
 
 -- | Continuously wait for a signal from a thread or an interrupt handler.
 -- The list of actions provides the positions of clickable rectangles,
 -- and there is a mutable variable for received signals and the list
 -- of strings updated by running monitors.
-signalLoop :: XConf
-          -> [([Action], Position, Position)]
-          -> TMVar SignalType
-          -> TVar [String]
+signalLoop :: T.XConf
+          -> [([A.Action], X11.Position, X11.Position)]
+          -> STM.TMVar S.SignalType
+          -> STM.TVar [String]
           -> IO ()
-signalLoop xc@(XConf d r w fs is cfg) actions signal strs = do
-    typ <- atomically $ takeTMVar signal
+signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do
+    typ <- STM.atomically $ STM.takeTMVar signalv
     case typ of
-      Wakeup           -> wakeup
-      Action button x  -> runActions actions button x >> loopOn
-      Reposition       -> reposWindow cfg
-      ChangeScreen     -> updateConfigPosition d cfg >>= reposWindow
-      Hide t           -> hiderev t Hide hideWindow
-      Reveal t         -> hiderev t Reveal (showWindow r cfg)
-      Toggle t         -> toggle t
-      TogglePersistent -> updateCfg $ cfg {persistent = not $ persistent cfg}
-      SetAlpha a       -> updateCfg $ cfg {alpha = a}
+      S.Wakeup           -> wakeup
+      S.Action button x  -> runActions actions button x >> loopOn
+      S.Reposition       -> reposWindow cfg
+      S.ChangeScreen     -> updateConfigPosition d cfg >>= reposWindow
+      S.Hide t           -> hiderev t S.Hide W.hideWindow
+      S.Reveal t         -> hiderev t S.Reveal (W.showWindow r cfg)
+      S.Toggle t         -> toggle t
+      S.TogglePersistent -> updateCfg $ cfg {C.persistent = not $ C.persistent cfg}
+      S.SetAlpha a       -> updateCfg $ cfg {C.alpha = a}
     where
-        loopOn' xc' = signalLoop xc' actions signal strs
+        loopOn' xc' = signalLoop xc' actions signalv strs
         loopOn = loopOn' xc
-        updateCfg cfg' = loopOn' (xc {config = cfg'})
+        updateCfg cfg' = loopOn' (xc {T.config = cfg'})
 
         wakeup =  do
           segs <- parseSegments cfg strs
           xc' <- updateIconCache xc segs
-          actions' <- runX xc' $ drawInWin segs
-          signalLoop xc' actions' signal strs
+          actions' <- runX xc' $ Draw.drawInWin segs
+          signalLoop xc' actions' signalv strs
 
         hiderev t sign op
-            | t == 0 = unless (persistent cfg) (op d w) >> loopOn
+            | t == 0 = MR.unless (C.persistent cfg) (op d w) >> loopOn
             | otherwise = do
-                void $ forkIO
-                     $ threadDelay (t*100*1000) >>
-                       atomically (putTMVar signal $ sign 0)
+                MR.void $ Concurrent.forkIO
+                     $ Concurrent.threadDelay (t*100*1000) >>
+                       STM.atomically (STM.putTMVar signalv $ sign 0)
                 loopOn
 
         toggle t = do
-            ismapped <- isMapped d w
-            atomically (putTMVar signal $ if ismapped then Hide t else Reveal t)
-            loopOn
+          ismapped <- W.isMapped d w
+          let s = if ismapped then S.Hide t else S.Reveal t
+          STM.atomically (STM.putTMVar signalv s)
+          loopOn
 
         reposWindow rcfg = do
-          r' <- repositionWin d w (NE.head fs) rcfg
-          signalLoop (XConf d r' w fs is rcfg) actions signal strs
+          r' <- W.repositionWin d w (NE.head fs) rcfg
+          signalLoop (T.XConf d r' w fs is rcfg) actions signalv strs
 
-parseSegments :: Config -> TVar [String] -> IO [[Segment]]
+parseSegments :: C.Config -> STM.TVar [String] -> IO [[P.Segment]]
 parseSegments conf v = do
-  s <- readTVarIO v
+  s <- STM.readTVarIO v
   let l:c:r:_ = s ++ repeat ""
-  liftIO $ mapM (parseString conf) [l, c, r]
+  MR.liftIO $ mapM (P.parseString conf) [l, c, r]
 
-updateIconCache :: XConf -> [[Segment]] -> IO XConf
-updateIconCache xc@(XConf d _ w _ c cfg) segs = do
-  c' <- updateCache d w c (iconRoot cfg) [p | (Icon p, _, _, _) <- concat segs]
-  return $ xc {iconCache = c'}
+updateIconCache :: T.XConf -> [[P.Segment]] -> IO T.XConf
+updateIconCache xc@(T.XConf d _ w _ c cfg) segs = do
+  let paths = [p | (P.Icon p, _, _, _) <- concat segs]
+  c' <- Bitmap.updateCache d w c (C.iconRoot cfg) paths
+  return $ xc {T.iconCache = c'}
 
-updateConfigPosition :: Display -> Config -> IO Config
+updateConfigPosition :: X11.Display -> C.Config -> IO C.Config
 updateConfigPosition disp cfg =
-  case position cfg of
-    OnScreen n o -> do
-      srs <- getScreenInfo disp
+  case C.position cfg of
+    C.OnScreen n o -> do
+      srs <- Xinerama.getScreenInfo disp
       return (if n == length srs
-              then (cfg {position = OnScreen 1 o})
-              else (cfg {position = OnScreen (n+1) o}))
-    o -> return (cfg {position = OnScreen 1 o})
+              then (cfg {C.position = C.OnScreen 1 o})
+              else (cfg {C.position = C.OnScreen (n+1) o}))
+    o -> return (cfg {C.position = C.OnScreen 1 o})
 
-runActions :: [ActionPos] -> Button -> Position -> IO ()
+runActions :: [T.ActionPos] -> A.Button -> X11.Position -> IO ()
 runActions actions button pos =
-  mapM_ runAction $
-   filter (\(Spawn b _) -> button `elem` b) $
+  mapM_ A.runAction $
+   filter (\(A.Spawn b _) -> button `elem` b) $
    concatMap (\(a,_,_) -> a) $
    filter (\(_, from, to) -> pos >= from && pos <= to) actions