summaryrefslogtreecommitdiff
path: root/src/Logstat/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Logstat/Types.hs')
-rw-r--r--src/Logstat/Types.hs21
1 files changed, 16 insertions, 5 deletions
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)