------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Command
-- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Dec 02, 2018 05:29
--
--
-- The basic Command plugin
--
------------------------------------------------------------------------------


module Xmobar.Plugins.Command where

import Control.Exception (handle, SomeException(..))
import System.Process
import System.Exit
import System.IO (hClose, hGetLine)

import Xmobar.Run.Exec

data Command = Com Program Args Alias Rate
             | ComX Program Args String Alias Rate
               deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show,ReadPrec [Command]
ReadPrec Command
Int -> ReadS Command
ReadS [Command]
(Int -> ReadS Command)
-> ReadS [Command]
-> ReadPrec Command
-> ReadPrec [Command]
-> Read Command
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Command]
$creadListPrec :: ReadPrec [Command]
readPrec :: ReadPrec Command
$creadPrec :: ReadPrec Command
readList :: ReadS [Command]
$creadList :: ReadS [Command]
readsPrec :: Int -> ReadS Command
$creadsPrec :: Int -> ReadS Command
Read,Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq)

type Args    = [String]
type Program = String
type Alias   = String
type Rate    = Int

instance Exec Command where
    alias :: Command -> String
alias (ComX String
p Args
_ String
_ String
a Int
_) =
      if String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then (if String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
p else String
a) else String
""
    alias (Com String
p Args
a String
al Int
r) = Command -> String
forall e. Exec e => e -> String
alias (String -> Args -> String -> String -> Int -> Command
ComX String
p Args
a String
"" String
al Int
r)
    start :: Command -> (String -> IO ()) -> IO ()
start (Com String
p Args
as String
al Int
r) String -> IO ()
cb =
      Command -> (String -> IO ()) -> IO ()
forall e. Exec e => e -> (String -> IO ()) -> IO ()
start (String -> Args -> String -> String -> Int -> Command
ComX String
p Args
as (String
"Could not execute command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
p) String
al Int
r) String -> IO ()
cb
    start (ComX String
prog Args
args String
msg String
_ Int
r) String -> IO ()
cb = if Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then IO ()
go else IO ()
exec
        where go :: IO ()
go = Int -> IO () -> IO ()
doEveryTenthSeconds Int
r IO ()
exec
              exec :: IO ()
exec = do
                (Handle
i,Handle
o,Handle
e,ProcessHandle
p) <- String
-> Args
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
prog Args
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
                ExitCode
exit <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
                let closeHandles :: IO ()
closeHandles = Handle -> IO ()
hClose Handle
o IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
i IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
e
                    getL :: IO String
getL = (SomeException -> IO String) -> IO String -> IO String
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
                                  (Handle -> IO String
hGetLine Handle
o)
                case ExitCode
exit of
                  ExitCode
ExitSuccess -> do String
str <- IO String
getL
                                    IO ()
closeHandles
                                    String -> IO ()
cb String
str
                  ExitCode
_ -> IO ()
closeHandles IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
cb String
msg