summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-12-02 05:19:22 +0000
committerjao <jao@gnu.org>2018-12-02 05:19:22 +0000
commit453ad68e5b24a6dd3a2aaba8727dc6c5c0bdfc9e (patch)
treebc6d0cf0bdf970aec74f10b0d0f2cf7cac5efcda /src/Xmobar/Plugins/Monitors/Common/Parsers.hs
parent61c9a5a3e86b42958e4e06a79b8156039c926177 (diff)
downloadxmobar-453ad68e5b24a6dd3a2aaba8727dc6c5c0bdfc9e.tar.gz
xmobar-453ad68e5b24a6dd3a2aaba8727dc6c5c0bdfc9e.tar.bz2
Plugins.Monitors.Common refactored into submodules
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Common/Parsers.hs')
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Parsers.hs152
1 files changed, 152 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Common/Parsers.hs b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
new file mode 100644
index 0000000..4b87a10
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
@@ -0,0 +1,152 @@
+------------------------------------------------------------------------------
+-- |
+-- Module: Xmobar.Plugins.Monitors.Parsers
+-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
+-- License: BSD3-style (see LICENSE)
+--
+-- Maintainer: jao@gnu.org
+-- Stability: unstable
+-- Portability: portable
+-- Created: Sun Dec 02, 2018 04:49
+--
+--
+-- Parsing template strings
+--
+------------------------------------------------------------------------------
+
+
+module Xmobar.Plugins.Monitors.Common.Parsers ( runP
+ , skipRestOfLine
+ , getNumbers
+ , getNumbersAsString
+ , getAllBut
+ , getAfterString
+ , skipTillString
+ , parseTemplate
+ , parseTemplate'
+ ) where
+
+import Xmobar.Plugins.Monitors.Common.Types
+
+import Control.Applicative ((<$>))
+import qualified Data.Map as Map
+import Text.ParserCombinators.Parsec
+
+runP :: Parser [a] -> String -> IO [a]
+runP p i =
+ 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
+ ; manyTill anyChar newline
+ } <|> return ""
+
+skipTillString :: String -> Parser String
+skipTillString s =
+ manyTill skipRestOfLine $ string s
+
+-- | Parses the output template string
+templateStringParser :: Parser (String,String,String)
+templateStringParser =
+ do { s <- nonPlaceHolder
+ ; com <- templateCommandParser
+ ; ss <- nonPlaceHolder
+ ; return (s, com, ss)
+ }
+ where
+ nonPlaceHolder = fmap concat . many $
+ many1 (noneOf "<") <|> colorSpec <|> iconSpec
+
+-- | Recognizes color specification and returns it unchanged
+colorSpec :: Parser String
+colorSpec = try (string "</fc>") <|> try (
+ do string "<fc="
+ s <- many1 (alphaNum <|> char ',' <|> char '#')
+ char '>'
+ return $ "<fc=" ++ s ++ ">")
+
+-- | Recognizes icon specification and returns it unchanged
+iconSpec :: Parser String
+iconSpec = try (do string "<icon="
+ i <- manyTill (noneOf ">") (try (string "/>"))
+ return $ "<icon=" ++ i ++ "/>")
+
+-- | Parses the command part of the template string
+templateCommandParser :: Parser String
+templateCommandParser =
+ do { char '<'
+ ; com <- many $ noneOf ">"
+ ; char '>'
+ ; return com
+ }
+
+-- | Combines the template parsers
+templateParser :: Parser [(String,String,String)]
+templateParser = many templateStringParser --"%")
+
+trimTo :: Int -> String -> String -> (Int, String)
+trimTo n p "" = (n, p)
+trimTo n p ('<':cs) = trimTo n p' s
+ where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">"
+ s = drop 1 (dropWhile (/= '>') cs)
+trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s)
+trimTo n p s = let p' = takeWhile (/= '<') s
+ s' = dropWhile (/= '<') s
+ in
+ if length p' <= n
+ then trimTo (n - length p') (p ++ p') s'
+ else trimTo 0 (p ++ take n p') s'
+
+-- | 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, trimmed to MaxTotalWidth if that
+-- configuration value is positive.
+parseTemplate :: [String] -> Monitor String
+parseTemplate l =
+ do t <- getConfigValue template
+ e <- getConfigValue export
+ w <- getConfigValue maxTotalWidth
+ ell <- getConfigValue maxTotalWidthEllipsis
+ let m = Map.fromList . zip e $ l
+ s <- parseTemplate' t m
+ let (n, s') = if w > 0 && length s > w
+ then trimTo (w - length ell) "" s
+ else (1, s)
+ return $ if n > 0 then s' else s' ++ ell
+
+-- | Parses the template given to it with a map of export values and combines
+-- them
+parseTemplate' :: String -> Map.Map String String -> Monitor String
+parseTemplate' t m =
+ do s <- io $ runP templateParser t
+ combine m s
+
+-- | Given a finite "Map" and a parsed template t produces the
+-- | resulting output string as the output of the monitor.
+combine :: Map.Map String String -> [(String, String, String)] -> Monitor String
+combine _ [] = return []
+combine m ((s,ts,ss):xs) =
+ do next <- combine m xs
+ str <- case Map.lookup ts m of
+ Nothing -> return $ "<" ++ ts ++ ">"
+ Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m
+ return $ s ++ str ++ ss ++ next