{-# LANGUAGE CPP #-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.TextEventLoop
-- 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 01:21
--
--
-- Text-only event loop
--
------------------------------------------------------------------------------

module Xmobar.App.TextEventLoop (startLoop) where

import Prelude hiding (lookup)

import Control.Monad.Reader
import Control.Concurrent
import Control.Concurrent.Async (Async, async)
import Control.Concurrent.STM
import Control.Exception (bracket_, handle, SomeException(..))

import Xmobar.System.Signal
import Xmobar.Config.Types (Config)
import Xmobar.Run.Exec
import Xmobar.Run.Runnable
import Xmobar.X11.Parsers (parseStringAsText)

import Xmobar.App.CommandThreads (startCommand, refreshLockT)

#ifdef DBUS
import Xmobar.System.DBus
#endif

-- | Starts the main event loop and threads
startLoop :: Config
          -> TMVar SignalType
          -> TMVar ()
          -> [[([Async ()], TVar String)]]
          -> IO ()
startLoop cfg sig pauser vs = do
    tv <- newTVarIO []
    _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser))
#ifdef DBUS
    runIPC sig
#endif
    eventLoop cfg tv sig
  where
    handler thing (SomeException e) =
      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)

-- | 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 signal pauser = do
      nval <- atomically $ refreshLockT pauser $ do
              nv <- mapM concatV vs
              guard (nv /= ov)
              writeTVar tvar nv
              return nv
      atomically $ putTMVar signal Wakeup
      checker tvar nval vs signal pauser
    where
      concatV = fmap concat . mapM (readTVar . snd)

-- | Continuously wait for a signal from a thread or a interrupt handler
eventLoop :: Config -> TVar [String] -> TMVar SignalType -> IO ()
eventLoop cfg tv signal = do
  typ <- atomically $ takeTMVar signal
  case typ of
    Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg tv signal
    _ -> eventLoop cfg tv signal

updateString :: Config -> TVar [String] -> IO String
updateString conf v = do
  s <- readTVarIO v
  let l:c:r:_ = s ++ repeat ""
  liftIO $ concat `fmap` mapM (parseStringAsText conf) [l, c, r]