diff options
| -rw-r--r-- | Parsers.hs | 78 | ||||
| -rw-r--r-- | Plugins/Monitors/Batt.hs | 56 |
2 files changed, 84 insertions, 50 deletions
@@ -23,12 +23,6 @@ import Config import Runnable import Commands -import Control.Monad.Writer(mapM_, ap, liftM, liftM2, MonadWriter, tell) -import Control.Applicative.Permutation(optAtom, runPermsSep) -import Control.Applicative(Applicative, (<*>), Alternative, empty, (<$), (<$>)) -import qualified Control.Applicative - -import Data.List(tails, find, inits) import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Perm @@ -111,8 +105,11 @@ allTillSep :: Config -> Parser String allTillSep = many . noneOf . sepChar stripComments :: String -> String -stripComments = unlines . map (strip False) . lines +stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else "" + strip m ('\\':xss) = case xss of + '\\':xs -> '\\' : strip m xs + _ -> strip m $ drop 1 xss strip m ('"':xs) = '"': strip (not m) xs strip m (x:xs) = x : strip m xs strip _ [] = [] @@ -122,22 +119,48 @@ stripComments = unlines . map (strip False) . lines parseConfig :: String -> Either ParseError (Config,[String]) parseConfig = runParser parseConf fields "Config" . stripComments where - parseConf = parse $ do - sepEndSpaces ["Config","{"] - x <- unWrapParser perms - wrapSkip (string "}") + parseConf = do + many space + sepEndSpc ["Config","{"] + x <- perms eof - return x - perms = runPermsSep (WrappedParser $ wrapSkip $ string ",") $ liftM9 Config - <$> withDef font "font" strField - <*> withDef bgColor "bgColor" strField - <*> withDef fgColor "fgColor" strField - <*> withDef position "position" (field readsToParsec) - <*> withDef lowerOnStart "lowerOnStart" (field parseEnum ) - <*> withDef commands "commands" (field readsToParsec) - <*> withDef sepChar "sepChar" strField - <*> withDef alignSep "alignSep" strField - <*> withDef template "template" strField + s <- getState + return (x,s) + + perms = permute $ Config + <$?> pFont <|?> pBgColor + <|?> pFgColor <|?> pPosition + <|?> pLowerOnStart <|?> pCommands + <|?> pSepChar <|?> pAlignSep + <|?> pTemplate + + fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" + , "template", "position", "lowerOnStart", "commands"] + pFont = strField font "font" + pBgColor = strField bgColor "bgColor" + pFgColor = strField fgColor "fgColor" + pSepChar = strField sepChar "sepChar" + pAlignSep = strField alignSep "alignSep" + pTemplate = strField template "template" + + pPosition = field position "position" $ tillFieldEnd >>= read' "position" + pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart" + pCommands = field commands "commands" $ readCommands + + staticPos = do string "Static" + wrapSkip (string "{") + p <- many (noneOf "}") + wrapSkip (string "}") + string "," + return ("Static {" ++ p ++ "}") + tillFieldEnd = staticPos <|> many (noneOf ",}\n\r") + + commandsEnd = wrapSkip (string "]") >> oneOf "}," + readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" + + strField e n = field e n . between (strDel "start" n) (strDel "end" n) . many $ noneOf "\"\n\r" + strDel t n = char '"' <?> strErr t n + strErr t n = "the " ++ t ++ " of the string field " ++ n ++ " - a double quote (\")." wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string) @@ -146,10 +169,11 @@ parseConfig = runParser parseConf fields "Config" . stripComments updateState (filter (/= n)) >> sepEndSpc [n,"="] >> wrapSkip c >>= \r -> fieldEnd >> return r - withDef ext name parser = optAtom (do tell [name]; return $ ext defaultConfig) - (liftM return $ WrappedParser $ parser name) + read' d s = case reads s of + [(x, _)] -> return x + _ -> fail $ "error reading the " ++ d ++ " field: " ++ s - parseEnum = choice $ map (\x -> x <$ string (show x)) [minBound .. maxBound] +commandsErr :: String +commandsErr = "commands: this usually means that a command could not be parsed.\n" ++ + "The error could be located at the begining of the command which follows the offending one." - strField name = flip field name $ between (char '"') (char '"') (many1 . satisfy $ (/= '"')) - field cont name = sepEndSpaces [name,"="] >> cont diff --git a/Plugins/Monitors/Batt.hs b/Plugins/Monitors/Batt.hs index 4d3f540..6ea62a9 100644 --- a/Plugins/Monitors/Batt.hs +++ b/Plugins/Monitors/Batt.hs @@ -18,37 +18,47 @@ import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common import System.Posix.Files (fileExist) -data Batt = Batt Float +data Batt = Batt Float String | NA battConfig :: IO MConfig battConfig = mkMConfig "Batt: <left>" -- template - ["left"] -- available replacements + ["left","status"] -- available replacements -file2batfile :: String -> (String, String) -file2batfile s = ("/proc/acpi/battery/"++ s ++ "/info", "/proc/acpi/battery/"++ s ++ "/state") +type File = (String, String) -readFileBatt :: (String, String) -> IO (B.ByteString, B.ByteString) -readFileBatt (i,s) = - do a <- rf i - b <- rf s - return (a,b) +file2batfile :: String -> (File, File) +file2batfile s = ( (s' ++ "/charge_full", s' ++ "/energy_full") + , (s' ++ "/charge_now" , s' ++ "/energy_now" ) + ) + where s' = "/sys/class/power_supply/" ++ s + +readFileBatt :: (File, File) -> IO (String, String, String) +readFileBatt (f,n) = + do a <- rf f + b <- rf n + ac <- fileExist "/sys/class/power_supply/AC0/online" + c <- if not ac + then return [] + else do s <- B.unpack `fmap` catRead "/sys/class/power_supply/AC0/online" + return $ if s == "1\n" then "<fc=green>On</fc>" else"<fc=red>Off</fc>" + return (a,b,c) where rf file = do - f <- fileExist file - if f then catRead file else return B.empty + fe <- fileExist (fst file) + if fe + then B.unpack `fmap` catRead (fst file) + else do fe' <- fileExist (snd file) + if fe' + then B.unpack `fmap` catRead (snd file) + else return [] -parseBATT :: [(String, String)] -> IO Batt +parseBATT :: [(File,File)] -> IO Batt parseBATT bfs = - do [(a0,b0),(a1,b1),(a2,b2)] <- mapM readFileBatt (take 3 $ bfs ++ repeat ("","")) - let sp p s = case stringParser p s of - [] -> 0 - x -> read x - (f0, p0) = (sp (3,2) a0, sp (2,4) b0) - (f1, p1) = (sp (3,2) a1, sp (2,4) b1) - (f2, p2) = (sp (3,2) a2, sp (2,4) b2) - left = (p0 + p1 + p2) / (f0 + f1 + f2) --present / full - return $ if isNaN left then NA else Batt left + do [(a0,b0,c0),(a1,b1,_),(a2,b2,_)] <- mapM readFileBatt (take 3 $ bfs ++ repeat (("",""),("",""))) + let read' s = if s == [] then 0 else read s + left = (read' b0 + read' b1 + read' b2) / (read' a0 + read' a1 + read' a2) --present / full + return $ if isNaN left then NA else Batt left c0 formatBatt :: Float -> Monitor [String] formatBatt x = showPercentsWithColors [x] @@ -60,6 +70,6 @@ runBatt' :: [String] -> [String] -> Monitor String runBatt' bfs _ = do c <- io $ parseBATT (map file2batfile bfs) case c of - Batt x -> do l <- formatBatt x - parseTemplate l + Batt x s -> do l <- formatBatt x + parseTemplate (l ++ [s]) NA -> return "N/A" |