diff options
| -rw-r--r-- | Main.hs | 7 | ||||
| -rw-r--r-- | Parsers.hs | 64 | ||||
| -rw-r--r-- | xmobar.cabal | 2 | 
3 files changed, 66 insertions, 7 deletions
| @@ -64,11 +64,8 @@ readConfig :: FilePath -> IO Config  readConfig f = do    file <- fileExist f    s    <- if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage -  case reads s of -    [(conf,_)] -> return conf -    []         -> error $ f ++ ": configuration file contains errors!\n" ++ usage -    _          -> error ("Some problem occured. Aborting...") - +  either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err) +         return $ parseConfig s  -- | Read default configuration file or load the default config  readDefaultConfig :: IO Config  readDefaultConfig = do @@ -15,14 +15,22 @@  module Parsers      ( parseString      , parseTemplate +    , parseConfig      ) where  import Config  import Commands  import Runnable -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec hiding ((<|>)) +import qualified Text.ParserCombinators.Parsec as Parsec  import qualified Data.Map as Map +import Data.Foldable (sequenceA_) +import Data.List (find,inits,tails) +import Control.Applicative.Permutation(optAtom, runPermsSep) +import Control.Monad(Monad(return), mapM_, ap) +import Control.Applicative hiding (many) +  -- | Runs the string parser  parseString :: Config -> String -> IO [(String, String)]  parseString c s = @@ -99,3 +107,57 @@ combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs  allTillSep :: Config -> Parser String  allTillSep = many . noneOf . sepChar + +instance Applicative (GenParser tok st) where +    pure = return +    (<*>) = ap + +instance Alternative (GenParser tok st) where +    (<|>) x y = (Parsec.<|>) (try x) y +    empty = pzero + +readsToParsec :: Read b => CharParser st b +readsToParsec = do +    pos0 <- getPosition +    input <- getInput +    case reads input of +        (result,rest):_ -> do +            sequenceA_ $ do +                  ls <- fmap (lines . fst) . find ((==rest) . snd) +                            $ zip (inits input) (tails input) +                  lastLine <- safeLast ls +                  return $ setPosition +                      . flip setSourceColumn (length lastLine) +                      . flip incSourceLine (length ls - 1) $ pos0 +            setInput rest +            return result +        _ -> setInput input >> fail "readsToParsec failed" + +safeLast :: [a] -> Maybe a +safeLast [] = Nothing +safeLast xs = Just (last xs) + +-- | Parse the config +parseConfig :: String -> Either ParseError Config +parseConfig = flip parse "Config" $ sepEndSpaces ["Config","{"] +                                    *> perms<* wrapSkip (string "}") +    where +      perms = runPermsSep (wrapSkip $ string ",") $ Config +        <$> withDef font         (strField "font") +        <*> withDef bgColor      (strField "bgColor") +        <*> withDef fgColor      (strField "fgColor") +        <*> withDef position     (field "position" readsToParsec) +        <*> withDef lowerOnStart (field "lowerOnStart" parseEnum) +        <*> withDef commands     (field "commands" readsToParsec) +        <*> withDef sepChar      (strField "sepChar") +        <*> withDef alignSep     (strField "alignSep") +        <*> withDef template     (strField "template") + +      wrapSkip x = many space *> x <* many space +      sepEndSpaces = mapM_ (\s -> string s <* many space) +      withDef f = optAtom (f defaultConfig) + +      parseEnum = choice $ map (\x -> x <$ string (show x)) [minBound .. maxBound] + +      strField name = field name $ between (char '"') (char '"') (many1 . satisfy $ (/= '"')) +      field name cont = sepEndSpaces [name,"="] *> cont diff --git a/xmobar.cabal b/xmobar.cabal index 5298e30..034f0d2 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -54,4 +54,4 @@ executable xmobar          build-depends: hinotify          cpp-options: -DINOTIFY -    build-depends:      X11>=1.3.0, mtl, unix, parsec, filepath, stm +    build-depends:      X11>=1.3.0, mtl, unix, parsec, filepath, stm, action-permutations==0.0.0.0 | 
