{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Parquet.Delta where

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


deltaParquetModule :: Module
deltaParquetModule :: Module
deltaParquetModule = 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 Delta Parquet model")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/parquet/delta"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    delta :: String -> Type
delta = Namespace -> String -> Type
typeref Namespace
ns

    elements :: [Element]
elements = [
      String -> Type -> Element
def String
"ArrayType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"elementType"String -> Type -> FieldType
>: String -> Type
delta String
"DataType",
          String
"containsNull"String -> Type -> FieldType
>: Type
boolean],

      String -> Type -> Element
def String
"DataType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"array"String -> Type -> FieldType
>: String -> Type
delta String
"ArrayType",
          String
"binary"String -> Type -> FieldType
>: Type
unit,
          String
"boolean"String -> Type -> FieldType
>: Type
unit,
          String
"byte"String -> Type -> FieldType
>: Type
unit,
          String
"date"String -> Type -> FieldType
>: Type
unit,
          String
"decimal"String -> Type -> FieldType
>: String -> Type
delta String
"DecimalType",
          String
"double"String -> Type -> FieldType
>: Type
unit,
          String
"float"String -> Type -> FieldType
>: Type
unit,
          String
"integer"String -> Type -> FieldType
>: Type
unit,
          String
"long"String -> Type -> FieldType
>: Type
unit,
          String
"map"String -> Type -> FieldType
>: String -> Type
delta String
"MapType",
          String
"null"String -> Type -> FieldType
>: Type
unit,
          String
"short"String -> Type -> FieldType
>: Type
unit,
          String
"string"String -> Type -> FieldType
>: Type
unit,
          String
"struct"String -> Type -> FieldType
>: String -> Type
delta String
"StructType"],

      String -> Type -> Element
def String
"DecimalType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"precision"String -> Type -> FieldType
>: Type
int32,
          String
"scale"String -> Type -> FieldType
>: Type
int32],

      String -> Type -> Element
def String
"MapType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"keyType"String -> Type -> FieldType
>: String -> Type
delta String
"DataType",
          String
"valueType"String -> Type -> FieldType
>: String -> Type
delta String
"DataType",
          String
"valueContainsNull"String -> Type -> FieldType
>: Type
boolean],

      String -> Type -> Element
def String
"StructField" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: Type
string,
          String
"dataType"String -> Type -> FieldType
>: String -> Type
delta String
"DataType",
          String
"nullable"String -> Type -> FieldType
>: Type
boolean],

      String -> Type -> Element
def String
"StructType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"fields"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
delta String
"StructField"]]