From 9d2c98871bbd04c585fae034072f934b5c3e8093 Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 25 Nov 2018 06:13:29 +0000 Subject: Parsers wee refactoring --- src/lib/Xmobar.hs | 4 +- src/lib/Xmobar/Parsers.hs | 193 ---------------------------------------- src/lib/Xmobar/Template.hs | 65 ++++++++++++++ src/lib/Xmobar/X11/Bitmap.hs | 2 +- src/lib/Xmobar/X11/Draw.hs | 2 +- src/lib/Xmobar/X11/EventLoop.hs | 4 +- src/lib/Xmobar/X11/Parsers.hs | 146 ++++++++++++++++++++++++++++++ src/lib/Xmobar/X11/Types.hs | 2 +- 8 files changed, 218 insertions(+), 200 deletions(-) delete mode 100644 src/lib/Xmobar/Parsers.hs create mode 100644 src/lib/Xmobar/Template.hs create mode 100644 src/lib/Xmobar/X11/Parsers.hs (limited to 'src/lib') diff --git a/src/lib/Xmobar.hs b/src/lib/Xmobar.hs index ecc664a..897d671 100644 --- a/src/lib/Xmobar.hs +++ b/src/lib/Xmobar.hs @@ -46,7 +46,7 @@ import Control.Exception (bracket) import Xmobar.Config import Xmobar.Runnable -import Xmobar.Parsers +import Xmobar.Template import Xmobar.System.Signal (setupSignalHandler, withDeferSignals) import Xmobar.X11.Types import Xmobar.X11.EventLoop (startLoop, startCommand) @@ -89,7 +89,7 @@ xmobar conf = withDeferSignals $ do d <- openDisplay "" fs <- initFont d (font conf) fl <- mapM (initFont d) (additionalFonts conf) - cls <- mapM (parseTemplate conf) (splitTemplate conf) + cls <- mapM (parseCommands conf) (splitTemplate conf) sig <- setupSignalHandler bracket (mapM (mapM $ startCommand sig) cls) cleanupThreads diff --git a/src/lib/Xmobar/Parsers.hs b/src/lib/Xmobar/Parsers.hs deleted file mode 100644 index d8bd409..0000000 --- a/src/lib/Xmobar/Parsers.hs +++ /dev/null @@ -1,193 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Parsers --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- Parsers needed for Xmobar, a text based status bar --- ------------------------------------------------------------------------------ - -module Xmobar.Parsers - ( parseString - , parseTemplate - , Widget(..) - ) where - -import Xmobar.Config -import Xmobar.Runnable -import Xmobar.Commands -import Xmobar.Actions - -import Control.Monad (guard, mzero) -import qualified Data.Map as Map -import Text.ParserCombinators.Parsec -import Graphics.X11.Types (Button) - -data Widget = Icon String | Text String - -type ColorString = String -type FontIndex = Int - --- | Runs the string parser -parseString :: Config -> String - -> IO [(Widget, ColorString, FontIndex, Maybe [Action])] -parseString c s = - case parse (stringParser (fgColor c) 0 Nothing) "" s of - Left _ -> return [(Text $ "Could not parse string: " ++ s - , fgColor c - , 0 - , Nothing)] - Right x -> return (concat x) - -allParsers :: ColorString - -> FontIndex - -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -allParsers c f a = textParser c f a - <|> try (iconParser c f a) - <|> try (rawParser c f a) - <|> try (actionParser c f a) - <|> try (fontParser c a) - <|> colorParser f a - --- | Gets the string and combines the needed parsers -stringParser :: String -> FontIndex -> Maybe [Action] - -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]] -stringParser c f a = manyTill (allParsers c f a) eof - --- | Parses a maximal string without color markup. -textParser :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -textParser c f a = do s <- many1 $ - noneOf "<" <|> - try (notFollowedBy' (char '<') - (try (string "fc=") <|> - try (string "fn=") <|> - try (string "action=") <|> - try (string "/action>") <|> - try (string "icon=") <|> - try (string "raw=") <|> - try (string "/fn>") <|> - string "/fc>")) - return [(Text s, c, f, a)] - --- | Parse a "raw" tag, which we use to prevent other tags from creeping in. --- The format here is net-string-esque: a literal "". -rawParser :: ColorString - -> FontIndex - -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -rawParser c f a = do - string " do - guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) - s <- count (fromIntegral len) anyChar - string "/>" - return [(Text s, c, f, a)] - _ -> mzero - --- | Wrapper for notFollowedBy that returns the result of the first parser. --- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy --- accepts only parsers with return type Char. -notFollowedBy' :: Parser a -> Parser b -> Parser a -notFollowedBy' p e = do x <- p - notFollowedBy $ try (e >> return '*') - return x - -iconParser :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -iconParser c f a = do - string "") (try (string "/>")) - return [(Icon i, c, f, a)] - -actionParser :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -actionParser c f act = do - string "")] - buttons <- (char '>' >> return "1") <|> (space >> spaces >> - between (string "button=") (string ">") (many1 (oneOf "12345"))) - let a = Spawn (toButtons buttons) command - a' = case act of - Nothing -> Just [a] - Just act' -> Just $ a : act' - s <- manyTill (allParsers c f a') (try $ string "") - return (concat s) - -toButtons :: String -> [Button] -toButtons = map (\x -> read [x]) - --- | Parsers a string wrapped in a color specification. -colorParser :: FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -colorParser f a = do - c <- between (string "") colors - s <- manyTill (allParsers c f a) (try $ string "") - return (concat s) - --- | Parsers a string wrapped in a font specification. -fontParser :: ColorString -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -fontParser c a = do - f <- between (string "") colors - s <- manyTill (allParsers c (read f) a) (try $ string "") - return (concat s) - --- | Parses a color specification (hex or named) -colors :: Parser String -colors = many1 (alphaNum <|> char ',' <|> char '#') - --- | Parses the output template string -templateStringParser :: Config -> Parser (String,String,String) -templateStringParser c = do - s <- allTillSep c - com <- templateCommandParser c - ss <- allTillSep c - return (com, s, ss) - --- | Parses the command part of the template string -templateCommandParser :: Config -> Parser String -templateCommandParser c = - let chr = char . head . sepChar - in between (chr c) (chr c) (allTillSep c) - --- | Combines the template parsers -templateParser :: Config -> Parser [(String,String,String)] -templateParser = many . templateStringParser - --- | Actually runs the template parsers -parseTemplate :: Config -> String -> IO [(Runnable,String,String)] -parseTemplate c s = - do str <- case parse (templateParser c) "" s of - Left _ -> return [("", s, "")] - Right x -> return x - let cl = map alias (commands c) - m = Map.fromList $ zip cl (commands c) - return $ combine c m str - --- | Given a finite "Map" and a parsed template produce the resulting --- output string. -combine :: Config -> Map.Map String Runnable - -> [(String, String, String)] -> [(Runnable,String,String)] -combine _ _ [] = [] -combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs - where com = Map.findWithDefault dflt ts m - dflt = Run $ Com ts [] [] 10 - -allTillSep :: Config -> Parser String -allTillSep = many . noneOf . sepChar diff --git a/src/lib/Xmobar/Template.hs b/src/lib/Xmobar/Template.hs new file mode 100644 index 0000000..bd4852a --- /dev/null +++ b/src/lib/Xmobar/Template.hs @@ -0,0 +1,65 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Template +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Nov 25, 2018 05:49 +-- +-- +-- Handling the top-level output template +-- +------------------------------------------------------------------------------ + + +module Xmobar.Template(parseCommands) where + +import qualified Data.Map as Map +import Text.ParserCombinators.Parsec + +import Xmobar.Commands +import Xmobar.Config +import Xmobar.Runnable + +-- | Parses the output template string +templateStringParser :: Config -> Parser (String,String,String) +templateStringParser c = do + s <- allTillSep c + com <- templateCommandParser c + ss <- allTillSep c + return (com, s, ss) + +-- | Parses the command part of the template string +templateCommandParser :: Config -> Parser String +templateCommandParser c = + let chr = char . head . sepChar + in between (chr c) (chr c) (allTillSep c) + +-- | Combines the template parsers +templateParser :: Config -> Parser [(String,String,String)] +templateParser = many . templateStringParser + +-- | Actually runs the template parsers +parseCommands :: Config -> String -> IO [(Runnable,String,String)] +parseCommands c s = + do str <- case parse (templateParser c) "" s of + Left _ -> return [("", s, "")] + Right x -> return x + let cl = map alias (commands c) + m = Map.fromList $ zip cl (commands c) + return $ combine c m str + +-- | Given a finite "Map" and a parsed template produce the resulting +-- output string. +combine :: Config -> Map.Map String Runnable + -> [(String, String, String)] -> [(Runnable,String,String)] +combine _ _ [] = [] +combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs + where com = Map.findWithDefault dflt ts m + dflt = Run $ Com ts [] [] 10 + +allTillSep :: Config -> Parser String +allTillSep = many . noneOf . sepChar diff --git a/src/lib/Xmobar/X11/Bitmap.hs b/src/lib/Xmobar/X11/Bitmap.hs index dee3966..c0dba14 100644 --- a/src/lib/Xmobar/X11/Bitmap.hs +++ b/src/lib/Xmobar/X11/Bitmap.hs @@ -24,7 +24,7 @@ import System.Directory (doesFileExist) import System.FilePath (()) import System.Mem.Weak ( addFinalizer ) import Xmobar.X11.ColorCache -import Xmobar.Parsers (Widget(..)) +import Xmobar.X11.Parsers (Widget(..)) import Xmobar.Actions (Action) #ifdef XPM diff --git a/src/lib/Xmobar/X11/Draw.hs b/src/lib/Xmobar/X11/Draw.hs index 3fe6f5c..d0c78a8 100644 --- a/src/lib/Xmobar/X11/Draw.hs +++ b/src/lib/Xmobar/X11/Draw.hs @@ -29,7 +29,6 @@ import Data.Map hiding (foldr, map, filter) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras -import Xmobar.Parsers (Widget(..)) import Xmobar.Actions (Action(..)) import qualified Xmobar.X11.Bitmap as B import Xmobar.X11.Types @@ -37,6 +36,7 @@ import Xmobar.X11.XUtil import Xmobar.Config import Xmobar.X11.ColorCache import Xmobar.X11.Window (drawBorder) +import Xmobar.X11.Parsers (Widget(..)) #ifdef XFT import Xmobar.X11.MinXft diff --git a/src/lib/Xmobar/X11/EventLoop.hs b/src/lib/Xmobar/X11/EventLoop.hs index 231d953..cc08acd 100644 --- a/src/lib/Xmobar/X11/EventLoop.hs +++ b/src/lib/Xmobar/X11/EventLoop.hs @@ -37,14 +37,14 @@ import Data.Map hiding (foldr, map, filter) import Data.Maybe (fromJust, isJust) import Xmobar.Config -import Xmobar.Parsers import Xmobar.Commands import Xmobar.Actions import Xmobar.Runnable +import Xmobar.Utils import Xmobar.System.Signal +import Xmobar.X11.Parsers import Xmobar.X11.Window import Xmobar.X11.XUtil -import Xmobar.Utils import Xmobar.X11.Draw import Xmobar.X11.Bitmap as Bitmap import Xmobar.X11.Types diff --git a/src/lib/Xmobar/X11/Parsers.hs b/src/lib/Xmobar/X11/Parsers.hs new file mode 100644 index 0000000..8c1abac --- /dev/null +++ b/src/lib/Xmobar/X11/Parsers.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Xmobar.Parsers +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Parsing for template substrings +-- +----------------------------------------------------------------------------- + +module Xmobar.X11.Parsers (parseString, Widget(..)) where + +import Xmobar.Config +import Xmobar.Actions + +import Control.Monad (guard, mzero) +import Text.ParserCombinators.Parsec +import Graphics.X11.Types (Button) + +data Widget = Icon String | Text String + +type ColorString = String +type FontIndex = Int + +-- | Runs the string parser +parseString :: Config -> String + -> IO [(Widget, ColorString, FontIndex, Maybe [Action])] +parseString c s = + case parse (stringParser (fgColor c) 0 Nothing) "" s of + Left _ -> return [(Text $ "Could not parse string: " ++ s + , fgColor c + , 0 + , Nothing)] + Right x -> return (concat x) + +allParsers :: ColorString + -> FontIndex + -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +allParsers c f a = textParser c f a + <|> try (iconParser c f a) + <|> try (rawParser c f a) + <|> try (actionParser c f a) + <|> try (fontParser c a) + <|> colorParser f a + +-- | Gets the string and combines the needed parsers +stringParser :: String -> FontIndex -> Maybe [Action] + -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]] +stringParser c f a = manyTill (allParsers c f a) eof + +-- | Parses a maximal string without color markup. +textParser :: String -> FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +textParser c f a = do s <- many1 $ + noneOf "<" <|> + try (notFollowedBy' (char '<') + (try (string "fc=") <|> + try (string "fn=") <|> + try (string "action=") <|> + try (string "/action>") <|> + try (string "icon=") <|> + try (string "raw=") <|> + try (string "/fn>") <|> + string "/fc>")) + return [(Text s, c, f, a)] + +-- | Parse a "raw" tag, which we use to prevent other tags from creeping in. +-- The format here is net-string-esque: a literal "". +rawParser :: ColorString + -> FontIndex + -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +rawParser c f a = do + string " do + guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) + s <- count (fromIntegral len) anyChar + string "/>" + return [(Text s, c, f, a)] + _ -> mzero + +-- | Wrapper for notFollowedBy that returns the result of the first parser. +-- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy +-- accepts only parsers with return type Char. +notFollowedBy' :: Parser a -> Parser b -> Parser a +notFollowedBy' p e = do x <- p + notFollowedBy $ try (e >> return '*') + return x + +iconParser :: String -> FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +iconParser c f a = do + string "") (try (string "/>")) + return [(Icon i, c, f, a)] + +actionParser :: String -> FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +actionParser c f act = do + string "")] + buttons <- (char '>' >> return "1") <|> (space >> spaces >> + between (string "button=") (string ">") (many1 (oneOf "12345"))) + let a = Spawn (toButtons buttons) command + a' = case act of + Nothing -> Just [a] + Just act' -> Just $ a : act' + s <- manyTill (allParsers c f a') (try $ string "") + return (concat s) + +toButtons :: String -> [Button] +toButtons = map (\x -> read [x]) + +-- | Parsers a string wrapped in a color specification. +colorParser :: FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +colorParser f a = do + c <- between (string "") colors + s <- manyTill (allParsers c f a) (try $ string "") + return (concat s) + +-- | Parsers a string wrapped in a font specification. +fontParser :: ColorString -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +fontParser c a = do + f <- between (string "") colors + s <- manyTill (allParsers c (read f) a) (try $ string "") + return (concat s) + +-- | Parses a color specification (hex or named) +colors :: Parser String +colors = many1 (alphaNum <|> char ',' <|> char '#') diff --git a/src/lib/Xmobar/X11/Types.hs b/src/lib/Xmobar/X11/Types.hs index 77249b3..c5c7ade 100644 --- a/src/lib/Xmobar/X11/Types.hs +++ b/src/lib/Xmobar/X11/Types.hs @@ -15,7 +15,7 @@ ------------------------------------------------------------------------------ -module Xmobar.X11.Types (X , XConf (..)) where +module Xmobar.X11.Types (X, XConf (..)) where import Graphics.X11.Xlib import Control.Monad.Reader -- cgit v1.2.3