{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Firehose.Types.OrcSerDe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Firehose.Types.OrcSerDe where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Firehose.Types.OrcCompression
import Amazonka.Firehose.Types.OrcFormatVersion
import qualified Amazonka.Prelude as Prelude

-- | A serializer to use for converting data to the ORC format before storing
-- it in Amazon S3. For more information, see
-- <https://orc.apache.org/docs/ Apache ORC>.
--
-- /See:/ 'newOrcSerDe' smart constructor.
data OrcSerDe = OrcSerDe'
  { -- | The Hadoop Distributed File System (HDFS) block size. This is useful if
    -- you intend to copy the data from Amazon S3 to HDFS before querying. The
    -- default is 256 MiB and the minimum is 64 MiB. Kinesis Data Firehose uses
    -- this value for padding calculations.
    OrcSerDe -> Maybe Natural
blockSizeBytes :: Prelude.Maybe Prelude.Natural,
    -- | The column names for which you want Kinesis Data Firehose to create
    -- bloom filters. The default is @null@.
    OrcSerDe -> Maybe [Text]
bloomFilterColumns :: Prelude.Maybe [Prelude.Text],
    -- | The Bloom filter false positive probability (FPP). The lower the FPP,
    -- the bigger the Bloom filter. The default value is 0.05, the minimum is
    -- 0, and the maximum is 1.
    OrcSerDe -> Maybe Double
bloomFilterFalsePositiveProbability :: Prelude.Maybe Prelude.Double,
    -- | The compression code to use over data blocks. The default is @SNAPPY@.
    OrcSerDe -> Maybe OrcCompression
compression :: Prelude.Maybe OrcCompression,
    -- | Represents the fraction of the total number of non-null rows. To turn
    -- off dictionary encoding, set this fraction to a number that is less than
    -- the number of distinct keys in a dictionary. To always use dictionary
    -- encoding, set this threshold to 1.
    OrcSerDe -> Maybe Double
dictionaryKeyThreshold :: Prelude.Maybe Prelude.Double,
    -- | Set this to @true@ to indicate that you want stripes to be padded to the
    -- HDFS block boundaries. This is useful if you intend to copy the data
    -- from Amazon S3 to HDFS before querying. The default is @false@.
    OrcSerDe -> Maybe Bool
enablePadding :: Prelude.Maybe Prelude.Bool,
    -- | The version of the file to write. The possible values are @V0_11@ and
    -- @V0_12@. The default is @V0_12@.
    OrcSerDe -> Maybe OrcFormatVersion
formatVersion :: Prelude.Maybe OrcFormatVersion,
    -- | A number between 0 and 1 that defines the tolerance for block padding as
    -- a decimal fraction of stripe size. The default value is 0.05, which
    -- means 5 percent of stripe size.
    --
    -- For the default values of 64 MiB ORC stripes and 256 MiB HDFS blocks,
    -- the default block padding tolerance of 5 percent reserves a maximum of
    -- 3.2 MiB for padding within the 256 MiB block. In such a case, if the
    -- available size within the block is more than 3.2 MiB, a new, smaller
    -- stripe is inserted to fit within that space. This ensures that no stripe
    -- crosses block boundaries and causes remote reads within a node-local
    -- task.
    --
    -- Kinesis Data Firehose ignores this parameter when OrcSerDe$EnablePadding
    -- is @false@.
    OrcSerDe -> Maybe Double
paddingTolerance :: Prelude.Maybe Prelude.Double,
    -- | The number of rows between index entries. The default is 10,000 and the
    -- minimum is 1,000.
    OrcSerDe -> Maybe Natural
rowIndexStride :: Prelude.Maybe Prelude.Natural,
    -- | The number of bytes in each stripe. The default is 64 MiB and the
    -- minimum is 8 MiB.
    OrcSerDe -> Maybe Natural
stripeSizeBytes :: Prelude.Maybe Prelude.Natural
  }
  deriving (OrcSerDe -> OrcSerDe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrcSerDe -> OrcSerDe -> Bool
$c/= :: OrcSerDe -> OrcSerDe -> Bool
== :: OrcSerDe -> OrcSerDe -> Bool
$c== :: OrcSerDe -> OrcSerDe -> Bool
Prelude.Eq, ReadPrec [OrcSerDe]
ReadPrec OrcSerDe
Int -> ReadS OrcSerDe
ReadS [OrcSerDe]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrcSerDe]
$creadListPrec :: ReadPrec [OrcSerDe]
readPrec :: ReadPrec OrcSerDe
$creadPrec :: ReadPrec OrcSerDe
readList :: ReadS [OrcSerDe]
$creadList :: ReadS [OrcSerDe]
readsPrec :: Int -> ReadS OrcSerDe
$creadsPrec :: Int -> ReadS OrcSerDe
Prelude.Read, Int -> OrcSerDe -> ShowS
[OrcSerDe] -> ShowS
OrcSerDe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrcSerDe] -> ShowS
$cshowList :: [OrcSerDe] -> ShowS
show :: OrcSerDe -> String
$cshow :: OrcSerDe -> String
showsPrec :: Int -> OrcSerDe -> ShowS
$cshowsPrec :: Int -> OrcSerDe -> ShowS
Prelude.Show, forall x. Rep OrcSerDe x -> OrcSerDe
forall x. OrcSerDe -> Rep OrcSerDe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrcSerDe x -> OrcSerDe
$cfrom :: forall x. OrcSerDe -> Rep OrcSerDe x
Prelude.Generic)

-- |
-- Create a value of 'OrcSerDe' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'blockSizeBytes', 'orcSerDe_blockSizeBytes' - The Hadoop Distributed File System (HDFS) block size. This is useful if
-- you intend to copy the data from Amazon S3 to HDFS before querying. The
-- default is 256 MiB and the minimum is 64 MiB. Kinesis Data Firehose uses
-- this value for padding calculations.
--
-- 'bloomFilterColumns', 'orcSerDe_bloomFilterColumns' - The column names for which you want Kinesis Data Firehose to create
-- bloom filters. The default is @null@.
--
-- 'bloomFilterFalsePositiveProbability', 'orcSerDe_bloomFilterFalsePositiveProbability' - The Bloom filter false positive probability (FPP). The lower the FPP,
-- the bigger the Bloom filter. The default value is 0.05, the minimum is
-- 0, and the maximum is 1.
--
-- 'compression', 'orcSerDe_compression' - The compression code to use over data blocks. The default is @SNAPPY@.
--
-- 'dictionaryKeyThreshold', 'orcSerDe_dictionaryKeyThreshold' - Represents the fraction of the total number of non-null rows. To turn
-- off dictionary encoding, set this fraction to a number that is less than
-- the number of distinct keys in a dictionary. To always use dictionary
-- encoding, set this threshold to 1.
--
-- 'enablePadding', 'orcSerDe_enablePadding' - Set this to @true@ to indicate that you want stripes to be padded to the
-- HDFS block boundaries. This is useful if you intend to copy the data
-- from Amazon S3 to HDFS before querying. The default is @false@.
--
-- 'formatVersion', 'orcSerDe_formatVersion' - The version of the file to write. The possible values are @V0_11@ and
-- @V0_12@. The default is @V0_12@.
--
-- 'paddingTolerance', 'orcSerDe_paddingTolerance' - A number between 0 and 1 that defines the tolerance for block padding as
-- a decimal fraction of stripe size. The default value is 0.05, which
-- means 5 percent of stripe size.
--
-- For the default values of 64 MiB ORC stripes and 256 MiB HDFS blocks,
-- the default block padding tolerance of 5 percent reserves a maximum of
-- 3.2 MiB for padding within the 256 MiB block. In such a case, if the
-- available size within the block is more than 3.2 MiB, a new, smaller
-- stripe is inserted to fit within that space. This ensures that no stripe
-- crosses block boundaries and causes remote reads within a node-local
-- task.
--
-- Kinesis Data Firehose ignores this parameter when OrcSerDe$EnablePadding
-- is @false@.
--
-- 'rowIndexStride', 'orcSerDe_rowIndexStride' - The number of rows between index entries. The default is 10,000 and the
-- minimum is 1,000.
--
-- 'stripeSizeBytes', 'orcSerDe_stripeSizeBytes' - The number of bytes in each stripe. The default is 64 MiB and the
-- minimum is 8 MiB.
newOrcSerDe ::
  OrcSerDe
newOrcSerDe :: OrcSerDe
newOrcSerDe =
  OrcSerDe'
    { $sel:blockSizeBytes:OrcSerDe' :: Maybe Natural
blockSizeBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:bloomFilterColumns:OrcSerDe' :: Maybe [Text]
bloomFilterColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: Maybe Double
bloomFilterFalsePositiveProbability =
        forall a. Maybe a
Prelude.Nothing,
      $sel:compression:OrcSerDe' :: Maybe OrcCompression
compression = forall a. Maybe a
Prelude.Nothing,
      $sel:dictionaryKeyThreshold:OrcSerDe' :: Maybe Double
dictionaryKeyThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:enablePadding:OrcSerDe' :: Maybe Bool
enablePadding = forall a. Maybe a
Prelude.Nothing,
      $sel:formatVersion:OrcSerDe' :: Maybe OrcFormatVersion
formatVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:paddingTolerance:OrcSerDe' :: Maybe Double
paddingTolerance = forall a. Maybe a
Prelude.Nothing,
      $sel:rowIndexStride:OrcSerDe' :: Maybe Natural
rowIndexStride = forall a. Maybe a
Prelude.Nothing,
      $sel:stripeSizeBytes:OrcSerDe' :: Maybe Natural
stripeSizeBytes = forall a. Maybe a
Prelude.Nothing
    }

-- | The Hadoop Distributed File System (HDFS) block size. This is useful if
-- you intend to copy the data from Amazon S3 to HDFS before querying. The
-- default is 256 MiB and the minimum is 64 MiB. Kinesis Data Firehose uses
-- this value for padding calculations.
orcSerDe_blockSizeBytes :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Natural)
orcSerDe_blockSizeBytes :: Lens' OrcSerDe (Maybe Natural)
orcSerDe_blockSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Natural
blockSizeBytes :: Maybe Natural
$sel:blockSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
blockSizeBytes} -> Maybe Natural
blockSizeBytes) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Natural
a -> OrcSerDe
s {$sel:blockSizeBytes:OrcSerDe' :: Maybe Natural
blockSizeBytes = Maybe Natural
a} :: OrcSerDe)

-- | The column names for which you want Kinesis Data Firehose to create
-- bloom filters. The default is @null@.
orcSerDe_bloomFilterColumns :: Lens.Lens' OrcSerDe (Prelude.Maybe [Prelude.Text])
orcSerDe_bloomFilterColumns :: Lens' OrcSerDe (Maybe [Text])
orcSerDe_bloomFilterColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe [Text]
bloomFilterColumns :: Maybe [Text]
$sel:bloomFilterColumns:OrcSerDe' :: OrcSerDe -> Maybe [Text]
bloomFilterColumns} -> Maybe [Text]
bloomFilterColumns) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe [Text]
a -> OrcSerDe
s {$sel:bloomFilterColumns:OrcSerDe' :: Maybe [Text]
bloomFilterColumns = Maybe [Text]
a} :: OrcSerDe) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Bloom filter false positive probability (FPP). The lower the FPP,
-- the bigger the Bloom filter. The default value is 0.05, the minimum is
-- 0, and the maximum is 1.
orcSerDe_bloomFilterFalsePositiveProbability :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Double)
orcSerDe_bloomFilterFalsePositiveProbability :: Lens' OrcSerDe (Maybe Double)
orcSerDe_bloomFilterFalsePositiveProbability = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Double
bloomFilterFalsePositiveProbability :: Maybe Double
$sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: OrcSerDe -> Maybe Double
bloomFilterFalsePositiveProbability} -> Maybe Double
bloomFilterFalsePositiveProbability) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Double
a -> OrcSerDe
s {$sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: Maybe Double
bloomFilterFalsePositiveProbability = Maybe Double
a} :: OrcSerDe)

-- | The compression code to use over data blocks. The default is @SNAPPY@.
orcSerDe_compression :: Lens.Lens' OrcSerDe (Prelude.Maybe OrcCompression)
orcSerDe_compression :: Lens' OrcSerDe (Maybe OrcCompression)
orcSerDe_compression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe OrcCompression
compression :: Maybe OrcCompression
$sel:compression:OrcSerDe' :: OrcSerDe -> Maybe OrcCompression
compression} -> Maybe OrcCompression
compression) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe OrcCompression
a -> OrcSerDe
s {$sel:compression:OrcSerDe' :: Maybe OrcCompression
compression = Maybe OrcCompression
a} :: OrcSerDe)

-- | Represents the fraction of the total number of non-null rows. To turn
-- off dictionary encoding, set this fraction to a number that is less than
-- the number of distinct keys in a dictionary. To always use dictionary
-- encoding, set this threshold to 1.
orcSerDe_dictionaryKeyThreshold :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Double)
orcSerDe_dictionaryKeyThreshold :: Lens' OrcSerDe (Maybe Double)
orcSerDe_dictionaryKeyThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Double
dictionaryKeyThreshold :: Maybe Double
$sel:dictionaryKeyThreshold:OrcSerDe' :: OrcSerDe -> Maybe Double
dictionaryKeyThreshold} -> Maybe Double
dictionaryKeyThreshold) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Double
a -> OrcSerDe
s {$sel:dictionaryKeyThreshold:OrcSerDe' :: Maybe Double
dictionaryKeyThreshold = Maybe Double
a} :: OrcSerDe)

-- | Set this to @true@ to indicate that you want stripes to be padded to the
-- HDFS block boundaries. This is useful if you intend to copy the data
-- from Amazon S3 to HDFS before querying. The default is @false@.
orcSerDe_enablePadding :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Bool)
orcSerDe_enablePadding :: Lens' OrcSerDe (Maybe Bool)
orcSerDe_enablePadding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Bool
enablePadding :: Maybe Bool
$sel:enablePadding:OrcSerDe' :: OrcSerDe -> Maybe Bool
enablePadding} -> Maybe Bool
enablePadding) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Bool
a -> OrcSerDe
s {$sel:enablePadding:OrcSerDe' :: Maybe Bool
enablePadding = Maybe Bool
a} :: OrcSerDe)

-- | The version of the file to write. The possible values are @V0_11@ and
-- @V0_12@. The default is @V0_12@.
orcSerDe_formatVersion :: Lens.Lens' OrcSerDe (Prelude.Maybe OrcFormatVersion)
orcSerDe_formatVersion :: Lens' OrcSerDe (Maybe OrcFormatVersion)
orcSerDe_formatVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe OrcFormatVersion
formatVersion :: Maybe OrcFormatVersion
$sel:formatVersion:OrcSerDe' :: OrcSerDe -> Maybe OrcFormatVersion
formatVersion} -> Maybe OrcFormatVersion
formatVersion) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe OrcFormatVersion
a -> OrcSerDe
s {$sel:formatVersion:OrcSerDe' :: Maybe OrcFormatVersion
formatVersion = Maybe OrcFormatVersion
a} :: OrcSerDe)

-- | A number between 0 and 1 that defines the tolerance for block padding as
-- a decimal fraction of stripe size. The default value is 0.05, which
-- means 5 percent of stripe size.
--
-- For the default values of 64 MiB ORC stripes and 256 MiB HDFS blocks,
-- the default block padding tolerance of 5 percent reserves a maximum of
-- 3.2 MiB for padding within the 256 MiB block. In such a case, if the
-- available size within the block is more than 3.2 MiB, a new, smaller
-- stripe is inserted to fit within that space. This ensures that no stripe
-- crosses block boundaries and causes remote reads within a node-local
-- task.
--
-- Kinesis Data Firehose ignores this parameter when OrcSerDe$EnablePadding
-- is @false@.
orcSerDe_paddingTolerance :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Double)
orcSerDe_paddingTolerance :: Lens' OrcSerDe (Maybe Double)
orcSerDe_paddingTolerance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Double
paddingTolerance :: Maybe Double
$sel:paddingTolerance:OrcSerDe' :: OrcSerDe -> Maybe Double
paddingTolerance} -> Maybe Double
paddingTolerance) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Double
a -> OrcSerDe
s {$sel:paddingTolerance:OrcSerDe' :: Maybe Double
paddingTolerance = Maybe Double
a} :: OrcSerDe)

-- | The number of rows between index entries. The default is 10,000 and the
-- minimum is 1,000.
orcSerDe_rowIndexStride :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Natural)
orcSerDe_rowIndexStride :: Lens' OrcSerDe (Maybe Natural)
orcSerDe_rowIndexStride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Natural
rowIndexStride :: Maybe Natural
$sel:rowIndexStride:OrcSerDe' :: OrcSerDe -> Maybe Natural
rowIndexStride} -> Maybe Natural
rowIndexStride) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Natural
a -> OrcSerDe
s {$sel:rowIndexStride:OrcSerDe' :: Maybe Natural
rowIndexStride = Maybe Natural
a} :: OrcSerDe)

-- | The number of bytes in each stripe. The default is 64 MiB and the
-- minimum is 8 MiB.
orcSerDe_stripeSizeBytes :: Lens.Lens' OrcSerDe (Prelude.Maybe Prelude.Natural)
orcSerDe_stripeSizeBytes :: Lens' OrcSerDe (Maybe Natural)
orcSerDe_stripeSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\OrcSerDe' {Maybe Natural
stripeSizeBytes :: Maybe Natural
$sel:stripeSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
stripeSizeBytes} -> Maybe Natural
stripeSizeBytes) (\s :: OrcSerDe
s@OrcSerDe' {} Maybe Natural
a -> OrcSerDe
s {$sel:stripeSizeBytes:OrcSerDe' :: Maybe Natural
stripeSizeBytes = Maybe Natural
a} :: OrcSerDe)

instance Data.FromJSON OrcSerDe where
  parseJSON :: Value -> Parser OrcSerDe
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"OrcSerDe"
      ( \Object
x ->
          Maybe Natural
-> Maybe [Text]
-> Maybe Double
-> Maybe OrcCompression
-> Maybe Double
-> Maybe Bool
-> Maybe OrcFormatVersion
-> Maybe Double
-> Maybe Natural
-> Maybe Natural
-> OrcSerDe
OrcSerDe'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BlockSizeBytes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BloomFilterColumns"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BloomFilterFalsePositiveProbability")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Compression")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DictionaryKeyThreshold")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EnablePadding")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"FormatVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PaddingTolerance")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RowIndexStride")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StripeSizeBytes")
      )

instance Prelude.Hashable OrcSerDe where
  hashWithSalt :: Int -> OrcSerDe -> Int
hashWithSalt Int
_salt OrcSerDe' {Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe OrcCompression
Maybe OrcFormatVersion
stripeSizeBytes :: Maybe Natural
rowIndexStride :: Maybe Natural
paddingTolerance :: Maybe Double
formatVersion :: Maybe OrcFormatVersion
enablePadding :: Maybe Bool
dictionaryKeyThreshold :: Maybe Double
compression :: Maybe OrcCompression
bloomFilterFalsePositiveProbability :: Maybe Double
bloomFilterColumns :: Maybe [Text]
blockSizeBytes :: Maybe Natural
$sel:stripeSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:rowIndexStride:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:paddingTolerance:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:formatVersion:OrcSerDe' :: OrcSerDe -> Maybe OrcFormatVersion
$sel:enablePadding:OrcSerDe' :: OrcSerDe -> Maybe Bool
$sel:dictionaryKeyThreshold:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:compression:OrcSerDe' :: OrcSerDe -> Maybe OrcCompression
$sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:bloomFilterColumns:OrcSerDe' :: OrcSerDe -> Maybe [Text]
$sel:blockSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
blockSizeBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
bloomFilterColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
bloomFilterFalsePositiveProbability
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrcCompression
compression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
dictionaryKeyThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enablePadding
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrcFormatVersion
formatVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
paddingTolerance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
rowIndexStride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
stripeSizeBytes

instance Prelude.NFData OrcSerDe where
  rnf :: OrcSerDe -> ()
rnf OrcSerDe' {Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe OrcCompression
Maybe OrcFormatVersion
stripeSizeBytes :: Maybe Natural
rowIndexStride :: Maybe Natural
paddingTolerance :: Maybe Double
formatVersion :: Maybe OrcFormatVersion
enablePadding :: Maybe Bool
dictionaryKeyThreshold :: Maybe Double
compression :: Maybe OrcCompression
bloomFilterFalsePositiveProbability :: Maybe Double
bloomFilterColumns :: Maybe [Text]
blockSizeBytes :: Maybe Natural
$sel:stripeSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:rowIndexStride:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:paddingTolerance:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:formatVersion:OrcSerDe' :: OrcSerDe -> Maybe OrcFormatVersion
$sel:enablePadding:OrcSerDe' :: OrcSerDe -> Maybe Bool
$sel:dictionaryKeyThreshold:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:compression:OrcSerDe' :: OrcSerDe -> Maybe OrcCompression
$sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:bloomFilterColumns:OrcSerDe' :: OrcSerDe -> Maybe [Text]
$sel:blockSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
blockSizeBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
bloomFilterColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
bloomFilterFalsePositiveProbability
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrcCompression
compression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
dictionaryKeyThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enablePadding
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrcFormatVersion
formatVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
paddingTolerance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
rowIndexStride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
stripeSizeBytes

instance Data.ToJSON OrcSerDe where
  toJSON :: OrcSerDe -> Value
toJSON OrcSerDe' {Maybe Bool
Maybe Double
Maybe Natural
Maybe [Text]
Maybe OrcCompression
Maybe OrcFormatVersion
stripeSizeBytes :: Maybe Natural
rowIndexStride :: Maybe Natural
paddingTolerance :: Maybe Double
formatVersion :: Maybe OrcFormatVersion
enablePadding :: Maybe Bool
dictionaryKeyThreshold :: Maybe Double
compression :: Maybe OrcCompression
bloomFilterFalsePositiveProbability :: Maybe Double
bloomFilterColumns :: Maybe [Text]
blockSizeBytes :: Maybe Natural
$sel:stripeSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:rowIndexStride:OrcSerDe' :: OrcSerDe -> Maybe Natural
$sel:paddingTolerance:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:formatVersion:OrcSerDe' :: OrcSerDe -> Maybe OrcFormatVersion
$sel:enablePadding:OrcSerDe' :: OrcSerDe -> Maybe Bool
$sel:dictionaryKeyThreshold:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:compression:OrcSerDe' :: OrcSerDe -> Maybe OrcCompression
$sel:bloomFilterFalsePositiveProbability:OrcSerDe' :: OrcSerDe -> Maybe Double
$sel:bloomFilterColumns:OrcSerDe' :: OrcSerDe -> Maybe [Text]
$sel:blockSizeBytes:OrcSerDe' :: OrcSerDe -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BlockSizeBytes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
blockSizeBytes,
            (Key
"BloomFilterColumns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
bloomFilterColumns,
            (Key
"BloomFilterFalsePositiveProbability" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Double
bloomFilterFalsePositiveProbability,
            (Key
"Compression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OrcCompression
compression,
            (Key
"DictionaryKeyThreshold" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Double
dictionaryKeyThreshold,
            (Key
"EnablePadding" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
enablePadding,
            (Key
"FormatVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OrcFormatVersion
formatVersion,
            (Key
"PaddingTolerance" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Double
paddingTolerance,
            (Key
"RowIndexStride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
rowIndexStride,
            (Key
"StripeSizeBytes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
stripeSizeBytes
          ]
      )