-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.Run.Actions
-- Copyright   :  (c) Alexander Polakov
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

module Xmobar.Run.Actions ( Button
                          , Action(..)
                          , runAction
                          , runAction'
                          , stripActions) where

import System.Process (system)
import Control.Monad (void)
import Text.Regex (Regex, subRegex, mkRegex, matchRegex)
import Data.Word (Word32)

type Button = Word32

data Action = Spawn [Button] String deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, ReadPrec [Action]
ReadPrec Action
Int -> ReadS Action
ReadS [Action]
(Int -> ReadS Action)
-> ReadS [Action]
-> ReadPrec Action
-> ReadPrec [Action]
-> Read Action
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Action]
$creadListPrec :: ReadPrec [Action]
readPrec :: ReadPrec Action
$creadPrec :: ReadPrec Action
readList :: ReadS [Action]
$creadList :: ReadS [Action]
readsPrec :: Int -> ReadS Action
$creadsPrec :: Int -> ReadS Action
Read, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

runAction :: Action -> IO ()
runAction :: Action -> IO ()
runAction (Spawn [Button]
_ String
s) = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ExitCode
system (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&")

-- | Run action with stdout redirected to stderr
runAction' :: Action -> IO ()
runAction' :: Action -> IO ()
runAction' (Spawn [Button]
_ String
s) = IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ExitCode
system (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 1>&2 &")

stripActions :: String -> String
stripActions :: ShowS
stripActions String
s = case Regex -> String -> Maybe [String]
matchRegex Regex
actionRegex String
s of
  Maybe [String]
Nothing -> String
s
  Just [String]
_  -> ShowS
stripActions String
strippedOneLevel
  where
      strippedOneLevel :: String
strippedOneLevel = Regex -> String -> ShowS
subRegex Regex
actionRegex String
s String
"[action=\\1\\2]\\3[/action]"

actionRegex :: Regex
actionRegex :: Regex
actionRegex = String -> Regex
mkRegex String
"<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>"