From 6fc4f0cfcb809b51048e6a3d952b9c887e07b13b Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 2 Dec 2018 05:50:56 +0000 Subject: Fix: exposing the Command constructors in lib --- src/Xmobar/Run/Command.hs | 55 +++++++++++++++++++++++++++ src/Xmobar/Run/Commands.hs | 82 ----------------------------------------- src/Xmobar/Run/Exec.hs | 48 ++++++++++++++++++++++++ src/Xmobar/Run/Runnable.hs | 2 +- src/Xmobar/Run/Runnable.hs-boot | 2 +- src/Xmobar/Run/Template.hs | 3 +- src/Xmobar/Run/Types.hs | 4 +- 7 files changed, 109 insertions(+), 87 deletions(-) create mode 100644 src/Xmobar/Run/Command.hs delete mode 100644 src/Xmobar/Run/Commands.hs create mode 100644 src/Xmobar/Run/Exec.hs (limited to 'src/Xmobar/Run') diff --git a/src/Xmobar/Run/Command.hs b/src/Xmobar/Run/Command.hs new file mode 100644 index 0000000..0953132 --- /dev/null +++ b/src/Xmobar/Run/Command.hs @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Command +-- Copyright: (c) 2018 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.Run.Command where + +import Control.Exception (handle, SomeException(..)) +import System.Process +import System.Exit +import System.IO (hClose) +import Xmobar.System.Utils (hGetLineSafe) + +import Xmobar.Run.Exec + +data Command = Com Program Args Alias Rate + | ComX Program Args String Alias Rate + deriving (Show,Read,Eq) + +type Args = [String] +type Program = String +type Alias = String +type Rate = Int + +instance Exec Command where + alias (ComX p _ _ a _) = + if p /= "" then (if a == "" then p else a) else "" + alias (Com p a al r) = alias (ComX p a "" al r) + start (Com p as al r) cb = + start (ComX p as ("Could not execute command " ++ p) al r) cb + start (ComX prog args msg _ r) cb = if r > 0 then go else exec + where go = exec >> tenthSeconds r >> go + exec = do + (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing + exit <- waitForProcess p + let closeHandles = hClose o >> hClose i >> hClose e + getL = handle (\(SomeException _) -> return "") + (hGetLineSafe o) + case exit of + ExitSuccess -> do str <- getL + closeHandles + cb str + _ -> closeHandles >> cb msg diff --git a/src/Xmobar/Run/Commands.hs b/src/Xmobar/Run/Commands.hs deleted file mode 100644 index 2aac344..0000000 --- a/src/Xmobar/Run/Commands.hs +++ /dev/null @@ -1,82 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Commands --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- The 'Exec' class and the 'Command' data type. --- --- The 'Exec' class rappresents the executable types, whose constructors may --- appear in the 'Config.commands' field of the 'Config.Config' data type. --- --- The 'Command' data type is for OS commands to be run by xmobar --- ------------------------------------------------------------------------------ - -module Xmobar.Run.Commands (Command (..), Exec (..), tenthSeconds) where - -import Prelude -import Control.Exception (handle, SomeException(..)) -import Data.Char -import System.Process -import System.Exit -import System.IO (hClose) -import Control.Concurrent - -import Xmobar.System.Signal -import Xmobar.System.Utils (hGetLineSafe) - --- | Work around to the Int max bound: since threadDelay takes an Int, it --- is not possible to set a thread delay grater than about 45 minutes. --- With a little recursion we solve the problem. -tenthSeconds :: Int -> IO () -tenthSeconds s | s >= x = do threadDelay (x * 100000) - tenthSeconds (s - x) - | otherwise = threadDelay (s * 100000) - where x = (maxBound :: Int) `div` 100000 - -class Show e => Exec e where - alias :: e -> String - alias e = takeWhile (not . isSpace) $ show e - rate :: e -> Int - rate _ = 10 - run :: e -> IO String - run _ = return "" - start :: e -> (String -> IO ()) -> IO () - start e cb = go - where go = run e >>= cb >> tenthSeconds (rate e) >> go - trigger :: e -> (Maybe SignalType -> IO ()) -> IO () - trigger _ sh = sh Nothing - -data Command = Com Program Args Alias Rate - | ComX Program Args String Alias Rate - deriving (Show,Read,Eq) - -type Args = [String] -type Program = String -type Alias = String -type Rate = Int - -instance Exec Command where - alias (ComX p _ _ a _) = - if p /= "" then (if a == "" then p else a) else "" - alias (Com p a al r) = alias (ComX p a "" al r) - start (Com p as al r) cb = - start (ComX p as ("Could not execute command " ++ p) al r) cb - start (ComX prog args msg _ r) cb = if r > 0 then go else exec - where go = exec >> tenthSeconds r >> go - exec = do - (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing - exit <- waitForProcess p - let closeHandles = hClose o >> hClose i >> hClose e - getL = handle (\(SomeException _) -> return "") - (hGetLineSafe o) - case exit of - ExitSuccess -> do str <- getL - closeHandles - cb str - _ -> closeHandles >> cb msg diff --git a/src/Xmobar/Run/Exec.hs b/src/Xmobar/Run/Exec.hs new file mode 100644 index 0000000..c8fcb9e --- /dev/null +++ b/src/Xmobar/Run/Exec.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Xmobar.Exec +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- The 'Exec' class and the 'Command' data type. +-- +-- The 'Exec' class rappresents the executable types, whose constructors may +-- appear in the 'Config.commands' field of the 'Config.Config' data type. +-- +-- The 'Command' data type is for OS commands to be run by xmobar +-- +----------------------------------------------------------------------------- + +module Xmobar.Run.Exec (Exec (..), tenthSeconds) where + +import Prelude +import Data.Char +import Control.Concurrent + +import Xmobar.System.Signal + +-- | Work around to the Int max bound: since threadDelay takes an Int, it +-- is not possible to set a thread delay grater than about 45 minutes. +-- With a little recursion we solve the problem. +tenthSeconds :: Int -> IO () +tenthSeconds s | s >= x = do threadDelay (x * 100000) + tenthSeconds (s - x) + | otherwise = threadDelay (s * 100000) + where x = (maxBound :: Int) `div` 100000 + +class Show e => Exec e where + alias :: e -> String + alias e = takeWhile (not . isSpace) $ show e + rate :: e -> Int + rate _ = 10 + run :: e -> IO String + run _ = return "" + start :: e -> (String -> IO ()) -> IO () + start e cb = go + where go = run e >>= cb >> tenthSeconds (rate e) >> go + trigger :: e -> (Maybe SignalType -> IO ()) -> IO () + trigger _ sh = sh Nothing diff --git a/src/Xmobar/Run/Runnable.hs b/src/Xmobar/Run/Runnable.hs index 962166e..068a05b 100644 --- a/src/Xmobar/Run/Runnable.hs +++ b/src/Xmobar/Run/Runnable.hs @@ -24,7 +24,7 @@ module Xmobar.Run.Runnable where import Control.Monad import Text.Read import Xmobar.Run.Types (runnableTypes) -import Xmobar.Run.Commands +import Xmobar.Run.Exec data Runnable = forall r . (Exec r, Read r, Show r) => Run r diff --git a/src/Xmobar/Run/Runnable.hs-boot b/src/Xmobar/Run/Runnable.hs-boot index f272d81..1cd1688 100644 --- a/src/Xmobar/Run/Runnable.hs-boot +++ b/src/Xmobar/Run/Runnable.hs-boot @@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} module Xmobar.Run.Runnable where -import Xmobar.Run.Commands +import Xmobar.Run.Exec data Runnable = forall r . (Exec r,Read r,Show r) => Run r diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs index 749edcd..50c3a08 100644 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -20,7 +20,8 @@ module Xmobar.Run.Template(parseTemplate, splitTemplate) where import qualified Data.Map as Map import Text.ParserCombinators.Parsec -import Xmobar.Run.Commands +import Xmobar.Run.Exec +import Xmobar.Run.Command import Xmobar.Run.Runnable defaultAlign :: String diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs index 4fb526a..f4a7252 100644 --- a/src/Xmobar/Run/Types.hs +++ b/src/Xmobar/Run/Types.hs @@ -18,8 +18,6 @@ module Xmobar.Run.Types(runnableTypes) where -import Xmobar.Run.Commands - import {-# SOURCE #-} Xmobar.Run.Runnable() import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date @@ -42,6 +40,8 @@ import Xmobar.Plugins.MBox import Xmobar.Plugins.DateZone #endif +import Xmobar.Run.Command + -- | An alias for tuple types that is more convenient for long lists. type a :*: b = (a, b) infixr :*: -- cgit v1.2.3