\subsection{Cardano.BM.Data.MonitoringEval}

%if style == newcode
\begin{code}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE ViewPatterns #-}

module Cardano.BM.Data.MonitoringEval
  ( MEvExpr (..)
  , MEvPreCond
  , Operator (..)
  , Operand (..)
  , MEvAction (..)
  , VarName
  , Environment
  , parseMaybe
  , evaluate
  )
  where

import Prelude hiding (Ordering (..))

import           Control.Applicative ((<|>))
import           Control.Monad (void)
import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..))
import           Data.Aeson.Types (typeMismatch)
import qualified Data.Attoparsec.Text as P
import           Data.Char (isAlpha, isDigit, isLower, isUpper)
import qualified Data.HashMap.Strict as HM
import           Data.Maybe (catMaybes)
import           Data.Text (Text, pack, unpack)
import           Data.Word (Word64)

import           Cardano.BM.Data.Aggregated
import           Cardano.BM.Data.LogItem
import           Cardano.BM.Data.Severity

\end{code}
%endif

\subsubsection{Operators}\label{code:Operator}
Operators used to construct expressions.
\begin{code}

data Operator = GE -- >=
              | EQ -- ==
              | NE -- /=, !=, <>
              | LE -- <=
              | LT -- <
              | GT -- >
              deriving (Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq)

instance Show Operator where
    show :: Operator -> String
show Operator
GE = String
">="
    show Operator
EQ = String
"=="
    show Operator
NE = String
"/="
    show Operator
LE = String
"<="
    show Operator
LT = String
"<"
    show Operator
GT = String
">"

fromOperator :: Operator -> (Measurable -> Measurable -> Bool)
fromOperator :: Operator -> Measurable -> Measurable -> Bool
fromOperator Operator
GE = Measurable -> Measurable -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
fromOperator Operator
EQ = Measurable -> Measurable -> Bool
forall a. Eq a => a -> a -> Bool
(==)
fromOperator Operator
NE = Measurable -> Measurable -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
fromOperator Operator
LE = Measurable -> Measurable -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
fromOperator Operator
LT = Measurable -> Measurable -> Bool
forall a. Ord a => a -> a -> Bool
(<)
fromOperator Operator
GT = Measurable -> Measurable -> Bool
forall a. Ord a => a -> a -> Bool
(>)

\end{code}

\begin{code}
data AlgOp = Plus
           | Minus
           | Mult
           deriving AlgOp -> AlgOp -> Bool
(AlgOp -> AlgOp -> Bool) -> (AlgOp -> AlgOp -> Bool) -> Eq AlgOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlgOp -> AlgOp -> Bool
$c/= :: AlgOp -> AlgOp -> Bool
== :: AlgOp -> AlgOp -> Bool
$c== :: AlgOp -> AlgOp -> Bool
Eq

instance Show AlgOp where
    show :: AlgOp -> String
show AlgOp
Plus  = String
"+"
    show AlgOp
Minus = String
"-"
    show AlgOp
Mult  = String
"*"

fromAlgOp :: AlgOp -> (Measurable -> Measurable -> Measurable)
fromAlgOp :: AlgOp -> Measurable -> Measurable -> Measurable
fromAlgOp AlgOp
Plus  = Measurable -> Measurable -> Measurable
forall a. Num a => a -> a -> a
(+)
fromAlgOp AlgOp
Minus = (-)
fromAlgOp AlgOp
Mult  = Measurable -> Measurable -> Measurable
forall a. Num a => a -> a -> a
(*)

data AlgOperand = AlgM Measurable
                | AlgV VarName
                deriving AlgOperand -> AlgOperand -> Bool
(AlgOperand -> AlgOperand -> Bool)
-> (AlgOperand -> AlgOperand -> Bool) -> Eq AlgOperand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlgOperand -> AlgOperand -> Bool
$c/= :: AlgOperand -> AlgOperand -> Bool
== :: AlgOperand -> AlgOperand -> Bool
$c== :: AlgOperand -> AlgOperand -> Bool
Eq

instance Show AlgOperand where
    show :: AlgOperand -> String
show (AlgM Measurable
m)  = Measurable -> String
forall a. Show a => a -> String
show Measurable
m
    show (AlgV VarName
vn) = VarName -> String
unpack VarName
vn

data Operand = OpMeasurable Measurable
             | OpVarName    VarName
             | Operation    AlgOp AlgOperand AlgOperand
             deriving Operand -> Operand -> Bool
(Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool) -> Eq Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c== :: Operand -> Operand -> Bool
Eq

instance Show Operand where
    show :: Operand -> String
show (OpMeasurable Measurable
m)  = Measurable -> String
forall a. Show a => a -> String
show Measurable
m
    show (OpVarName    VarName
vn) = VarName -> String
unpack VarName
vn
    show (Operation    AlgOp
algOp AlgOperand
op1 AlgOperand
op2) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AlgOperand -> String
forall a. Show a => a -> String
show AlgOperand
op1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AlgOp -> String
forall a. Show a => a -> String
show AlgOp
algOp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AlgOperand -> String
forall a. Show a => a -> String
show AlgOperand
op2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

\end{code}

\subsubsection{Expressions}\label{code:MEvExpr}
Evaluation in monitoring will evaluate expressions
\begin{code}
type VarName = Text
data MEvExpr = Compare VarName (Operator, Operand)
             | AND MEvExpr MEvExpr
             | OR  MEvExpr MEvExpr
             | NOT MEvExpr

            -- parsing: "(some >= (2000 µs))"  =>  Compare "some" (GE, (Microseconds 2000))
            -- parser "((lastreported >= (5 s)) Or ((other >= (0 s)) And (some > (1500 µs))))"

-- Precondition for monitoring is the same logical expression,
-- but it is an optional expression.
type MEvPreCond = Maybe MEvExpr

instance Eq MEvExpr where
    == :: MEvExpr -> MEvExpr -> Bool
(==) (Compare VarName
vn1 (Operator, Operand)
p1) (Compare VarName
vn2 (Operator, Operand)
p2) = (VarName
vn1 VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
vn2) Bool -> Bool -> Bool
&& ((Operator, Operand)
p1 (Operator, Operand) -> (Operator, Operand) -> Bool
forall a. Eq a => a -> a -> Bool
== (Operator, Operand)
p2)
    (==) (AND MEvExpr
e11 MEvExpr
e12)    (AND MEvExpr
e21 MEvExpr
e22)    = (MEvExpr
e11 MEvExpr -> MEvExpr -> Bool
forall a. Eq a => a -> a -> Bool
== MEvExpr
e21 Bool -> Bool -> Bool
&& MEvExpr
e12 MEvExpr -> MEvExpr -> Bool
forall a. Eq a => a -> a -> Bool
== MEvExpr
e22)
    (==) (OR MEvExpr
e11 MEvExpr
e12)     (OR MEvExpr
e21 MEvExpr
e22)     = (MEvExpr
e11 MEvExpr -> MEvExpr -> Bool
forall a. Eq a => a -> a -> Bool
== MEvExpr
e21 Bool -> Bool -> Bool
&& MEvExpr
e12 MEvExpr -> MEvExpr -> Bool
forall a. Eq a => a -> a -> Bool
== MEvExpr
e22)
    (==) (NOT MEvExpr
e1)         (NOT MEvExpr
e2)         = (MEvExpr
e1 MEvExpr -> MEvExpr -> Bool
forall a. Eq a => a -> a -> Bool
== MEvExpr
e2)
    (==) MEvExpr
_                MEvExpr
_                = Bool
False

instance FromJSON MEvExpr where
    parseJSON :: Value -> Parser MEvExpr
parseJSON (String VarName
s) =
        case VarName -> Either String MEvExpr
parseEither VarName
s of
            Left String
e     -> String -> Parser MEvExpr
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
            Right MEvExpr
expr -> MEvExpr -> Parser MEvExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure MEvExpr
expr
    parseJSON Value
o = String -> Value -> Parser MEvExpr
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
o

instance ToJSON MEvExpr where
    toJSON :: MEvExpr -> Value
toJSON MEvExpr
expr = VarName -> Value
String (VarName -> Value) -> VarName -> Value
forall a b. (a -> b) -> a -> b
$ String -> VarName
pack (String -> VarName) -> String -> VarName
forall a b. (a -> b) -> a -> b
$ MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
expr

instance Show MEvExpr where
    show :: MEvExpr -> String
show (Compare VarName
vn (Operator
op, Operand
x)) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (VarName -> String
unpack VarName
vn) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Operator -> String
forall a. Show a => a -> String
show Operator
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Operand -> String
forall a. Show a => a -> String
show Operand
x String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (AND MEvExpr
e1 MEvExpr
e2)          = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") And (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
e2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (OR MEvExpr
e1 MEvExpr
e2)           = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
e1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Or "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
e2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (NOT MEvExpr
e)              = String
"Not (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (MEvExpr -> String
forall a. Show a => a -> String
show MEvExpr
e) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

\end{code}

\subsubsection{Monitoring actions}\label{code:MEvAction}
If evaluation of a monitoring expression is |True|, then a set of actions are
executed for alerting.
\begin{code}
data MEvAction = CreateMessage Severity !Text
               | SetGlobalMinimalSeverity Severity
               | AlterSeverity LoggerName Severity
               deriving (MEvAction -> MEvAction -> Bool
(MEvAction -> MEvAction -> Bool)
-> (MEvAction -> MEvAction -> Bool) -> Eq MEvAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MEvAction -> MEvAction -> Bool
$c/= :: MEvAction -> MEvAction -> Bool
== :: MEvAction -> MEvAction -> Bool
$c== :: MEvAction -> MEvAction -> Bool
Eq)

instance FromJSON MEvAction where
    parseJSON :: Value -> Parser MEvAction
parseJSON (String VarName
s) =
        case VarName -> Either String MEvAction
parseEitherAction VarName
s of
            Left String
e     -> String -> Parser MEvAction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
            Right MEvAction
expr -> MEvAction -> Parser MEvAction
forall (f :: * -> *) a. Applicative f => a -> f a
pure MEvAction
expr
    parseJSON Value
o = String -> Value -> Parser MEvAction
forall a. String -> Value -> Parser a
typeMismatch String
"String" Value
o

instance ToJSON MEvAction where
    toJSON :: MEvAction -> Value
toJSON = VarName -> Value
String (VarName -> Value) -> (MEvAction -> VarName) -> MEvAction -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VarName
pack (String -> VarName)
-> (MEvAction -> String) -> MEvAction -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MEvAction -> String
forall a. Show a => a -> String
show

instance Show MEvAction where
    show :: MEvAction -> String
show (CreateMessage Severity
sev VarName
msg)        = String
"CreateMessage " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
sev String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall a. Show a => a -> String
show VarName
msg
    show (SetGlobalMinimalSeverity Severity
sev) = String
"SetGlobalMinimalSeverity " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
sev
    show (AlterSeverity VarName
loggerName Severity
sev) = String
"AlterSeverity " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall a. Show a => a -> String
show VarName
loggerName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
sev
\end{code}

\subsubsection{Parsing an expression from textual representation}\label{code:parseEither}\label{code:parseMaybe}
\begin{code}
parseEither :: Text -> Either String MEvExpr
parseEither :: VarName -> Either String MEvExpr
parseEither VarName
t =
    let r :: Result MEvExpr
r = Parser MEvExpr -> VarName -> Result MEvExpr
forall a. Parser a -> VarName -> Result a
P.parse Parser MEvExpr
parseExpr VarName
t
    in
    Result MEvExpr -> Either String MEvExpr
forall r. Result r -> Either String r
P.eitherResult Result MEvExpr
r

parseMaybe :: Text -> Maybe MEvExpr
parseMaybe :: VarName -> Maybe MEvExpr
parseMaybe VarName
t =
    let r :: Result MEvExpr
r = Parser MEvExpr -> VarName -> Result MEvExpr
forall a. Parser a -> VarName -> Result a
P.parse Parser MEvExpr
parseExpr VarName
t
    in
    Result MEvExpr -> Maybe MEvExpr
forall r. Result r -> Maybe r
P.maybeResult Result MEvExpr
r

openPar, closePar :: P.Parser ()
openPar :: Parser ()
openPar = Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
'('
closePar :: Parser ()
closePar = Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
')'
token :: Text -> P.Parser ()
token :: VarName -> Parser ()
token VarName
s = Parser VarName VarName -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName VarName -> Parser ())
-> Parser VarName VarName -> Parser ()
forall a b. (a -> b) -> a -> b
$ VarName -> Parser VarName VarName
P.string VarName
s

\end{code}

\subsubsection{Parsing an action from textual representation}\label{code:parseEitherAction}
\begin{code}
parseEitherAction :: Text -> Either String MEvAction
parseEitherAction :: VarName -> Either String MEvAction
parseEitherAction VarName
t =
    let r :: Result MEvAction
r = Parser MEvAction -> VarName -> Result MEvAction
forall a. Parser a -> VarName -> Result a
P.parse Parser MEvAction
parseAction VarName
t
    in
    Result MEvAction -> Either String MEvAction
forall r. Result r -> Either String r
P.eitherResult Result MEvAction
r

\end{code}

\label{code:parseExpr}
An expression is enclosed in parentheses. Either it is a negation, starting with 'Not',
or a binary operand like 'And', 'Or', or a comparison of a named variable.
\begin{code}
{-@ lazy parseExpr @-}
parseExpr :: P.Parser MEvExpr
parseExpr :: Parser MEvExpr
parseExpr = do
    Parser ()
openPar
    Parser ()
P.skipSpace
    MEvExpr
e <- do
            (Char -> Parser ()
nextIsChar Char
'N' Parser () -> Parser MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MEvExpr
parseNot)
        Parser MEvExpr -> Parser MEvExpr -> Parser MEvExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ()
nextIsChar Char
'(' Parser () -> Parser MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MEvExpr
parseBi)
        Parser MEvExpr -> Parser MEvExpr -> Parser MEvExpr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser MEvExpr
parseComp
    Parser ()
P.skipSpace
    Parser ()
closePar
    MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return MEvExpr
e

\end{code}

\label{code:parseAction}
An action is enclosed in parentheses.
\begin{code}
parseAction :: P.Parser MEvAction
parseAction :: Parser MEvAction
parseAction =
        (Char -> Parser ()
nextIsChar Char
'C' Parser () -> Parser MEvAction -> Parser MEvAction
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MEvAction
parseActionCreateMessage)
    Parser MEvAction -> Parser MEvAction -> Parser MEvAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ()
nextIsChar Char
'S' Parser () -> Parser MEvAction -> Parser MEvAction
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MEvAction
parseActionSetMinSeverity)
    Parser MEvAction -> Parser MEvAction -> Parser MEvAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ()
nextIsChar Char
'A' Parser () -> Parser MEvAction -> Parser MEvAction
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MEvAction
parseActionAlterSeverity)

parseActionCreateMessage :: P.Parser MEvAction
parseActionCreateMessage :: Parser MEvAction
parseActionCreateMessage = do
    Parser VarName VarName -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName VarName -> Parser ())
-> Parser VarName VarName -> Parser ()
forall a b. (a -> b) -> a -> b
$ VarName -> Parser VarName VarName
P.string VarName
"CreateMessage"
    Parser ()
P.skipSpace
    Severity
sev <- Parser Severity
parsePureSeverity
    Parser ()
P.skipSpace
    Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
'\"'
    VarName
alertMessage <- (Char -> Bool) -> Parser VarName VarName
P.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\"')
    Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
'\"'
    MEvAction -> Parser MEvAction
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvAction -> Parser MEvAction) -> MEvAction -> Parser MEvAction
forall a b. (a -> b) -> a -> b
$ Severity -> VarName -> MEvAction
CreateMessage Severity
sev VarName
alertMessage

parseActionSetMinSeverity :: P.Parser MEvAction
parseActionSetMinSeverity :: Parser MEvAction
parseActionSetMinSeverity = do
    Parser VarName VarName -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName VarName -> Parser ())
-> Parser VarName VarName -> Parser ()
forall a b. (a -> b) -> a -> b
$ VarName -> Parser VarName VarName
P.string VarName
"SetGlobalMinimalSeverity"
    Parser ()
P.skipSpace
    Severity
sev <- Parser Severity
parsePureSeverity
    MEvAction -> Parser MEvAction
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvAction -> Parser MEvAction) -> MEvAction -> Parser MEvAction
forall a b. (a -> b) -> a -> b
$ Severity -> MEvAction
SetGlobalMinimalSeverity Severity
sev

parseActionAlterSeverity :: P.Parser MEvAction
parseActionAlterSeverity :: Parser MEvAction
parseActionAlterSeverity = do
    Parser VarName VarName -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName VarName -> Parser ())
-> Parser VarName VarName -> Parser ()
forall a b. (a -> b) -> a -> b
$ VarName -> Parser VarName VarName
P.string VarName
"AlterSeverity"
    Parser ()
P.skipSpace
    Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
'\"'
    VarName
loggerName <- (Char -> Bool) -> Parser VarName VarName
P.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\"')
    Parser VarName Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser VarName Char -> Parser ())
-> Parser VarName Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser VarName Char
P.char Char
'\"'
    Parser ()
P.skipSpace
    Severity
sev <- Parser Severity
parsePureSeverity
    MEvAction -> Parser MEvAction
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvAction -> Parser MEvAction) -> MEvAction -> Parser MEvAction
forall a b. (a -> b) -> a -> b
$ VarName -> Severity -> MEvAction
AlterSeverity VarName
loggerName Severity
sev

parsePureSeverity :: P.Parser Severity
parsePureSeverity :: Parser Severity
parsePureSeverity =
        (VarName -> Parser VarName VarName
P.string VarName
"Debug"     Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Debug)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Info"      Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Info)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Notice"    Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Notice)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Warning"   Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Warning)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Error"     Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Error)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Critical"  Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Critical)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Alert"     Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Alert)
    Parser Severity -> Parser Severity -> Parser Severity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Emergency" Parser VarName VarName -> Parser Severity -> Parser Severity
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Severity -> Parser Severity
forall (m :: * -> *) a. Monad m => a -> m a
return Severity
Emergency)

\end{code}

\label{code:nextIsChar}
\begin{code}
nextIsChar :: Char -> P.Parser ()
nextIsChar :: Char -> Parser ()
nextIsChar Char
c = do
    Char
c' <- Parser VarName Char
P.peekChar'
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c'
    then () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"cannot parse char: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]

peekNextChar :: (Char -> Bool) -> P.Parser ()
peekNextChar :: (Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
predicate = do
    Char
c <- Parser VarName Char
P.peekChar'
    if Char -> Bool
predicate Char
c
    then () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    else String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"next char doesn't satisfy to a predicate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]

parseBi :: P.Parser MEvExpr
parseBi :: Parser MEvExpr
parseBi = do
    MEvExpr
e1 <- Parser MEvExpr
parseExpr
    Parser ()
P.skipSpace
    MEvExpr -> MEvExpr -> MEvExpr
op <-     (VarName -> Parser ()
token VarName
"And" Parser ()
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return MEvExpr -> MEvExpr -> MEvExpr
AND)
          Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser ()
token VarName
"Or" Parser ()
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MEvExpr -> MEvExpr -> MEvExpr)
-> Parser VarName (MEvExpr -> MEvExpr -> MEvExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return MEvExpr -> MEvExpr -> MEvExpr
OR)
    Parser ()
P.skipSpace
    MEvExpr
e2 <- Parser MEvExpr
parseExpr
    MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvExpr -> MEvExpr -> MEvExpr
op MEvExpr
e1 MEvExpr
e2)

parseNot :: P.Parser MEvExpr
parseNot :: Parser MEvExpr
parseNot = do
    VarName -> Parser ()
token VarName
"Not"
    Parser ()
P.skipSpace
    MEvExpr
e <- Parser MEvExpr
parseExpr
    Parser ()
P.skipSpace
    MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvExpr -> MEvExpr
NOT MEvExpr
e)

parseComp :: P.Parser MEvExpr
parseComp :: Parser MEvExpr
parseComp = do
    VarName
vn <- Parser VarName VarName
parseVarName
    Parser ()
P.skipSpace
    Operator
op <- Parser Operator
parseOperator
    Parser ()
P.skipSpace
    Operand
operand <- Parser Operand
parseOperand
    MEvExpr -> Parser MEvExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (MEvExpr -> Parser MEvExpr) -> MEvExpr -> Parser MEvExpr
forall a b. (a -> b) -> a -> b
$ VarName -> (Operator, Operand) -> MEvExpr
Compare VarName
vn (Operator
op, Operand
operand)

parseOperator :: P.Parser Operator
parseOperator :: Parser Operator
parseOperator = do
        (VarName -> Parser VarName VarName
P.string VarName
">=" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
GE)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"==" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
EQ)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"/=" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
NE)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"!=" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
NE)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"<>" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
NE)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"<=" Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
LE)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"<"  Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
LT)
    Parser Operator -> Parser Operator -> Parser Operator
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
">"  Parser VarName VarName -> Parser Operator -> Parser Operator
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
GT)

parseOpMeasurable :: P.Parser Operand
parseOpMeasurable :: Parser Operand
parseOpMeasurable =
    Measurable -> Operand
OpMeasurable (Measurable -> Operand)
-> Parser VarName Measurable -> Parser Operand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser VarName Measurable
parseMeasurable

parseAlgOperator :: P.Parser AlgOp
parseAlgOperator :: Parser AlgOp
parseAlgOperator =
        (VarName -> Parser VarName VarName
P.string VarName
"+" Parser VarName VarName -> Parser AlgOp -> Parser AlgOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AlgOp -> Parser AlgOp
forall (m :: * -> *) a. Monad m => a -> m a
return AlgOp
Plus)
    Parser AlgOp -> Parser AlgOp -> Parser AlgOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"-" Parser VarName VarName -> Parser AlgOp -> Parser AlgOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AlgOp -> Parser AlgOp
forall (m :: * -> *) a. Monad m => a -> m a
return AlgOp
Minus)
    Parser AlgOp -> Parser AlgOp -> Parser AlgOp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"*" Parser VarName VarName -> Parser AlgOp -> Parser AlgOp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AlgOp -> Parser AlgOp
forall (m :: * -> *) a. Monad m => a -> m a
return AlgOp
Mult)

-- VarName first, examples:
-- 1. stats.mean + (2 seconds)
-- 2. stats.mean + stats.max
-- 3. stats.mean - (10)
-- 4. stats.mean
parseOpAlgebraVFirst :: P.Parser Operand
parseOpAlgebraVFirst :: Parser Operand
parseOpAlgebraVFirst = do
    VarName
varName <- Parser VarName VarName
parseVarName
    Parser ()
P.skipSpace
    Char
c <- Parser VarName Char
P.peekChar'
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'
    then Operand -> Parser Operand
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> Parser Operand) -> Operand -> Parser Operand
forall a b. (a -> b) -> a -> b
$ VarName -> Operand
OpVarName VarName
varName
    else do
        AlgOp
algOp <- Parser AlgOp
parseAlgOperator
        Parser ()
P.skipSpace
        AlgOperand
algOperand <- do
                (Char -> Parser ()
nextIsChar Char
'('       Parser () -> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser VarName AlgOperand
parseAlgM)
            Parser VarName AlgOperand
-> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
isLower Parser () -> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser VarName AlgOperand
parseAlgV)
        Operand -> Parser Operand
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> Parser Operand) -> Operand -> Parser Operand
forall a b. (a -> b) -> a -> b
$ AlgOp -> AlgOperand -> AlgOperand -> Operand
Operation AlgOp
algOp (VarName -> AlgOperand
AlgV VarName
varName) AlgOperand
algOperand

-- Measurable first, examples:
-- 1. (2 seconds) + (3 seconds)
-- 2. (2 seconds) + stats.mean
-- 3. (10) - stats.mean
parseOpAlgebraMFirst :: P.Parser Operand
parseOpAlgebraMFirst :: Parser Operand
parseOpAlgebraMFirst = do
    Parser ()
openPar
    Parser ()
P.skipSpace
    Measurable
m <- Parser VarName Measurable
parseMeasurable
    Parser ()
P.skipSpace
    Parser ()
closePar
    Parser ()
P.skipSpace
    AlgOp
algOp <- Parser AlgOp
parseAlgOperator
    Parser ()
P.skipSpace
    AlgOperand
algOperand <- do
            (Char -> Parser ()
nextIsChar Char
'('       Parser () -> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser VarName AlgOperand
parseAlgM)
        Parser VarName AlgOperand
-> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
isLower Parser () -> Parser VarName AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser VarName AlgOperand
parseAlgV)
    Operand -> Parser Operand
forall (m :: * -> *) a. Monad m => a -> m a
return (Operand -> Parser Operand) -> Operand -> Parser Operand
forall a b. (a -> b) -> a -> b
$ AlgOp -> AlgOperand -> AlgOperand -> Operand
Operation AlgOp
algOp (Measurable -> AlgOperand
AlgM Measurable
m) AlgOperand
algOperand

parseAlgM :: P.Parser AlgOperand
parseAlgM :: Parser VarName AlgOperand
parseAlgM = do
    Parser ()
openPar
    Parser ()
P.skipSpace
    Measurable
m <- Parser VarName Measurable
parseMeasurable
    Parser ()
P.skipSpace
    Parser ()
closePar
    AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a. Monad m => a -> m a
return (AlgOperand -> Parser VarName AlgOperand)
-> AlgOperand -> Parser VarName AlgOperand
forall a b. (a -> b) -> a -> b
$ Measurable -> AlgOperand
AlgM Measurable
m

parseAlgV :: P.Parser AlgOperand
parseAlgV :: Parser VarName AlgOperand
parseAlgV = do
    VarName
varName <- Parser VarName VarName
parseVarName
    AlgOperand -> Parser VarName AlgOperand
forall (m :: * -> *) a. Monad m => a -> m a
return (AlgOperand -> Parser VarName AlgOperand)
-> AlgOperand -> Parser VarName AlgOperand
forall a b. (a -> b) -> a -> b
$ VarName -> AlgOperand
AlgV VarName
varName

parseVarName :: P.Parser VarName
parseVarName :: Parser VarName VarName
parseVarName =
    (Char -> Bool) -> Parser VarName VarName
P.takeWhile1 ((Char -> Bool) -> Parser VarName VarName)
-> (Char -> Bool) -> Parser VarName VarName
forall a b. (a -> b) -> a -> b
$ \Char
c ->
           Char -> Bool
isAlpha Char
c
        Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

parseOperand :: P.Parser Operand
parseOperand :: Parser Operand
parseOperand = do
    Parser ()
openPar
    Parser ()
P.skipSpace
    Operand
operand <- do
            ((Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
isDigit Parser () -> Parser Operand -> Parser Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Operand
parseOpMeasurable)
        Parser Operand -> Parser Operand -> Parser Operand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
isUpper Parser () -> Parser Operand -> Parser Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Operand
parseOpMeasurable) -- This is for Severity.
        Parser Operand -> Parser Operand -> Parser Operand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Bool) -> Parser ()
peekNextChar Char -> Bool
isLower Parser () -> Parser Operand -> Parser Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Operand
parseOpAlgebraVFirst)
        Parser Operand -> Parser Operand -> Parser Operand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ()
nextIsChar Char
'('       Parser () -> Parser Operand -> Parser Operand
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Operand
parseOpAlgebraMFirst)
    Parser ()
P.skipSpace
    Parser ()
closePar
    Operand -> Parser Operand
forall (m :: * -> *) a. Monad m => a -> m a
return Operand
operand

parseMeasurable :: P.Parser Measurable
parseMeasurable :: Parser VarName Measurable
parseMeasurable = do
    Measurable
m <- do
            Parser VarName Measurable
parseTime
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarName Measurable
parseBytes
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser VarName Measurable
parseSeverity
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Integer
forall a. Integral a => Parser a
P.decimal Parser Integer
-> (Integer -> Parser VarName Measurable)
-> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Measurable -> Parser VarName Measurable)
-> (Integer -> Measurable) -> Integer -> Parser VarName Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Measurable
PureI)
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Double
P.double Parser Double
-> (Double -> Parser VarName Measurable)
-> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Measurable -> Parser VarName Measurable)
-> (Double -> Measurable) -> Double -> Parser VarName Measurable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Measurable
PureD)
    Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return Measurable
m

parseTime :: P.Parser Measurable
parseTime :: Parser VarName Measurable
parseTime = do
    Word64
n <- Parser Word64
forall a. Integral a => Parser a
P.decimal
    Parser ()
P.skipSpace
    Word64 -> Parser VarName Measurable
tryUnit Word64
n
  where
    tryUnit :: Word64 -> P.Parser Measurable
    tryUnit :: Word64 -> Parser VarName Measurable
tryUnit Word64
n =
            (VarName -> Parser VarName VarName
P.string VarName
"ns" Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Nanoseconds Word64
n))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"µs" Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Microseconds Word64
n))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"s"  Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Seconds Word64
n))

parseBytes :: P.Parser Measurable
parseBytes :: Parser VarName Measurable
parseBytes = do
    Word64
n <- Parser Word64
forall a. Integral a => Parser a
P.decimal
    Parser ()
P.skipSpace
    Word64 -> Parser VarName Measurable
tryUnit Word64
n
  where
    tryUnit :: Word64 -> P.Parser Measurable
    tryUnit :: Word64 -> Parser VarName Measurable
tryUnit Word64
n =
            (VarName -> Parser VarName VarName
P.string VarName
"kB"    Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Bytes (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"bytes" Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Bytes Word64
n))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"byte"  Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Bytes Word64
n))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"MB"    Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Bytes (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)))
        Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"GB"    Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Measurable
Bytes (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)))

parseSeverity :: P.Parser Measurable
parseSeverity :: Parser VarName Measurable
parseSeverity =
        (VarName -> Parser VarName VarName
P.string VarName
"Debug"     Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Debug))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Info"      Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Info))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Notice"    Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Notice))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Warning"   Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Warning))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Error"     Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Error))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Critical"  Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Critical))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Alert"     Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Alert))
    Parser VarName Measurable
-> Parser VarName Measurable -> Parser VarName Measurable
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (VarName -> Parser VarName VarName
P.string VarName
"Emergency" Parser VarName VarName
-> Parser VarName Measurable -> Parser VarName Measurable
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Measurable -> Parser VarName Measurable
forall (m :: * -> *) a. Monad m => a -> m a
return (Severity -> Measurable
Severity Severity
Emergency))
\end{code}

\subsubsection{Evaluate expression}\label{code:Environment}\label{code:evaluate}
This is an interpreter of |MEvExpr| in an |Environment|.
\begin{code}
type Environment = HM.HashMap VarName Measurable

\end{code}

The actual interpreter of an expression returns |True|
if the expression is valid in the |Environment|,
otherwise returns |False|.
\begin{code}
evaluate :: Environment -> MEvExpr -> Bool
evaluate :: Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
expr = case MEvExpr
expr of
    Compare VarName
vn ((Operator -> Measurable -> Measurable -> Bool
fromOperator -> Measurable -> Measurable -> Bool
compOp), Operand
operand) -> case VarName -> Maybe Measurable
getValueOf VarName
vn of
        Maybe Measurable
Nothing -> Bool
False
        Just Measurable
m1 -> case Operand
operand of
            OpMeasurable Measurable
m2 ->
                Measurable
m1 Measurable -> Measurable -> Bool
`compOp` Measurable
m2
            OpVarName VarName
opvn ->
                Bool -> (Measurable -> Bool) -> Maybe Measurable -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Measurable
m2 -> Measurable
m1 Measurable -> Measurable -> Bool
`compOp` Measurable
m2) (Maybe Measurable -> Bool) -> Maybe Measurable -> Bool
forall a b. (a -> b) -> a -> b
$ VarName -> Maybe Measurable
getValueOf VarName
opvn
            Operation (AlgOp -> Measurable -> Measurable -> Measurable
fromAlgOp -> Measurable -> Measurable -> Measurable
algOp) (AlgM Measurable
m1') (AlgM Measurable
m2') ->
                Measurable
m1 Measurable -> Measurable -> Bool
`compOp` (Measurable
m1' Measurable -> Measurable -> Measurable
`algOp` Measurable
m2')
            Operation (AlgOp -> Measurable -> Measurable -> Measurable
fromAlgOp -> Measurable -> Measurable -> Measurable
algOp) (AlgM Measurable
m) (AlgV VarName
opvn) ->
                Bool -> (Measurable -> Bool) -> Maybe Measurable -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Measurable
m2 -> Measurable
m1 Measurable -> Measurable -> Bool
`compOp` (Measurable
m Measurable -> Measurable -> Measurable
`algOp` Measurable
m2)) (Maybe Measurable -> Bool) -> Maybe Measurable -> Bool
forall a b. (a -> b) -> a -> b
$ VarName -> Maybe Measurable
getValueOf VarName
opvn
            Operation (AlgOp -> Measurable -> Measurable -> Measurable
fromAlgOp -> Measurable -> Measurable -> Measurable
algOp) (AlgV VarName
opvn) (AlgM Measurable
m) ->
                Bool -> (Measurable -> Bool) -> Maybe Measurable -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Measurable
m2 -> Measurable
m1 Measurable -> Measurable -> Bool
`compOp` (Measurable
m2 Measurable -> Measurable -> Measurable
`algOp` Measurable
m)) (Maybe Measurable -> Bool) -> Maybe Measurable -> Bool
forall a b. (a -> b) -> a -> b
$ VarName -> Maybe Measurable
getValueOf VarName
opvn
            Operation (AlgOp -> Measurable -> Measurable -> Measurable
fromAlgOp -> Measurable -> Measurable -> Measurable
algOp) (AlgV VarName
opvn1) (AlgV VarName
opvn2) ->
                case [Maybe Measurable] -> [Measurable]
forall a. [Maybe a] -> [a]
catMaybes [VarName -> Maybe Measurable
getValueOf VarName
opvn1, VarName -> Maybe Measurable
getValueOf VarName
opvn2] of
                    [Measurable
opm1, Measurable
opm2] -> Measurable
m1 Measurable -> Measurable -> Bool
`compOp` (Measurable
opm1 Measurable -> Measurable -> Measurable
`algOp` Measurable
opm2)
                    [Measurable]
_ -> Bool
False
    AND MEvExpr
e1 MEvExpr
e2 -> (Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
e1) Bool -> Bool -> Bool
&& (Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
e2)
    OR MEvExpr
e1 MEvExpr
e2  -> (Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
e1) Bool -> Bool -> Bool
|| (Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
e2)
    NOT MEvExpr
e     -> Bool -> Bool
not (Environment -> MEvExpr -> Bool
evaluate Environment
ev MEvExpr
e)
  where
    getValueOf :: VarName -> Maybe Measurable
getValueOf = (VarName -> Environment -> Maybe Measurable)
-> Environment -> VarName -> Maybe Measurable
forall a b c. (a -> b -> c) -> b -> a -> c
flip VarName -> Environment -> Maybe Measurable
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Environment
ev

\end{code}