diff options
| -rw-r--r-- | Commands.hs | 80 | ||||
| -rw-r--r-- | Config.hs | 10 | ||||
| -rw-r--r-- | Parsers.hs | 19 | ||||
| -rw-r--r-- | Runnable.hs | 50 | ||||
| -rw-r--r-- | Runnable.hs-boot | 11 | ||||
| -rw-r--r-- | XMobar.hs | 18 | ||||
| -rw-r--r-- | xmobar.config-sample | 18 |
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 + + @@ -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,()) @@ -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 + + @@ -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%" |