App.EventLoop -> App.X11EventLoop

3 files changed, 45 insertions, 51 deletions

diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs
index 7bcf3bd..6b20158 100644
--- a/src/Xmobar/App/Main.hs
+++ b/src/Xmobar/App/Main.hs
@@ -17,49 +17,25 @@
 
 module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
 
-import qualified Data.Map as Map
+
 import Data.List (intercalate)
 import System.Posix.Process (executeFile)
 import System.Environment (getArgs)
 import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)
 import Text.Parsec.Error (ParseError)
-import Data.List.NonEmpty (NonEmpty(..))
-import Control.Monad (unless)
 
-import Graphics.X11.Xlib
+import Control.Monad (unless)
 
+import Xmobar.App.Config
 import Xmobar.Config.Types
 import Xmobar.Config.Parse
-import Xmobar.System.Signal (withDeferSignals)
-
-import Xmobar.X11.Types
-import Xmobar.X11.Text
-import Xmobar.X11.Window
 import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
-import Xmobar.App.CommandThreads (loop)
-import Xmobar.App.EventLoop (startLoop)
-import Xmobar.App.TextEventLoop (startTextLoop)
+import Xmobar.App.X11EventLoop (x11Loop)
+import Xmobar.App.TextEventLoop (textLoop)
 import Xmobar.App.Compile (recompile, trace)
-import Xmobar.App.Config
-
-xXmobar :: Config -> IO ()
-xXmobar conf = withDeferSignals $ do
-  initThreads
-  d <- openDisplay ""
-  fs <- initFont d (font conf)
-  fl <- mapM (initFont d) (additionalFonts conf)
-  let ic = Map.empty
-      to = textOffset conf
-      ts = textOffsets conf ++ replicate (length fl) (-1)
-  loop conf $ \sig lock vars -> do
-    (r,w) <- createWin d fs conf
-    startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
-
-textXmobar :: Config -> IO ()
-textXmobar conf = loop conf (startTextLoop conf)
 
 xmobar :: Config -> IO ()
-xmobar cfg = if textOutput cfg then textXmobar cfg else xXmobar cfg
+xmobar cfg = if textOutput cfg then textLoop cfg else x11Loop cfg
 
 configFromArgs :: Config -> IO Config
 configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
index 6135554..4980bf1 100644
--- a/src/Xmobar/App/TextEventLoop.hs
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -14,7 +14,7 @@
 --
 ------------------------------------------------------------------------------
 
-module Xmobar.App.TextEventLoop (startTextLoop) where
+module Xmobar.App.TextEventLoop (textLoop) where
 
 import Prelude hiding (lookup)
 
@@ -26,15 +26,18 @@ import Control.Concurrent.STM
 import Xmobar.System.Signal
 import Xmobar.Config.Types (Config)
 import Xmobar.X11.Parsers (Segment, Widget(..), parseString)
-import Xmobar.App.CommandThreads (initLoop)
+import Xmobar.App.CommandThreads (initLoop, loop)
 
 -- | Starts the main event loop and threads
-startTextLoop :: Config
-              -> TMVar SignalType
-              -> TMVar ()
-              -> [[([Async ()], TVar String)]]
-              -> IO ()
-startTextLoop cfg sig pauser vs = do
+textLoop :: Config -> IO ()
+textLoop conf = loop conf (startTextLoop' conf)
+
+startTextLoop' :: Config
+               -> TMVar SignalType
+               -> TMVar ()
+               -> [[([Async ()], TVar String)]]
+               -> IO ()
+startTextLoop' cfg sig pauser vs = do
     tv <- initLoop sig pauser vs
     eventLoop cfg tv sig
 
diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/X11EventLoop.hs
index b1bd3ff..7021b21 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/X11EventLoop.hs
@@ -2,7 +2,7 @@
 
 ------------------------------------------------------------------------------
 -- |
--- Module: Xmobar.App.EventLoop
+-- Module: Xmobar.App.X11EventLoop
 -- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
@@ -16,10 +16,10 @@
 --
 ------------------------------------------------------------------------------
 
-module Xmobar.App.EventLoop (startLoop) where
+module Xmobar.App.X11EventLoop (x11Loop) where
 
 import Prelude hiding (lookup)
-import Graphics.X11.Xlib hiding (textExtents, textWidth)
+import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xinerama
 import Graphics.X11.Xrandr
@@ -32,11 +32,18 @@ import Control.Concurrent.STM
 import Control.Exception (handle, SomeException(..))
 import Data.Bits
 import Data.Map hiding (foldr, map, filter)
+import qualified Data.Map as Map
+import Data.List.NonEmpty (NonEmpty(..))
+
 import Data.Maybe (fromJust, isJust)
 import qualified Data.List.NonEmpty as NE
 
 import Xmobar.System.Signal
-import Xmobar.Config.Types (persistent
+import Xmobar.Config.Types ( persistent
+                           , font
+                           , additionalFonts
+                           , textOffset
+                           , textOffsets
                            , position
                            , iconRoot
                            , Config
@@ -52,7 +59,7 @@ import Xmobar.X11.Bitmap as Bitmap
 import Xmobar.X11.Types
 import Xmobar.System.Utils (safeIndex)
 
-import Xmobar.App.CommandThreads (initLoop)
+import Xmobar.App.CommandThreads (initLoop, loop)
 
 #ifndef THREADED_RUNTIME
 import Xmobar.X11.Events(nextEvent')
@@ -66,6 +73,19 @@ runX :: XConf -> X () -> IO ()
 runX xc f = runReaderT f xc
 
 -- | Starts the main event loop and threads
+x11Loop :: Config -> IO ()
+x11Loop conf = do
+  initThreads
+  d <- openDisplay ""
+  fs <- initFont d (font conf)
+  fl <- mapM (initFont d) (additionalFonts conf)
+  let ic = Map.empty
+      to = textOffset conf
+      ts = textOffsets conf ++ replicate (length fl) (-1)
+  loop conf $ \sig lock vars -> do
+    (r,w) <- createWin d fs conf
+    startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
+
 startLoop :: XConf
           -> TMVar SignalType
           -> TMVar ()
@@ -187,22 +207,17 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
             filter (\(_, from, to) -> x >= from && x <= to) as
           eventLoop tv xc as signal
 
-updateString :: Config
-             -> TVar [String]
-             -> IO [[(Widget, TextRenderInfo, Int, Maybe [Action])]]
+updateString :: Config -> TVar [String] -> IO [[Segment]]
 updateString conf v = do
   s <- readTVarIO v
   let l:c:r:_ = s ++ repeat ""
   liftIO $ mapM (parseString conf) [l, c, r]
 
-updateActions :: XConf
-              -> Rectangle
-              -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]]
+updateActions :: XConf -> Rectangle -> [[Segment]]
               -> IO [([Action], Position, Position)]
 updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
   let (d,fs) = (display &&& fontListS) conf
-      strLn :: [(Widget, TextRenderInfo, Int, Maybe [Action])]
-            -> IO [(Maybe [Action], Position, Position)]
+      strLn :: [Segment] -> IO [(Maybe [Action], Position, Position)]
       strLn  = liftIO . mapM getCoords
       iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf)
       getCoords (Text s,_,i,a) =