Xmobar.App.CommandThreads -> Xmobar.Run.Loop

3 files changed, 2 insertions, 133 deletions

diff --git a/src/Xmobar/App/CommandThreads.hs b/src/Xmobar/App/CommandThreads.hs
deleted file mode 100644
index 28bf926..0000000
--- a/src/Xmobar/App/CommandThreads.hs
+++ /dev/null
@@ -1,131 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-------------------------------------------------------------------------------
--- |
--- Module: Xmobar.App.CommandThreads
--- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
--- License: BSD3-style (see LICENSE)
---
--- Maintainer: jao@gnu.org
--- Stability: unstable
--- Portability: unportable
--- Created: Fri Jan 28, 2022 03:20
---
---
--- Running a thread for each defined Command
---
-------------------------------------------------------------------------------
-
-module Xmobar.App.CommandThreads ( initLoop
-                                 , loop
-                                 , newRefreshLock
-                                 , refreshLock) where
-
-import Control.Concurrent (forkIO)
-import Control.Exception (bracket_, bracket, handle, SomeException(..))
-import Control.Concurrent.STM
-import Control.Concurrent.Async (Async, async, cancel)
-import Control.Monad (guard, void, unless)
-import Data.Maybe (isJust)
-import Data.Foldable (for_)
-
-import Xmobar.System.Signal
-import Xmobar.Config.Types
-import Xmobar.Run.Runnable (Runnable)
-import Xmobar.Run.Exec (start, trigger, alias)
-import Xmobar.Run.Template
-import Xmobar.Run.Timer (withTimer)
-
-#ifdef DBUS
-import Xmobar.System.DBus
-#endif
-
-newRefreshLock :: IO (TMVar ())
-newRefreshLock = newTMVarIO ()
-
-refreshLock :: TMVar () -> IO a -> IO a
-refreshLock var = bracket_ lock unlock
-    where
-        lock = atomically $ takeTMVar var
-        unlock = atomically $ putTMVar var ()
-
-refreshLockT :: TMVar () -> STM a -> STM a
-refreshLockT var action = do
-    takeTMVar var
-    r <- action
-    putTMVar var ()
-    return r
-
-type StartFunction = TMVar SignalType
-                     -> TMVar ()
-                     -> [[([Async ()], TVar String)]]
-                     -> IO ()
-
-loop :: Config -> StartFunction -> IO ()
-loop conf starter = withDeferSignals $ do
-  cls <- mapM (parseTemplate (commands conf) (sepChar conf))
-                (splitTemplate (alignSep conf) (template conf))
-  let confSig = unSignalChan (signal conf)
-  sig <- maybe newEmptyTMVarIO pure confSig
-  unless (isJust confSig) $ setupSignalHandler sig
-  refLock <- newRefreshLock
-  withTimer (refreshLock refLock) $
-    bracket (mapM (mapM $ startCommand sig) cls)
-            cleanupThreads
-            $ \vars -> do
-      starter sig refLock vars
-
-cleanupThreads :: [[([Async ()], a)]] -> IO ()
-cleanupThreads vars =
-  for_ (concat vars) $ \(asyncs, _) ->
-    for_ asyncs cancel
-
--- | Initialises context for an event loop, returning a TVar that
--- will hold the current list of values computed by commands.
-initLoop :: TMVar SignalType -> TMVar () -> [[([Async ()], TVar String)]]
-         -> IO (TVar [String])
-initLoop sig lock vs = do
-  tv <- newTVarIO ([] :: [String])
-  _ <- forkIO (handle (handler "checker") (checker tv [] vs sig lock))
-#ifdef DBUS
-  runIPC sig
-#endif
-  return tv
-  where
-    handler thing (SomeException e) =
-      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
-
--- | Runs a command as an independent thread and returns its Async handles
--- and the TVar the command will be writing to.
-startCommand :: TMVar SignalType
-             -> (Runnable,String,String)
-             -> IO ([Async ()], TVar String)
-startCommand sig (com,s,ss)
-    | alias com == "" = do var <- newTVarIO is
-                           atomically $ writeTVar var (s ++ ss)
-                           return ([], var)
-    | otherwise = do var <- newTVarIO is
-                     let cb str = atomically $ writeTVar var (s ++ str ++ ss)
-                     a1 <- async $ start com cb
-                     a2 <- async $ trigger com $ maybe (return ())
-                                                 (atomically . putTMVar sig)
-                     return ([a1, a2], var)
-    where is = s ++ "Updating..." ++ ss
-
--- | Send signal to eventLoop every time a var is updated
-checker :: TVar [String]
-           -> [String]
-           -> [[([Async ()], TVar String)]]
-           -> TMVar SignalType
-           -> TMVar ()
-           -> IO ()
-checker tvar ov vs sig pauser = do
-      nval <- atomically $ refreshLockT pauser $ do
-              nv <- mapM concatV vs
-              guard (nv /= ov)
-              writeTVar tvar nv
-              return nv
-      atomically $ putTMVar sig Wakeup
-      checker tvar nval vs sig pauser
-    where
-      concatV = fmap concat . mapM (readTVar . snd)
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
index e516298..ad7c33b 100644
--- a/src/Xmobar/App/TextEventLoop.hs
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -28,8 +28,8 @@ import Control.Concurrent.STM
 
 import Xmobar.System.Signal
 import Xmobar.Config.Types (Config(textOutputFormat), TextOutputFormat(..))
+import Xmobar.Run.Loop (initLoop, loop)
 import Xmobar.X11.Parsers (Segment, Widget(..), parseString, tColorsString, colorComponents)
-import Xmobar.App.CommandThreads (initLoop, loop)
 
 -- | Starts the main event loop and threads
 textLoop :: Config -> IO ()
diff --git a/src/Xmobar/App/X11EventLoop.hs b/src/Xmobar/App/X11EventLoop.hs
index b8897b5..662c777 100644
--- a/src/Xmobar/App/X11EventLoop.hs
+++ b/src/Xmobar/App/X11EventLoop.hs
@@ -59,7 +59,7 @@ import Xmobar.X11.Bitmap as Bitmap
 import Xmobar.X11.Types
 import Xmobar.System.Utils (safeIndex)
 
-import Xmobar.App.CommandThreads (initLoop, loop)
+import Xmobar.Run.Loop (initLoop, loop)
 
 #ifndef THREADED_RUNTIME
 import Xmobar.X11.Events(nextEvent')