summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Parsers.hs78
-rw-r--r--Plugins/Monitors/Batt.hs56
2 files changed, 84 insertions, 50 deletions
diff --git a/Parsers.hs b/Parsers.hs
index 80ad602..88b25f1 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -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"