module XNobar.Scroller (scroller, Config(..)) where import Control.Concurrent.Async (withAsync) import Control.Exception (finally) import Control.Monad (when) import Control.Monad.State.Strict (evalStateT, forever, get, liftIO, modify') import Data.IORef (atomicModifyIORef', newIORef, readIORef) import Data.Maybe (fromJust, isJust, maybe) import Flow ((.>)) import System.Directory (removeFile) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode) import Xmobar (tenthSeconds) import XNobar.Internal.Notification (makeId) import XNobar.Internal.Scroller (onlyIf, remove, merge, scroll, showNotifs, Config(..)) import XNobar.Server (NotificationsRef, fetch) scroller :: Config -> (String -> IO ()) -> NotificationsRef -> IO () scroller config@(Config { idleText = idleText , marqueeLength = marqueeLength , fontNumber = fontNumber , scrollPeriod = scrollPeriod , noNewsPrefix = noNewsPrefix , newsPrefix = newsPrefix , lineBreak = lineBreak }) callback notifs = do clicked <- newIORef Nothing (_, n, _) <- readProcessWithExitCode "uuidgen" [] "" let pipe = "/tmp/xnobar-" ++ removeLinebreak n (_, _, _) <- readProcessWithExitCode "mkfifo" [pipe] "" withAsync (forever $ do (ret, out, err) <- readProcessWithExitCode "cat" [pipe] "" case ret of ExitSuccess -> atomicModifyIORef' clicked (const (Just (removeLinebreak out), ())) ExitFailure _ -> error "how is this possible?") (const $ evalStateT (forever (update clicked pipe)) Nothing) `finally` removeFile pipe where removeLinebreak = init update clicked pipe = do newNotifs <- liftIO $ fetch notifs clicked' <- liftIO $ readIORef clicked when (isJust clicked') $ liftIO $ clear clicked modify' $ onlyIf (isJust clicked') (remove (getId $ fromJust clicked')) .> onlyIf (not $ null newNotifs) (merge newNotifs) .> scroll get >>= maybe (noNewsPrefix ++ idleText) (showNotifs config pipe) .> (liftIO . callback) liftIO $ tenthSeconds scrollPeriod where clear = (`atomicModifyIORef'` const (Nothing, ())) getId = makeId . read