diff options
| -rw-r--r-- | Parsers.hs | 102 |
1 files changed, 46 insertions, 56 deletions
@@ -12,18 +12,16 @@ -- ----------------------------------------------------------------------------- -module Parsers ( - -- * Parsing - -- $parser - parseString - , stringParser - , defaultColors - , colorsAndText - , templateStringParser - , templateCommandParser - , templateParser - , parseTemplate - ) where +module Parsers + ( parseString + , stringParser + , colorParser + , colorsAndText + , templateStringParser + , templateCommandParser + , templateParser + , parseTemplate + ) where import Config import Commands @@ -31,28 +29,20 @@ import Runnable import Text.ParserCombinators.Parsec import qualified Data.Map as Map - -{- $parser -These are the neede parsers. Don't trust them too much. - -There are parsers for the commands output and parsers for the -formatting template. - -} - --- | Runs the actual string parsers +-- | Runs the string parser parseString :: Config -> String -> IO [(String, String)] parseString c s = - case (parse (stringParser c) "" s) of + case parse (stringParser c) "" s of Left _ -> return [("Could not parse string: " ++ s, fgColor c)] Right x -> return (concat x) -- | Gets the string and combines the needed parsers stringParser :: Config -> Parser [[(String, String)]] -stringParser c = manyTill (defaultColors c) eof +stringParser = flip manyTill eof . colorParser -- | Parses a string with the default color (no color set) -defaultColors :: Config -> Parser [(String, String)] -defaultColors c = do +colorParser :: Config -> Parser [(String, String)] +colorParser c = do s <- manyTill anyChar (tryString "<fc" <|> endOfLine "") n <- colorsAndText <|> endOfLine ("","") return [(s,fgColor c),n] @@ -60,58 +50,58 @@ defaultColors c = do -- | Parses a string with a color set colorsAndText :: Parser (String, String) colorsAndText = do - string "=" - c <- colorSpec - string ">" + c <- inside (string "=") colors (string ">") s <- manyTill anyChar (tryString "</fc>") return (s,c) -endOfLine :: a -> Parser a -endOfLine r = eof >> return r - -tryString :: String -> Parser String -tryString = try . string - -- | Parses a color specification (hex or named) -colorSpec :: Parser String -colorSpec = many1 (alphaNum <|> char ',' <|> char '#') +colors :: Parser String +colors = many1 (alphaNum <|> char ',' <|> char '#') -- | Parses the output template string templateStringParser :: Config -> Parser (String,String,String) templateStringParser c = do - s <- many $ noneOf (sepChar c) - (com,_,_) <- templateCommandParser c - ss <- many $ noneOf (sepChar c) + 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,String,String) -templateCommandParser c = do - let chr = head $ sepChar c - char chr - com <- many $ noneOf (sepChar c) - char chr - return $ (com,"","") +templateCommandParser :: Config -> Parser String +templateCommandParser c = + let chr = char . head . sepChar + in inside (chr c) (allTillSep c) (chr c) -- | Combines the template parsers templateParser :: Config -> Parser [(String,String,String)] -templateParser c = many (templateStringParser c) +templateParser = many . templateStringParser -- | Actually runs the template parsers parseTemplate :: Config -> String -> IO [(Runnable,String,String)] -parseTemplate config s = - do str <- case (parse (templateParser config) "" s) of +parseTemplate c s = + do str <- case (parse (templateParser c) "" s) of Left _ -> return [("","","")] Right x -> return x - let comList = map alias (commands config) - m = Map.fromList $ zip comList (commands config) - return $ combine config m str + 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 templatet produces the -- | resulting output string. combine :: Config -> Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)] combine _ _ [] = [] -combine config m ((ts,s,ss):xs) = - [(com, s, ss)] ++ combine config m xs - where com = Map.findWithDefault dflt ts m - dflt = Run $ Com ts [] [] 10 +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 + +endOfLine :: a -> Parser a +endOfLine r = eof >> return r + +tryString :: String -> Parser String +tryString = try . string + +allTillSep :: Config -> Parser String +allTillSep = many . noneOf . sepChar + +inside :: Parser a -> Parser b -> Parser c -> Parser b +inside pa pb pc = pa >> pb >>= \r -> pc >> return r |