summaryrefslogtreecommitdiff
path: root/src/Logstat/Types.hs
blob: 2c205ba6b240d3537b2c8d1ae955c59967e16b3e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
module Logstat.Types where

import Text.Megaparsec (SourcePos, sourcePosPretty)
import Data.Map.Strict (Map)
import Data.ByteString (ByteString)
import Logstat.Regex   (Regex)

-- This type may seem inefficient; Surely we're not generating a string AND
-- numeric representation for each and every intermediate value? But rest
-- assured, we're relying on lazy evaluation here.
-- (Which might be just as inefficient, I've not benchmarked anything yet)
data Val = Val ByteString (Maybe Double)

instance Show Val where show (Val b _) = "Val " ++ show b
-- These Eq and Ord instances are only for internal use (e.g. in Data.Map);
-- Function/operator implementations for the config language should compare the
-- string or numeric values directly.
instance Eq Val   where (Val a _) == (Val b _) = a == b
instance Ord Val  where (Val a _) <= (Val b _) = a <= b


data EvalError'
  = UnknownField Field -- This error case can actually be prevented with static analysis
  | NoMatch Field ByteString
  | NoExtract ByteString
  | InvalidNumber ByteString
  | DivByZero
  | Filtered -- Not strictly an error, just a way to signal that this event should be dropped

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
  show (InvalidNumber v) = "Invalid number " ++ show v
  show DivByZero = "Division by zero"
  show Filtered = "Filtered"


type Field = String
type ProcId = String
type FuncId = String


-- Potential optimization: Reassign all String fields to Ints, and use an Array as state.
type Event = Map Field Val
-- Actual event should also have:
--   aggregate - List of states to aggregate over (not efficient to implement it that way, but can be optimized with static analysis)


data Op
    = OEq  | ONeq  | OLt  | OGt  | OLe  | OGe    -- String comparison
    | OIEq | OINeq | OILt | OIGt | OILe | OIGe   -- Integer comparison
    | OConcat                                    -- String operations
    | OPlus | OMinus | OMul | ODiv | OMod | OPow -- Integer operations
    | OAnd | OOr                                 -- Boolean operations
  deriving(Eq,Show)

data SortType = SortAscNum | SortAscBS | SortDescNum | SortDescBS deriving Show

data Expr'
  = EField !Field
  | ELit !Val
  | EOp !Op !Expr !Expr
  | EIf !Expr !Expr !Expr
  | EMatch !Regex !Expr
  | EExtract !Expr !Regex
  | EReplace !Expr !Regex !ByteString
  | ENeg !Expr
  | ENot !Expr
  deriving(Show)

data Stmt'
  = SRegex !Field !Regex ![Maybe Field]
  | SSet !Field !Expr
  | SFilter !Expr
  | SSort !Int !Expr !SortType
  | SGroup ![Field]
  | 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)
  , cfgFiles :: [FilePath]
  } deriving(Show)