\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
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}
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)
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
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)
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}