Monitors are now a Plugin that can be removed from Config.hs

darcs-hash:20070718151211-d6583-7e0e49c22d07feda72d03370fd592c196dfcc9c1.gz

1 files changed, 0 insertions, 286 deletions

diff --git a/Monitors/Common.hs b/Monitors/Common.hs
deleted file mode 100644
index 9928946..0000000
--- a/Monitors/Common.hs
+++ /dev/null
@@ -1,286 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Monitors.Common
--- Copyright   :  (c) Andrea Rossato
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Utilities for creating monitors for Xmobar
---
------------------------------------------------------------------------------
-
-module Monitors.Common ( 
-                       -- * Monitors
-                       -- $monitor
-                         Monitor
-                       , MConfig (..)
-                       , Opts (..)
-                       , setConfigValue
-                       , getConfigValue
-                       , mkMConfig
-                       , runM
-                       , io
-                       -- * Parsers
-                       -- $parsers
-                       , runP
-                       , skipRestOfLine
-                       , getNumbers
-                       , getNumbersAsString
-                       , getAllBut
-                       , getAfterString
-                       , skipTillString
-                       , parseTemplate
-                       -- ** String Manipulation
-                       -- $strings
-                       , showWithColors
-                       , takeDigits
-                       , floatToPercent
-                       , stringParser
-                       -- * Threaded Actions
-                       -- $thread
-                       , doActionTwiceWithDelay
-                       ) where
-
-
-import Control.Concurrent
-import Control.Monad.Reader
-
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.IORef
-import qualified Data.Map as Map 
-
-import Numeric
-
-import Text.ParserCombinators.Parsec
-
-import System.Console.GetOpt
-
--- $monitor
-
-type Monitor a = ReaderT MConfig IO a
-
-data MConfig =
-    MC { normalColor :: IORef (Maybe String)
-       , low :: IORef Int
-       , lowColor :: IORef (Maybe String)
-       , high :: IORef Int
-       , highColor :: IORef (Maybe String)
-       , template :: IORef String
-       , export :: IORef [String]
-       } 
-
--- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState'
-type Selector a = MConfig -> IORef a
-
-sel :: Selector a -> Monitor a
-sel s = 
-    do hs <- ask
-       liftIO $ readIORef (s hs)
-
-mods :: Selector a -> (a -> a) -> Monitor ()
-mods s m = 
-    do v <- ask
-       io $ modifyIORef (s v) m
-
-setConfigValue :: a -> Selector a -> Monitor ()
-setConfigValue v s =
-       mods s (\_ -> v)
-
-getConfigValue :: Selector a -> Monitor a
-getConfigValue s =
-    sel s
-
-mkMConfig :: String
-          -> [String]
-          -> IO MConfig
-mkMConfig tmpl exprts =
-    do lc <- newIORef Nothing
-       l <- newIORef 33
-       nc <- newIORef Nothing
-       h <- newIORef 66
-       hc <- newIORef Nothing
-       t <- newIORef tmpl
-       e <- newIORef exprts
-       return $ MC nc l lc h hc t e
-
-data Opts = HighColor String
-          | NormalColor String
-          | LowColor String
-          | Low String
-          | High String
-          | Template String
-
-options :: [OptDescr Opts]
-options =
-    [ Option ['H']  ["High"]  (ReqArg High "number") "The high threshold"
-    , Option ['L']  ["Low"]  (ReqArg Low "number") "The low threshold"
-    , Option ['h']  ["high"]  (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\""
-    , Option ['n']  ["normal"]  (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\""
-    , Option ['l']  ["low"]  (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\""
-    , Option ['t']  ["template"]  (ReqArg Template "output template") "Output template."
-    ]
-
-doArgs :: [String] 
-       -> ([String] -> Monitor String)
-       -> Monitor String
-doArgs args action =
-    do case (getOpt Permute options args) of
-         (o, n, []) -> do doConfigOptions o
-                          action n
-         (_, _, errs) -> return (concat errs)
-
-doConfigOptions :: [Opts] -> Monitor ()
-doConfigOptions [] = io $ return ()
-doConfigOptions (o:oo) =
-    do let next = doConfigOptions oo
-       case o of
-         High h -> setConfigValue (read h) high >> next
-         Low l -> setConfigValue (read l) low >> next
-         HighColor hc -> setConfigValue (Just hc) highColor >> next
-         NormalColor nc -> setConfigValue (Just nc) normalColor >> next
-         LowColor lc -> setConfigValue (Just lc) lowColor >> next
-         Template t -> setConfigValue t template >> next
-
-runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO String
-runM args conf action =
-    do c <- conf
-       let ac = doArgs args action
-       runReaderT ac c
-
-io :: IO a -> Monitor a
-io = liftIO
-
-
-
--- $parsers
-
-runP :: Parser [a] -> String -> IO [a]
-runP p i = 
-    do case (parse p "" i) of
-         Left _ -> return []
-         Right x  -> return x
-
-getAllBut :: String -> Parser String
-getAllBut s =
-    manyTill (noneOf s) (char $ head s)
-
-getNumbers :: Parser Float
-getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n
-
-getNumbersAsString :: Parser String
-getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n
-
-skipRestOfLine :: Parser Char
-skipRestOfLine =
-    do many $ noneOf "\n\r"
-       newline
-
-getAfterString :: String -> Parser String
-getAfterString s =
-    do { try $ manyTill skipRestOfLine $ string s
-       ; v <- manyTill anyChar $ newline
-       ; return v
-       } <|> return ("<" ++ s ++ " not found!>")
-
-skipTillString :: String -> Parser String
-skipTillString s = 
-    manyTill skipRestOfLine $ string s
-
--- | Parses the output template string
-templateStringParser :: Parser (String,String,String)
-templateStringParser =
-    do{ s <- many $ noneOf "<"
-      ; (_,com,_) <- templateCommandParser
-      ; ss <- many $ noneOf "<"
-      ; return (s, com, ss)
-      } 
-
--- | Parses the command part of the template string
-templateCommandParser :: Parser (String,String,String)
-templateCommandParser =
-    do { char '<'
-       ; com <- many $ noneOf ">"
-       ; char '>'
-       ; return $ ("",com,"")
-       }
-
--- | Combines the template parsers
-templateParser :: Parser [(String,String,String)]
-templateParser = many templateStringParser --"%")
-
--- | Takes a list of strings that represent the values of the exported
--- keys. The strings are joined with the exported keys to form a map
--- to be combined with 'combine' to the parsed template. Returns the
--- final output of the monitor.
-parseTemplate :: [String] -> Monitor String
-parseTemplate l =
-    do t <- getConfigValue template
-       s <- io $ runP templateParser t
-       e <- getConfigValue export
-       let m = Map.fromList . zip e $ l 
-       return $ combine m s 
-
--- | Given a finite "Map" and a parsed templatet produces the
--- | resulting output string.
-combine :: Map.Map String String -> [(String, String, String)] -> String
-combine _ [] = []
-combine m ((s,ts,ss):xs) = 
-    s ++ str ++ ss ++ combine m xs
-        where str = Map.findWithDefault err ts m
-              err = "<" ++ ts ++ " not found!>"
-
--- $strings
-
-type Pos = (Int, Int)
-
-takeDigits :: Int -> Float -> Float
-takeDigits d n = 
-    fromIntegral ((round (n * fact)) :: Int) / fact
-  where fact = 10 ^ d
-
-floatToPercent :: Float -> String
-floatToPercent n = 
-    showFFloat (Just 2) (n*100) "%" 
-
-stringParser :: Pos -> B.ByteString -> String
-stringParser (x,y) =
-     flip (!!) x . map B.unpack . B.words . flip (!!) y . B.lines
-
-setColor :: String -> Selector (Maybe String) -> Monitor String
-setColor str s =
-    do a <- getConfigValue s
-       case a of
-            Nothing -> return str
-            Just c -> return $
-                "<fc=" ++ c ++ ">" ++ str ++ "</fc>"
-
-showWithColors :: (Float -> String) -> Float -> Monitor String
-showWithColors f x =
-    do h <- getConfigValue high
-       l <- getConfigValue low
-       let col = setColor $ f x
-       head $ [col highColor | x > fromIntegral h ] ++
-              [col normalColor | x > fromIntegral l ] ++
-              [col lowColor | True]
-
--- $threads
-
-doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])
-doActionTwiceWithDelay delay action = 
-    do v1 <- newMVar []
-       forkIO $! getData action v1 0
-       v2 <- newMVar []
-       forkIO $! getData action v2 delay
-       threadDelay (delay `div` 3 * 4)
-       a <- readMVar v1
-       b <- readMVar v2
-       return (a,b)
-
-getData :: IO a -> MVar a -> Int -> IO ()
-getData action var d =
-    do threadDelay d
-       s <- action
-       modifyMVar_ var (\_ -> return $! s)