path: root/Logstat/Eval.hs

{-# LANGUAGE OverloadedStrings, FlexibleContexts, FlexibleInstances #-}
module Logstat.Eval where

import Control.Monad.Except
import Control.Monad.State.Strict
import Data.Fixed (mod')
import Data.Foldable (foldl',toList)
import Data.Maybe (catMaybes)
import qualified Data.ByteString as B
import qualified Data.Heap       as Heap
import qualified Data.Map.Strict as Map

import Logstat.Types
import Logstat.Value
import Logstat.Regex


except :: MonadError e m => Either e a -> m a
except (Left e) = throwError e
except (Right e) = return e


-- Monad in which computations run. State is remembered in case of exception;
-- An exception only indicates an error for a single event and does not prevent
-- processing of future events.
type Comp a = ExceptT EvalError (State a)


getField :: MonadError EvalError m => Event -> Field -> m Val
getField st n = maybe (throwError (UnknownField n)) return $ Map.lookup n st


evalExpr :: MonadError EvalError m => Event -> Expr -> m Val
evalExpr st expr = case expr of
  ELit e   -> return e
  EField f -> getField st f
  ENot e   -> bool . not . asBool <$> evalExpr st e
  EIf e t f-> evalExpr st e >>= \b -> evalExpr st $ if asBool b then t else f

  ENeg e -> do
    v <- evalExpr st e >>= asNum
    return $ num (- v)

  EMatch r e -> do
    v <- evalExpr st e
    return $ bool $ reMatch r (asBS v)

  EExtract e r -> do
    v <- asBS <$> evalExpr st e
    ma <- maybe (throwError (NoExtract v)) return $ match r v
    return $ bs $ ma !! 1

  EReplace e r n ->
    -- TODO: Support subpattern substitution
    bs . gsub r (const n) . asBS <$> evalExpr st e

  EOp op a' b' ->
    case op of
      OEq     -> bcmp (==)
      ONeq    -> bcmp (/=)
      OLt     -> bcmp (<)
      OGt     -> bcmp (>)
      OLe     -> bcmp (<=)
      OGe     -> bcmp (>=)
      OIEq    -> icmp (==)
      OINeq   -> icmp (/=)
      OILt    -> icmp (<)
      OIGt    -> icmp (>)
      OILe    -> icmp (<=)
      OIGe    -> icmp (>=)
      OConcat -> withab (return . asBS) $ \a b -> return $ bs $ B.append a b
      OPlus   -> iop (+)
      OMinus  -> iop (-)
      OMul    -> iop (*)
      ODiv    -> idiv (/)
      OMod    -> idiv mod'
      OPow    -> iop (**)
      OOr     -> with a' return $ \a -> if asBool a then return a else with b' return return
      OAnd    -> with a' return $ \a -> if asBool a then with b' return return else return a
    where
      with v f p = evalExpr st v >>= f >>= p
      withab f p = with a' f $ \a -> with b' f $ \b -> p a b
      -- ByteString comparison
      bcmp f = withab (return . asBS) $ \a b -> return $ bool $ f a b
      -- Numeric comparison
      icmp f = withab asNum $ \a b -> return $ bool $ f a b
      -- Numeric operations
      iop f  = withab asNum $ \a b -> return $ num $ f a b
      -- Division with zero-check
      idiv f = withab asNum $ \a b ->
        if b == 0
          then throwError DivByZero
          else return $ num $ f a b


-- The behavior of each statement is implemented in two functions:
--
-- step:
--   Process a single event. This function can update some internal state of
--   the statement and/or immediately return a (modified) event, to be
--   processed by the next statement in the chain.
--
-- final:
--   Return a list of aggregated/sorted events stored in the internal state of
--   the statement.


-- The sorting algorithm is optimized for the scenario where there are many
-- logs as input and we're only interested in the top n (100 or so) logs. This
-- isn't the most efficient algorithm for other scenarios, alternative
-- strategies could be added later.
-- The current algorithm uses a fixed size min-heap to efficiently filter out
-- all logs that would not make it to the top n. This heap is then sorted in
-- the final step.


step :: Event -> Comp Stmt Event
step ev = get >>= \stmt -> case stmt of
  SShow _     -> undefined -- Should be handled by extractShow
  SSet f e    -> evalExpr ev e >>= \v -> return $ Map.insert f v ev
  SFilter e   -> evalExpr ev e >>= \v -> if asBool v then return ev else throwError Filtered

  SRegex f r p -> do
    val <- asBS <$> getField ev f
    ma <- maybe (throwError (NoMatch f val)) return $ match r val
    return $ foldl' ins ev $ zip ma p
    where
      ins s (_, Nothing) = s
      ins s (v, Just n)  = Map.insert n (bs v) s

  SSort n e st ->
    case st of
      SortAscNum  hp -> run SortAscNum  hp (\v -> AscNum <$> asNum v)
      SortAscBS   hp -> run SortAscBS   hp (return . AscBS . asBS)
      SortDescNum hp -> run SortDescNum hp (\v -> DescNum <$> asNum v)
      SortDescBS  hp -> run SortDescBS  hp (return . DescBS . asBS)
    where
    run wrap hp f = do
      val <- evalExpr ev e >>= f
      put $ SSort n e $ wrap (ins hp val)
      throwError Filtered
    ins hp val =
      let si = SortItem val ev in
      if Heap.size hp < n
        then Heap.insert si hp
        else if Heap.minimum hp < si
          then Heap.insert si $ Heap.deleteMin hp
          else hp

  SGroup f st -> do
    v <- mapM (getField ev) f
    put $ SGroup f $ Map.insert v () st
    throwError Filtered


final :: Comp Stmt [Event]
final = get >>= \stmt -> case stmt of
  SSort _ _ st ->
    case st of
      SortAscNum  hp -> f hp
      SortAscBS   hp -> f hp
      SortDescNum hp -> f hp
      SortDescBS  hp -> f hp
    where
    f hp = return $ map (\(SortItem _ ev) -> ev) $ reverse $ toList hp

  SGroup f st -> return $ map (\(k,_) -> Map.fromList $ zip f k) $ Map.toList st

  _ -> return []



-- TODO: These conversions between Monad and value representation are ugly.
stepL :: Event -> Comp [Stmt] Event
stepL ev' = do
  (r, st) <- f ev' <$> get
  put st
  except r
  where
  f :: Event -> [Stmt] -> (Either EvalError Event, [Stmt])
  f ev [] = (Right ev, [])
  f ev (s:xs) =
    let (r, s') = runState (runExceptT (step ev)) s
    in case r of
      Left _ -> (r, s':xs)
      Right e -> let (r', xs') = f e xs in (r', s':xs')

-- How does error handling work here? e.g. a sort statement will return all
-- results from 'final', but those results are then passed to 'step' again
-- where each event can individually fail. This type signature forces those
-- individual errors to be ignored.
finalL :: Comp [Stmt] [Event]
finalL = do
  (r, st) <- f <$> get
  put st
  except r
  where
  f :: [Stmt] -> (Either EvalError [Event], [Stmt])
  f [] = (Right [], [])
  f (s:xs) =
    let (r, s') = runState (runExceptT final) s
    in case r of
      Left _ -> (r, s':xs)
      Right e ->
        let (r', xs') = runState (runExceptT (collect e)) xs in (r', s':xs')

  collect :: [Event] -> Comp [Stmt] [Event]
  collect evl = do
    -- This throws away errors from step, not very nice.
    l1 <- catMaybes <$> mapM (\ev -> (Just <$> stepL ev) `catchError` (const $ return Nothing)) evl
    l2 <- finalL
    -- This is potentially slow. In practice either step or final returns
    -- events, not both, so this is easily optimized in case (++) doesn't
    -- already specialize this case.
    return (l1 ++ l2)