From b2d9ca5a587c62ee38d04766689f19d3d4a13c1b Mon Sep 17 00:00:00 2001
From: John Soo <jsoo1@asu.edu>
Date: Fri, 17 Sep 2021 11:31:56 -0700
Subject: Let xmobar be used with a signal TMVar when used from other haskell.

---
 src/Xmobar/App/Config.hs    |  1 +
 src/Xmobar/App/EventLoop.hs |  2 +-
 src/Xmobar/App/Main.hs      |  6 +++++-
 src/Xmobar/Config/Parse.hs  |  2 +-
 src/Xmobar/Config/Types.hs  | 13 +++++++++++++
 src/Xmobar/System/Signal.hs |  7 +++----
 6 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/Xmobar/App/Config.hs b/src/Xmobar/App/Config.hs
index d17577e..a227681 100644
--- a/src/Xmobar/App/Config.hs
+++ b/src/Xmobar/App/Config.hs
@@ -64,6 +64,7 @@ defaultConfig =
            , template = "%StdinReader% }{ " ++
                         "<fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>"
            , verbose = False
+           , signal = SignalChan Nothing
            }
 
 -- | Return the path to the xmobar data directory.  This directory is
diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs
index 474ff4f..ae68e96 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/EventLoop.hs
@@ -42,7 +42,7 @@ import Data.Maybe (fromJust, isJust)
 import qualified Data.List.NonEmpty as NE
 
 import Xmobar.System.Signal
-import Xmobar.Config.Types
+import Xmobar.Config.Types (persistent, position, iconRoot, Config, Align(..), XPosition(..))
 import Xmobar.Run.Exec
 import Xmobar.Run.Runnable
 import Xmobar.X11.Actions
diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs
index 61604e0..002ff27 100644
--- a/src/Xmobar/App/Main.hs
+++ b/src/Xmobar/App/Main.hs
@@ -18,12 +18,14 @@
 module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
 
 import Control.Concurrent.Async (Async, cancel)
+import Control.Concurrent.STM (TMVar, newEmptyTMVarIO)
 import Control.Exception (bracket)
 import Control.Monad (unless)
 
 import Data.Foldable (for_)
 import qualified Data.Map as Map
 import Data.List (intercalate)
+import Data.Maybe (isJust)
 import System.Posix.Process (executeFile)
 import System.Environment (getArgs)
 import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)
@@ -53,7 +55,9 @@ xmobar conf = withDeferSignals $ do
   fl    <- mapM (initFont d) (additionalFonts conf)
   cls   <- mapM (parseTemplate (commands conf) (sepChar conf))
                 (splitTemplate (alignSep conf) (template conf))
-  sig   <- setupSignalHandler
+  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)
diff --git a/src/Xmobar/Config/Parse.hs b/src/Xmobar/Config/Parse.hs
index 056f3fc..48a31c3 100644
--- a/src/Xmobar/Config/Parse.hs
+++ b/src/Xmobar/Config/Parse.hs
@@ -57,7 +57,7 @@ parseConfig defaultConfig =
         x <- perms
         eof
         s <- getState
-        return (x,s)
+        return (x (SignalChan Nothing),s)
 
       perms = permute $ Config
               <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName
diff --git a/src/Xmobar/Config/Types.hs b/src/Xmobar/Config/Types.hs
index c31e460..3cad31c 100644
--- a/src/Xmobar/Config/Types.hs
+++ b/src/Xmobar/Config/Types.hs
@@ -17,9 +17,12 @@ module Xmobar.Config.Types
       -- $config
       Config (..)
     , XPosition (..), Align (..), Border(..)
+    , SignalChan (..)
     ) where
 
+import qualified Control.Concurrent.STM as STM
 import Xmobar.Run.Runnable (Runnable(..))
+import Xmobar.System.Signal (SignalType)
 
 -- $config
 -- Configuration data type
@@ -65,6 +68,7 @@ data Config =
                                     --   right text alignment
            , template :: String     -- ^ The output template
            , verbose :: Bool        -- ^ Emit additional debug messages
+           , signal :: SignalChan   -- ^ The signal channel used to send signals to xmobar
            } deriving (Read, Show)
 
 data XPosition = Top
@@ -91,3 +95,12 @@ data Border = NoBorder
             | BottomBM Int
             | FullBM Int
               deriving ( Read, Show, Eq )
+
+newtype SignalChan = SignalChan { unSignalChan :: Maybe (STM.TMVar SignalType) }
+
+instance Read SignalChan where
+  readsPrec _ s = [ (SignalChan Nothing, s) ]
+
+instance Show SignalChan where
+  show (SignalChan (Just _)) = "SignalChan (Just <tmvar>)"
+  show (SignalChan Nothing) = "SignalChan Nothing"
diff --git a/src/Xmobar/System/Signal.hs b/src/Xmobar/System/Signal.hs
index ce39e10..3983654 100644
--- a/src/Xmobar/System/Signal.hs
+++ b/src/Xmobar/System/Signal.hs
@@ -60,12 +60,11 @@ parseSignalType :: String -> Maybe SignalType
 parseSignalType = fmap fst . safeHead . reads
 
 -- | Signal handling
-setupSignalHandler :: IO (TMVar SignalType)
-setupSignalHandler = do
-   tid   <- newEmptyTMVarIO
+setupSignalHandler :: TMVar SignalType -> IO ()
+setupSignalHandler tid = do
    installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
    installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
-   return tid
+   return ()
 
 updatePosHandler :: TMVar SignalType -> IO ()
 updatePosHandler sig = do
-- 
cgit v1.2.3