diff options
-rw-r--r-- | src/Logstat/Eval.hs | 32 | ||||
-rw-r--r-- | src/Logstat/Main.hs | 13 | ||||
-rw-r--r-- | src/Logstat/Parse.hs | 86 | ||||
-rw-r--r-- | src/Logstat/Types.hs | 21 | ||||
-rw-r--r-- | src/Logstat/Value.hs | 2 |
5 files changed, 92 insertions, 62 deletions
diff --git a/src/Logstat/Eval.hs b/src/Logstat/Eval.hs index 8e29818..d497cbf 100644 --- a/src/Logstat/Eval.hs +++ b/src/Logstat/Eval.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances #-} module Logstat.Eval where +import Text.Megaparsec (SourcePos) import Data.Fixed (mod') import Data.Foldable (foldl',toList) import qualified Data.ByteString as B @@ -38,7 +39,7 @@ instance Ord a => Ord (SortItem a) where (SortItem a _) <= (SortItem b _) = a <= newState :: [Stmt] -> [State] newState = map st where - st s = case s of + st (Loc _ s) = case s of SSort _ _ SortAscNum -> StSortAscNum mempty SSort _ _ SortAscBS -> StSortAscBS mempty SSort _ _ SortDescNum -> StSortDescNum mempty @@ -48,11 +49,16 @@ newState = map st getField :: Event -> Field -> Either EvalError Val -getField st n = maybe (Left (UnknownField n)) return $ Map.lookup n st +getField st n = maybe (Left (Loc Nothing $ UnknownField n)) return $ Map.lookup n st + + +setLoc :: Maybe SourcePos -> Either EvalError a -> Either EvalError a +setLoc pos (Left (Loc Nothing r)) = Left $ Loc pos r +setLoc _ r = r evalExpr :: Expr -> Event -> Either EvalError Val -evalExpr expr ev = case expr of +evalExpr (Loc pos expr) ev = setLoc pos $ case expr of ELit e -> Right e EField f -> getField ev f ENot e -> bool . not . asBool <$> evalExpr e ev @@ -68,7 +74,7 @@ evalExpr expr ev = case expr of EExtract e r -> do v <- asBS <$> evalExpr e ev - ma <- maybe (Left (NoExtract v)) return $ match r v + ma <- maybe (Left (Loc pos $ NoExtract v)) return $ match r v return $ bs $ ma !! 1 EReplace e r n -> @@ -110,7 +116,7 @@ evalExpr expr ev = case expr of -- Division with zero-check idiv f = withab asNum $ \a b -> if b == 0 - then Left DivByZero + then Left $ Loc pos DivByZero else return $ num $ f a b @@ -135,14 +141,14 @@ evalExpr expr ev = case expr of -- the final step. step :: Stmt -> State -> Event -> (State, Either EvalError Event) -step stmt st ev = case stmt of +step (Loc pos stmt) st ev = setLoc pos <$> case stmt of SShow _ -> undefined -- Should be handled by extractShow SSet f e -> (,) st $ evalExpr e ev >>= \v -> return $ Map.insert f v ev - SFilter e -> (,) st $ evalExpr e ev >>= \v -> if asBool v then return ev else Left Filtered + SFilter e -> (,) st $ evalExpr e ev >>= \v -> if asBool v then return ev else Left $ Loc pos Filtered SRegex f r p -> (,) st $ do val <- asBS <$> getField ev f - ma <- maybe (Left (NoMatch f val)) return $ match r val + ma <- maybe (Left (Loc pos $ NoMatch f val)) return $ match r val return $ foldl' ins ev $ zip ma p where ins s (_, Nothing) = s @@ -159,7 +165,7 @@ step stmt st ev = case stmt of run wrap hp f = case evalExpr e ev >>= f of Left err -> (st, Left err) - Right val -> (wrap (ins hp val), Left Filtered) + Right val -> (wrap (ins hp val), Left $ Loc pos Filtered) ins hp val = let si = SortItem val ev in if Heap.size hp < n @@ -174,11 +180,11 @@ step stmt st ev = case stmt of Left err -> (st, Left err) Right v -> let m' = Map.insert v () m - in m' `seq` (StGroup m', Left Filtered) + in m' `seq` (StGroup m', Left $ Loc pos Filtered) final :: Stmt -> State -> [Event] -final stmt st = case stmt of +final (Loc _ stmt) st = case stmt of SSort _ _ _ -> case st of StSortAscNum hp -> f hp @@ -221,5 +227,5 @@ finalL = loop let (st', r) = f st ev (st'', evs') = steps f st' evs in (,) st'' $ case r of - Left Filtered -> evs' - _ -> r : evs' + Left (Loc _ Filtered) -> evs' + _ -> r : evs' diff --git a/src/Logstat/Main.hs b/src/Logstat/Main.hs index d4c72e4..96c69ba 100644 --- a/src/Logstat/Main.hs +++ b/src/Logstat/Main.hs @@ -25,10 +25,10 @@ import Logstat.Eval extractShow :: [Stmt] -> Either String ([Expr], [Stmt]) extractShow proc = f [] ["msg"] proc where - f l v [] = Right (map EField v, reverse l) - f l _ ((SShow e):[]) = Right (e, reverse l) - f _ _ ((SShow _):_) = Left $ "Error: 'show' must not be followed by other statements" -- TODO: CONTEXT! - f l _ (x@(SGroup v):xs) = f (x:l) v xs + f l v [] = Right (map (\v' -> Loc Nothing (EField v')) v, reverse l) + f l _ ((Loc _ (SShow e)):[]) = Right (e, reverse l) + f _ _ ((Loc pos (SShow _)):_) = Left $ "Error: show at " ++ show pos ++ " must not be followed by other statements" + f l _ (x@(Loc _ (SGroup v)):xs) = f (x:l) v xs f l v (x:xs) = f (x:l) v xs @@ -47,7 +47,7 @@ run st sh stp fnl = loop st eval ev = case mapM (\f -> f ev) sh of - Left e -> hPutStrLn stderr $ show e ++ " in show statement" + Left e -> hPutStrLn stderr $ show e Right v -> C.putStrLn $ B.intercalate ", " $ map asBS v line state = do @@ -55,8 +55,7 @@ run st sh stp fnl = loop st let event = Map.fromList [("msg", bs l)] (state', r) = stp state event case r of - Left Filtered -> return () - -- TODO: Add more error context, especially the file+line of the statement that triggered the error + Left (Loc _ Filtered) -> return () Left e -> hPutStrLn stderr $ show e ++ " with input: " ++ show l Right v -> eval v return state' diff --git a/src/Logstat/Parse.hs b/src/Logstat/Parse.hs index 041e8fd..725f2cf 100644 --- a/src/Logstat/Parse.hs +++ b/src/Logstat/Parse.hs @@ -30,7 +30,7 @@ import Logstat.Value emapM :: Monad m => (Expr -> m Expr) -> Expr -> m Expr -emapM f e = f e >>= \e' -> case e' of +emapM f e = f e >>= \(Loc pos e') -> Loc pos <$> case e' of EOp o a b -> EOp o <$> emapM f a <*> emapM f b EIf a b c -> EIf <$> emapM f a <*> emapM f b <*> emapM f c EMatch a b -> EMatch a <$> emapM f b @@ -102,41 +102,53 @@ reg defopt = do -- wrong order. Right r -> return (study r) + +loc :: Monad m => Parser m a -> Parser m (Loc a) +loc f = getPosition >>= \pos -> Loc (Just pos) <$> f + + expr :: Monad m => Parser m Expr expr = label "expression" $ makeExprParser term - [ [ InfixR (EOp OPow <$ symbol "**") ] - , [ Prefix (foldr1 (.) <$> some (ENot <$ (symbol "!"))) - , Prefix (ENeg <$ symbol "-" ) ] - , [ InfixL (EOp OMul <$ (lexeme $ try $ char '*' <* notFollowedBy (char '*'))) - , InfixL (EOp ODiv <$ symbol "/" ) - , InfixL (EOp OMod <$ symbol "%" ) ] - , [ InfixL (EOp OPlus <$ symbol "+" ) - , InfixL (EOp OMinus <$ symbol "-" ) - , InfixL (EOp OConcat <$ symbol "." ) ] - , [ InfixN (EOp OLt <$ symbol "lt") - , InfixN (EOp OGt <$ symbol "gt") - , InfixN (EOp OLe <$ symbol "le") - , InfixN (EOp OGe <$ symbol "ge") - , InfixN (EOp OILt <$ (lexeme $ try $ char '<' <* notFollowedBy (char '='))) - , InfixN (EOp OIGt <$ (lexeme $ try $ char '>' <* notFollowedBy (char '='))) - , InfixN (EOp OILe <$ symbol "<=") - , InfixN (EOp OIGe <$ symbol ">=") ] - , [ InfixN (EOp OEq <$ symbol "eq") - , InfixN (EOp ONeq <$ symbol "ne") - , InfixN (EOp OIEq <$ symbol "==") - , InfixN (EOp OINeq <$ symbol "!=") - , Postfix(EMatch <$> (symbol "~" >> reg [no_auto_capture])) - , Postfix((\a b -> ENot (EMatch a b)) <$> (symbol "!~" >> reg [no_auto_capture])) ] - , [ InfixL (EOp OAnd <$ symbol "&&") ] - , [ InfixL (EOp OOr <$ symbol "||") ] - , [ InfixR (try $ between (symbol "?") (symbol ":") expr >>= \m -> return $ (\l r -> EIf l m r)) ] + [ [ InfixR $ bin (EOp OPow) $ symbol "**" ] + , [ Prefix enot + , Prefix $ un ENeg $ symbol "-" ] + , [ InfixL $ bin (EOp OMul ) $ (lexeme $ try $ char '*' <* notFollowedBy (char '*')) + , InfixL $ bin (EOp ODiv ) $ symbol "/" + , InfixL $ bin (EOp OMod ) $ symbol "%" ] + , [ InfixL $ bin (EOp OPlus ) $ symbol "+" + , InfixL $ bin (EOp OMinus ) $ symbol "-" + , InfixL $ bin (EOp OConcat) $ symbol "." ] + , [ InfixN $ bin (EOp OLt ) $ symbol "lt" + , InfixN $ bin (EOp OGt ) $ symbol "gt" + , InfixN $ bin (EOp OLe ) $ symbol "le" + , InfixN $ bin (EOp OGe ) $ symbol "ge" + , InfixN $ bin (EOp OILt ) $ (lexeme $ try $ char '<' <* notFollowedBy (char '=')) + , InfixN $ bin (EOp OIGt ) $ (lexeme $ try $ char '>' <* notFollowedBy (char '=')) + , InfixN $ bin (EOp OILe ) $ symbol "<=" + , InfixN $ bin (EOp OIGe ) $ symbol ">=" ] + , [ InfixN $ bin (EOp OEq ) $ symbol "eq" + , InfixN $ bin (EOp ONeq ) $ symbol "ne" + , InfixN $ bin (EOp OIEq ) $ symbol "==" + , InfixN $ bin (EOp OINeq ) $ symbol "!=" + , Postfix ematch + , Postfix enmatch ] + , [ InfixL $ bin (EOp OAnd ) $ symbol "&&" ] + , [ InfixL $ bin (EOp OOr ) $ symbol "||" ] + , [ InfixR eif ] ] where - - term = (try (do { n <- identifier; symbol "("; return n}) >>= func) - <|> EField <$> identifier - <|> ELit . bs <$> str - <|> ELit . num <$> number + bin f p = loc p >>= \(Loc pos _) -> return (\a b -> Loc pos (f a b)) + un f p = loc p >>= \(Loc pos _) -> return (\a -> Loc pos (f a )) + + enot = (some $ loc $ symbol "!") >>= \l -> return $ foldr1 (.) $ map (\(Loc pos _) -> \a -> Loc pos (ENot a)) l + ematch = loc (symbol "~" >> reg [no_auto_capture]) >>= \(Loc pos r) -> return (\a -> Loc pos $ EMatch r a) + enmatch = loc (symbol "!~" >> reg [no_auto_capture]) >>= \(Loc pos r) -> return (\a -> Loc pos $ ENot $ Loc pos $ EMatch r a) + eif = (try $ loc $ between (symbol "?") (symbol ":") expr) >>= \(Loc pos m) -> return (\l r -> Loc pos $ EIf l m r) + + term = loc (try (do { n <- identifier; symbol "("; return n}) >>= func) + <|> loc (EField <$> identifier) + <|> loc (ELit . bs <$> str) + <|> loc (ELit . num <$> number) <|> between (symbol "(") (symbol ")") expr number = lexeme $ try L.float @@ -173,10 +185,12 @@ expr = label "expression" $ makeExprParser term symbol ")" when (length a /= length args) $ fail $ "Function " ++ n ++ " expects " ++ show (length args) ++ " arguments, but " ++ show (length a) ++ " were given" - return $ fillargs e $ zip args a + -- XXX: Throwing away the original location here is ugly. + let Loc _ r = fillargs e $ zip args a + return r fillargs e a = - let f (EField x) = maybe undefined id $ lookup x a + let f (Loc _ (EField x)) = maybe undefined id $ lookup x a f x = x in emap f e @@ -185,7 +199,7 @@ expr = label "expression" $ makeExprParser term stmts :: Monad m => Parser m a -> Parser m [Stmt] stmts end = concat <$> sepEndBy1 stmt (symbol ";") <* end where - stmt = stmtUse <|> (:[]) <$> (stmtFilter <|> stmtShow <|> stmtGroup <|> stmtRegex <|> stmtSet <|> stmtSort) + stmt = stmtUse <|> (:[]) <$> loc (stmtFilter <|> stmtShow <|> stmtGroup <|> stmtRegex <|> stmtSet <|> stmtSort) stmtUse = do symbol "use" @@ -299,7 +313,7 @@ parseFileIO cfg' fn' = do -- Make sure that the expression can only refer to variables declared in the function definition _ <- emapM (\fe -> do case fe of - EField fn -> when (notElem fn a) $ fail $ "Unknown variable " ++ fn + Loc _ (EField fn) -> when (notElem fn a) $ fail $ "Unknown variable " ++ fn _ -> return () return fe) e diff --git a/src/Logstat/Types.hs b/src/Logstat/Types.hs index fe2740f..2c205ba 100644 --- a/src/Logstat/Types.hs +++ b/src/Logstat/Types.hs @@ -1,5 +1,6 @@ module Logstat.Types where +import Text.Megaparsec (SourcePos, sourcePosPretty) import Data.Map.Strict (Map) import Data.ByteString (ByteString) import Logstat.Regex (Regex) @@ -18,7 +19,7 @@ instance Eq Val where (Val a _) == (Val b _) = a == b instance Ord Val where (Val a _) <= (Val b _) = a <= b -data EvalError +data EvalError' = UnknownField Field -- This error case can actually be prevented with static analysis | NoMatch Field ByteString | NoExtract ByteString @@ -26,7 +27,7 @@ data EvalError | DivByZero | Filtered -- Not strictly an error, just a way to signal that this event should be dropped -instance Show EvalError where +instance Show EvalError' where show (UnknownField n) = "Unknown variable '" ++ n ++ "'" show (NoMatch f v) = "Regex on field " ++ f ++ " failed to match " ++ show v show (NoExtract v) = "Regex in extract() failed to match " ++ show v @@ -35,7 +36,6 @@ instance Show EvalError where show Filtered = "Filtered" - type Field = String type ProcId = String type FuncId = String @@ -57,7 +57,7 @@ data Op data SortType = SortAscNum | SortAscBS | SortDescNum | SortDescBS deriving Show -data Expr +data Expr' = EField !Field | ELit !Val | EOp !Op !Expr !Expr @@ -69,7 +69,7 @@ data Expr | ENot !Expr deriving(Show) -data Stmt +data Stmt' = SRegex !Field !Regex ![Maybe Field] | SSet !Field !Expr | SFilter !Expr @@ -78,6 +78,17 @@ data Stmt | SShow ![Expr] deriving(Show) + +data Loc a = Loc (Maybe SourcePos) a + +instance Show a => Show (Loc a) where + show (Loc (Just pos) x) = show x ++ " at " ++ sourcePosPretty pos + show (Loc Nothing x) = show x + +type Expr = Loc Expr' +type Stmt = Loc Stmt' +type EvalError = Loc EvalError' + data Config = Config { cfgProcs :: Map ProcId [Stmt] , cfgFuncs :: Map FuncId ([Field], Expr) diff --git a/src/Logstat/Value.hs b/src/Logstat/Value.hs index 1d81d47..ec505d3 100644 --- a/src/Logstat/Value.hs +++ b/src/Logstat/Value.hs @@ -16,7 +16,7 @@ asBS :: Val -> B.ByteString asBS (Val b _) = b asNum :: MonadError EvalError m => Val -> m Double -asNum (Val b n) = maybe (throwError $ InvalidNumber b) return n +asNum (Val b n) = maybe (throwError $ Loc Nothing $ InvalidNumber b) return n -- Constructors are strict in their arguments bool :: Bool -> Val |