summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2017-10-21 09:17:26 +0200
committerYorhel <git@yorhel.nl>2017-10-21 09:17:26 +0200
commit336fc48aca9bfc1e451a2243eb477fcc6225dbd5 (patch)
treef764c77b3feebd8ac73f69effd35d650d80c77c5
parent0a3c7d9ea5bbb0515a5568153cd81d0578116cc0 (diff)
Sprinkle the AST with source locations to improve error messagesHEADmaster
-rw-r--r--src/Logstat/Eval.hs32
-rw-r--r--src/Logstat/Main.hs13
-rw-r--r--src/Logstat/Parse.hs86
-rw-r--r--src/Logstat/Types.hs21
-rw-r--r--src/Logstat/Value.hs2
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