summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorAndrea Rossato <andrea.rossato@ing.unitn.it>2007-07-12 19:50:34 +0200
committerAndrea Rossato <andrea.rossato@ing.unitn.it>2007-07-12 19:50:34 +0200
commite85b0920a06ad019754e1cb8e72eb6cc34cdeedc (patch)
tree34a28f6a54290bd7347f83efc4a7a5f387419f31
parent14267de1e03841980ce99206c0cf63e40bfa6cca (diff)
downloadxmobar-e85b0920a06ad019754e1cb8e72eb6cc34cdeedc.tar.gz
xmobar-e85b0920a06ad019754e1cb8e72eb6cc34cdeedc.tar.bz2
use of existential types for plugin support
This patch, which *changes the configuration format*, adds easy plugin support by using an existential type for storing the list of commands to be executed. Adding a plugin is just a matter of writing the appropriate instance of the Exec class, after importing Commands.hs. I must thank Claus Reinke for the help in understanding the mysteries of reading existential types. The Read instance of Runnable must be credited to him. See here: http://www.haskell.org/pipermail/haskell-cafe/2007-July/028227.html darcs-hash:20070712175034-d6583-f10174bb3b0a9b4f6e08d05052c18f30e539b319.gz
-rw-r--r--Commands.hs80
-rw-r--r--Config.hs10
-rw-r--r--Parsers.hs19
-rw-r--r--Runnable.hs50
-rw-r--r--Runnable.hs-boot11
-rw-r--r--XMobar.hs18
-rw-r--r--xmobar.config-sample18
7 files changed, 139 insertions, 67 deletions
diff --git a/Commands.hs b/Commands.hs
index 7c0985e..459892b 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMobar.Commands
@@ -26,48 +27,59 @@ import Monitors.Swap
import Monitors.Cpu
import Monitors.Batt
-data Command = Exec Program Args Alias
- | Weather Station Args
- | Network Interface Args
- | Memory Args
- | Swap Args
- | Cpu Args
- | Battery Args
- deriving (Read,Eq)
+data Command = Com Program Args Alias Rate
+ | Weather Station Args Rate
+ | Network Interface Args Rate
+ | Memory Args Rate
+ | Swap Args Rate
+ | Cpu Args Rate
+ | Battery Args Rate
+ deriving (Show,Read,Eq)
type Args = [String]
type Program = String
type Alias = String
type Station = String
type Interface = String
+type Rate = Int
-instance Show Command where
- show (Weather s _) = s
- show (Network i _) = i
- show (Memory _) = "memory"
- show (Swap _) = "swap"
- show (Cpu _) = "cpu"
- show (Battery _) = "battery"
- show (Exec p _ a) | p /= "" = if a == "" then p else a
- | otherwise = ""
class Exec e where
run :: e -> IO String
+ rate :: e -> Int
+ alias :: e -> String
instance Exec Command where
- run (Weather s a) = runM (a ++ [s]) weatherConfig runWeather
- run (Network i a) = runM (a ++ [i]) netConfig runNet
- run (Memory args) = runM args memConfig runMem
- run (Swap args) = runM args swapConfig runSwap
- run (Cpu args) = runM args cpuConfig runCpu
- run (Battery args) = runM args battConfig runBatt
- run (Exec prog args _) = do (i,o,e,p) <- runInteractiveCommand (prog ++ concat (map (' ':) args))
- exit <- waitForProcess p
- let closeHandles = do hClose o
- hClose i
- hClose e
- case exit of
- ExitSuccess -> do str <- hGetLine o
- closeHandles
- return str
- _ -> do closeHandles
- return $ "Could not execute command " ++ prog
+ alias (Weather s _ _) = s
+ alias (Network i _ _) = i
+ alias (Memory _ _) = "memory"
+ alias (Swap _ _) = "swap"
+ alias (Cpu _ _) = "cpu"
+ alias (Battery _ _) = "battery"
+ alias (Com p _ a _) | p /= "" = if a == "" then p else a
+ | otherwise = ""
+ rate (Weather _ _ r) = r
+ rate (Network _ _ r) = r
+ rate (Memory _ r) = r
+ rate (Swap _ r) = r
+ rate (Cpu _ r) = r
+ rate (Battery _ r) = r
+ rate (Com _ _ _ r) = r
+ run (Weather s a _) = runM (a ++ [s]) weatherConfig runWeather
+ run (Network i a _) = runM (a ++ [i]) netConfig runNet
+ run (Memory args _) = runM args memConfig runMem
+ run (Swap args _) = runM args swapConfig runSwap
+ run (Cpu args _) = runM args cpuConfig runCpu
+ run (Battery args _) = runM args battConfig runBatt
+ run (Com prog args _ _) = do (i,o,e,p) <- runInteractiveCommand (prog ++ concat (map (' ':) args))
+ exit <- waitForProcess p
+ let closeHandles = do hClose o
+ hClose i
+ hClose e
+ case exit of
+ ExitSuccess -> do str <- hGetLine o
+ closeHandles
+ return str
+ _ -> do closeHandles
+ return $ "Could not execute command " ++ prog
+
+
diff --git a/Config.hs b/Config.hs
index 1ab01c9..b2aae29 100644
--- a/Config.hs
+++ b/Config.hs
@@ -16,9 +16,12 @@ module Config ( -- * Configuration
-- $config
Config (..)
, defaultConfig
+ , runnableTypes
) where
import Commands
+import {-# SOURCE #-} Runnable
+
-- $config
-- Configuration data type and default configuration
@@ -33,7 +36,7 @@ data Config =
, height :: Int -- ^ Window height
, align :: String -- ^ text alignment
, refresh :: Int -- ^ Refresh rate in tenth of seconds
- , commands :: [(Command,Int)] -- ^ For setting the command, the command argujments
+ , commands :: [Runnable] -- ^ For setting the command, the command argujments
-- and refresh rate for the programs to run (optional)
, sepChar :: String -- ^ The character to be used for indicating
-- commands in the output template (default '%')
@@ -52,7 +55,10 @@ defaultConfig =
, height = 15
, align = "left"
, refresh = 10
- , commands = [(Memory [],10)]
+ , commands = [Run $ Memory [] 10]
, sepChar = "%"
, template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc> %memory%"
}
+
+runnableTypes :: (Command,())
+runnableTypes = undefined :: (Command,())
diff --git a/Parsers.hs b/Parsers.hs
index fa85193..8c25004 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -27,6 +27,7 @@ module Parsers (
import Config
import Commands
+import Runnable
import Text.ParserCombinators.Parsec
import qualified Data.Map as Map
@@ -103,20 +104,20 @@ templateParser :: Config -> Parser [(String,String,String)]
templateParser c = many (templateStringParser c)
-- | Actually runs the template parsers
-parseTemplate :: Config -> String -> IO [(Command,String,String)]
+parseTemplate :: Config -> String -> IO [(Runnable,String,String)]
parseTemplate config s =
do str <- case (parse (templateParser config) "" s) of
Left _ -> return [("","","")]
Right x -> return x
- let comList = map (show . fst) $ commands config
- m = Map.fromList . zip comList . map fst $ (commands config)
- return $ combine m str
+ let comList = map alias (commands config)
+ m = Map.fromList $ zip comList (commands config)
+ return $ combine config m str
-- | Given a finite "Map" and a parsed templatet produces the
-- | resulting output string.
-combine :: Map.Map String Command -> [(String, String, String)] -> [(Command,String,String)]
-combine _ [] = []
-combine m ((ts,s,ss):xs) =
- [(com, s, ss)] ++ combine m xs
+combine :: Config -> Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)]
+combine _ _ [] = []
+combine config m ((ts,s,ss):xs) =
+ [(com, s, ss)] ++ combine config m xs
where com = Map.findWithDefault dflt ts m
- dflt = Exec ts [] [] --"<" ++ ts ++ " not found!>"
+ dflt = Run $ Com ts [] [] (refresh config) --"<" ++ ts ++ " not found!>"
diff --git a/Runnable.hs b/Runnable.hs
new file mode 100644
index 0000000..90e01af
--- /dev/null
+++ b/Runnable.hs
@@ -0,0 +1,50 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Runnable where
+
+import Control.Monad
+import Text.Read
+import Text.ParserCombinators.ReadPrec
+import Config (runnableTypes)
+import Commands
+
+data Runnable = forall r . (Exec r,Show r, Read r) => Run r
+
+instance Show Runnable where
+ show (Run a) = "Run " ++ show a
+
+instance Exec Runnable where
+ run (Run a) = run a
+ rate (Run a) = rate a
+ alias (Run a) = alias a
+
+instance Read Runnable where
+ readPrec = readRunnable
+
+-- read an existential as any of hidden types ts
+class ReadAsAnyOf ts ex where
+ readAsAnyOf :: ts -> ReadPrec ex
+
+instance ReadAsAnyOf () ex where
+ readAsAnyOf ~() = mzero
+
+instance (Read t, Show t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where
+ readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts
+ where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) }
+
+
+
+readRunnable :: ReadPrec Runnable
+readRunnable = prec 10 $ do
+ Ident "Run" <- lexP
+ parens $ readAsAnyOf runnableTypes
+
+
+-- | Reads the configuration files or quits with an error
+readConfig :: FilePath -> IO Runnable
+readConfig f =
+ do s <- readFile f
+ case reads s of
+ [(config,_)] -> return config
+ [] -> error ("Corrupt config file: " ++ f)
+ _ -> error ("Some problem occured. Aborting...")
+
diff --git a/Runnable.hs-boot b/Runnable.hs-boot
new file mode 100644
index 0000000..90dbe81
--- /dev/null
+++ b/Runnable.hs-boot
@@ -0,0 +1,11 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Runnable where
+import Commands
+
+data Runnable = forall r . (Exec r,Show r, Read r) => Run r
+
+instance Read Runnable
+instance Exec Runnable
+instance Show Runnable
+
+
diff --git a/XMobar.hs b/XMobar.hs
index 6e9b142..593c7cb 100644
--- a/XMobar.hs
+++ b/XMobar.hs
@@ -47,6 +47,7 @@ import Control.Concurrent
import Config
import Parsers
import Commands
+import Runnable
-- $main
--
@@ -163,31 +164,22 @@ printStrings p gc fontst offs sl@((s,c,l):xs) =
-- $commands
--- | Gets the refresh rate set in configuration for a given command.
-getRefRate :: Config -> Command -> Int
-getRefRate c com =
- let l = commands c
- p = filter (\(s,_) -> s == com) l
- in case p of
- [(_,int)] -> int
- _ -> refresh c
-
-- | Runs a list of programs as independent threads and returns their thread id
-- and the MVar they will be writing to.
-execCommands :: Config -> [(Command,String,String)] -> IO [(ThreadId, MVar String)]
+execCommands :: Config -> [(Runnable,String,String)] -> IO [(ThreadId, MVar String)]
execCommands _ [] = return []
execCommands c (x:xs) =
do i <- execCommand c x
is <- execCommands c xs
return $ i : is
-execCommand :: Config -> (Command,String,String) -> IO (ThreadId, MVar String)
+execCommand :: Config -> (Runnable,String,String) -> IO (ThreadId, MVar String)
execCommand c com =
do var <- newMVar "Updating..."
h <- forkIO $ runCommandLoop var c com
return (h,var)
-runCommandLoop :: MVar String -> Config -> (Command,String,String) -> IO ()
+runCommandLoop :: MVar String -> Config -> (Runnable,String,String) -> IO ()
runCommandLoop var conf c@(com,s,ss)
| show com == "" =
do modifyMVar_ var (\_ -> return $ "Could not parse the template")
@@ -196,7 +188,7 @@ runCommandLoop var conf c@(com,s,ss)
| otherwise =
do str <- run com
modifyMVar_ var (\_ -> return $ s ++ str ++ ss)
- tenthSeconds (getRefRate conf com)
+ tenthSeconds (rate com)
runCommandLoop var conf c
-- | Reads MVars set by 'runCommandLoop'
diff --git a/xmobar.config-sample b/xmobar.config-sample
index e2d54a6..3092cbc 100644
--- a/xmobar.config-sample
+++ b/xmobar.config-sample
@@ -7,15 +7,15 @@ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
, height = 15
, align = "right"
, refresh = 10
- , commands = [ (Weather "EGPF" ["-t","<station>: <tempC>C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"], 36000)
- , (Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"], 10)
- , (Network "eth1" ["-L","0","-H","32","--normal","green","--high","red"], 10)
- , (Cpu ["-L","3","-H","50","--normal","green","--high","red"], 10)
- , (Exec "date" ["+\"%a %b %_d %H:%M\""] "mydate", 600)
- , (Exec "date" ["+%Y"] "year", 304128000)
- , (Memory ["-t","Mem: <usedratio>%"], 10)
- , (Swap [], 10)
- , (Exec "uname" ["-s","-r"] "", 36000)
+ , commands = [ Run Weather "EGPF" ["-t","<station>: <tempC>C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000
+ , Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10
+ , Run Network "eth1" ["-L","0","-H","32","--normal","green","--high","red"] 10
+ , Run Cpu ["-L","3","-H","50","--normal","green","--high","red"] 10
+ , Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600
+ , Run Com "date" ["+%Y"] "year" 304128000
+ , Run Memory ["-t","Mem: <usedratio>%"] 10
+ , Run Swap [] 10
+ , Run Com "uname" ["-s","-r"] "" 36000
]
, sepChar = "%"
, template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% | %EGPF% | <fc=#ee9a00>%mydate% of %year%</fc> %uname%"