Parsers: code and comment cleanup

darcs-hash:20080429123603-d6583-880ed830d8f9d9be913920a929cb450fde45899e.gz

1 files changed, 46 insertions, 56 deletions

diff --git a/Parsers.hs b/Parsers.hs
index 1a01723..4c9cc8e 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -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