{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Kusto.Kql where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Dsl.Types as Types


kqlModule :: Module
kqlModule :: Module
kqlModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"A partial KQL (Kusto Query Language) model, based on examples from the documentation. Not normative.")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/kusto/kql"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    kql :: String -> Type
kql = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"BetweenExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"not"String -> Type -> FieldType
>: Type
boolean,
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"lowerBound"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"upperBound"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],
          
      String -> Type -> Element
def String
"BinaryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"left"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"operator"String -> Type -> FieldType
>: String -> Type
kql String
"BinaryOperator",
          String
"right"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"BinaryOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"caseInsensitiveEqual",
          String
"contains",
          String
"divide",
          String
"endsWith",
          String
"equal",
          String
"greater",
          String
"greaterOrEqual",
          String
"has",
          String
"hasPrefix",
          String
"hasSuffix",
          String
"less",
          String
"lessOrEqual",
          String
"matchesRegex",
          String
"minus",
          String
"notEqual",
          String
"plus",
          String
"startsWith",
          String
"times"],

      String -> Type -> Element
def String
"BuiltInFunction" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"ago",
          String
"bin",
          String
"count",
          String
"dcount",
          String
"endofday",
          String
"extract",
          String
"format_datetime",
          String
"materialize",
          String
"now",
          String
"range",
          String
"startofday",
          String
"strcat",
          String
"todynamic"],

      String -> Type -> Element
def String
"ColumnAlias" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"column"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"alias"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName"],

      String -> Type -> Element
def String
"ColumnAssignment" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"column"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"ColumnName" Type
string,

      String -> Type -> Element
def String
"Columns" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"all"String -> Type -> FieldType
>: Type
unit,
          String
"single"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName"],

      String -> Type -> Element
def String
"Command" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"count"String -> Type -> FieldType
>: Type
unit,
          String
"distinct"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"See https://learn.microsoft.com/en-us/azure/data-explorer/kusto/query/distinct-operator" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName",
          String
"extend"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnAssignment",
          String
"join"String -> Type -> FieldType
>: String -> Type
kql String
"JoinCommand",
          String
"limit"String -> Type -> FieldType
>: Type
int32,
          String
"mvexpand"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"orderBy"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"SortBy",
          String
"parse"String -> Type -> FieldType
>: String -> Type
kql String
"ParseCommand",
          String
"print"String -> Type -> FieldType
>: String -> Type
kql String
"PrintCommand",
          String
"project"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Projection",
          String
"projectAway"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName",
          String
"projectRename"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnAlias",
          String
"render"String -> Type -> FieldType
>: Type
string,
          String
"search"String -> Type -> FieldType
>: String -> Type
kql String
"SearchCommand",
          String
"sortBy"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"SortBy",
          String
"summarize"String -> Type -> FieldType
>: String -> Type
kql String
"SummarizeCommand",
          String
"take"String -> Type -> FieldType
>:
            String -> Type -> Type
doc String
"Limit a search to a specified number of results"
            Type
int32,
          String
"top"String -> Type -> FieldType
>: String -> Type
kql String
"TopCommand",
          String
"union"String -> Type -> FieldType
>: String -> Type
kql String
"UnionCommand",
          String
"where"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"Datetime" Type
string,

      String -> Type -> Element
def String
"Duration" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"value"String -> Type -> FieldType
>: Type
int32,
          String
"unit"String -> Type -> FieldType
>: String -> Type
kql String
"DurationUnit"],

      String -> Type -> Element
def String
"DurationUnit" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [String
"second", String
"minute", String
"hour"],

      String -> Type -> Element
def String
"Expression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"and"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Expression",
          String
"any"String -> Type -> FieldType
>: Type
unit,
          String
"between"String -> Type -> FieldType
>: String -> Type
kql String
"BetweenExpression",
          String
"binary"String -> Type -> FieldType
>: String -> Type
kql String
"BinaryExpression",
          String
"braces"String -> Type -> FieldType
>: String -> Type
kql String
"Expression", -- TODO: what do braces represent? E.g. "let timeRange = {TimeRange}"
          String
"column"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"dataset"String -> Type -> FieldType
>: String -> Type
kql String
"TableName",
          String
"index"String -> Type -> FieldType
>: String -> Type
kql String
"IndexExpression",
          String
"list"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Expression",
          String
"literal"String -> Type -> FieldType
>: String -> Type
kql String
"Literal",
          String
"or"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Expression",
          String
"parentheses"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"property"String -> Type -> FieldType
>: String -> Type
kql String
"PropertyExpression",
          String
"unary"String -> Type -> FieldType
>: String -> Type
kql String
"UnaryExpression"],

      String -> Type -> Element
def String
"Function" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"builtIn"String -> Type -> FieldType
>: String -> Type
kql String
"BuiltInFunction",
          String
"custom"String -> Type -> FieldType
>: String -> Type
kql String
"FunctionName"],
      
      String -> Type -> Element
def String
"FunctionExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"function"String -> Type -> FieldType
>: String -> Type
kql String
"Function",
          String
"arguments"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"FunctionName" Type
string,

      String -> Type -> Element
def String
"IndexExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"index"String -> Type -> FieldType
>: Type
string],

      String -> Type -> Element
def String
"JoinCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"kind"String -> Type -> FieldType
>: String -> Type
kql String
"JoinKind",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"TableName",
          String
"on"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"JoinKind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [String
"leftouter", String
"leftsemi", String
"leftanti", String
"fullouter", String
"inner", String
"innerunique", String
"rightouter", String
"rightsemi", String
"rightanti"],

      String -> Type -> Element
def String
"KeyValuePair" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"key"String -> Type -> FieldType
>: Type
string,
          String
"value"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"LetBinding" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"LetExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"bindings"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"LetBinding",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"TabularExpression"],

      String -> Type -> Element
def String
"Literal" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"duration"String -> Type -> FieldType
>: String -> Type
kql String
"Duration",
          String
"datetime"String -> Type -> FieldType
>: String -> Type
kql String
"Datetime",
          String
"string"String -> Type -> FieldType
>: Type
string,
          -- TODO: unverified
          String
"int"String -> Type -> FieldType
>: Type
int32,
          String
"long"String -> Type -> FieldType
>: Type
int64,
          String
"double"String -> Type -> FieldType
>: Type
float64,
          String
"boolean"String -> Type -> FieldType
>: Type
boolean],

      String -> Type -> Element
def String
"Order" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [String
"ascending", String
"descending"],

      String -> Type -> Element
def String
"Parameter" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"key"String -> Type -> FieldType
>: Type
string,
          String
"value"String -> Type -> FieldType
>: String -> Type
kql String
"Literal"],

      String -> Type -> Element
def String
"ParseCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"column"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"pairs"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"KeyValuePair"],

      -- TODO: what are these expressions actually called in KQL?
      String -> Type -> Element
def String
"PipelineExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"TabularExpression",

      String -> Type -> Element
def String
"PrintCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"column"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"Projection" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"alias"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName"],

      String -> Type -> Element
def String
"PropertyExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression",
          String
"property"String -> Type -> FieldType
>: Type
string],

      String -> Type -> Element
def String
"Query" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"TabularExpression",

      String -> Type -> Element
def String
"SearchCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Search across all datasets and columns or, if provided, specific datasets and/or columns" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"datasets"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"TableName",
          String
"pattern"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"SummarizeCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
           String
"columns"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnAssignment",
           String
"by"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName"],

      String -> Type -> Element
def String
"TableName" Type
string,

      String -> Type -> Element
def String
"TopCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"count"String -> Type -> FieldType
>: Type
int32,
          String
"sort"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"SortBy"],

      String -> Type -> Element
def String
"SortBy" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"column"String -> Type -> FieldType
>: String -> Type
kql String
"ColumnName",
          String
"order"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Order"],

      String -> Type -> Element
def String
"TabularExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"command"String -> Type -> FieldType
>: String -> Type
kql String
"Command",
          String
"pipeline"String -> Type -> FieldType
>: String -> Type
kql String
"PipelineExpression",
          String
"let"String -> Type -> FieldType
>: String -> Type
kql String
"LetExpression",
          String
"table"String -> Type -> FieldType
>: String -> Type
kql String
"TableName"],

      String -> Type -> Element
def String
"UnaryExpression" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"operator"String -> Type -> FieldType
>: String -> Type
kql String
"UnaryOperator",
          String
"expression"String -> Type -> FieldType
>: String -> Type
kql String
"Expression"],

      String -> Type -> Element
def String
"UnaryOperator" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [String
"not"],

      String -> Type -> Element
def String
"UnionCommand" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"parameters"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"Parameter",
          String
"kind"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"UnionKind",
          String
"withSource"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"ColumnName",
          String
"isFuzzy"String -> Type -> FieldType
>: Type -> Type
optional Type
boolean,
          String
"tables"String -> Type -> FieldType
>: Type -> Type
nonemptyList (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
kql String
"TableName"],

      String -> Type -> Element
def String
"UnionKind" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$ [String] -> Type
enum [String
"inner", String
"outer"]]