{-# 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.Glacier.Types.SelectParameters
-- 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.Glacier.Types.SelectParameters where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glacier.Types.ExpressionType
import Amazonka.Glacier.Types.InputSerialization
import Amazonka.Glacier.Types.OutputSerialization
import qualified Amazonka.Prelude as Prelude

-- | Contains information about the parameters used for a select.
--
-- /See:/ 'newSelectParameters' smart constructor.
data SelectParameters = SelectParameters'
  { -- | The expression that is used to select the object.
    SelectParameters -> Maybe Text
expression :: Prelude.Maybe Prelude.Text,
    -- | The type of the provided expression, for example @SQL@.
    SelectParameters -> Maybe ExpressionType
expressionType :: Prelude.Maybe ExpressionType,
    -- | Describes the serialization format of the object.
    SelectParameters -> Maybe InputSerialization
inputSerialization :: Prelude.Maybe InputSerialization,
    -- | Describes how the results of the select job are serialized.
    SelectParameters -> Maybe OutputSerialization
outputSerialization :: Prelude.Maybe OutputSerialization
  }
  deriving (SelectParameters -> SelectParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectParameters -> SelectParameters -> Bool
$c/= :: SelectParameters -> SelectParameters -> Bool
== :: SelectParameters -> SelectParameters -> Bool
$c== :: SelectParameters -> SelectParameters -> Bool
Prelude.Eq, ReadPrec [SelectParameters]
ReadPrec SelectParameters
Int -> ReadS SelectParameters
ReadS [SelectParameters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelectParameters]
$creadListPrec :: ReadPrec [SelectParameters]
readPrec :: ReadPrec SelectParameters
$creadPrec :: ReadPrec SelectParameters
readList :: ReadS [SelectParameters]
$creadList :: ReadS [SelectParameters]
readsPrec :: Int -> ReadS SelectParameters
$creadsPrec :: Int -> ReadS SelectParameters
Prelude.Read, Int -> SelectParameters -> ShowS
[SelectParameters] -> ShowS
SelectParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectParameters] -> ShowS
$cshowList :: [SelectParameters] -> ShowS
show :: SelectParameters -> String
$cshow :: SelectParameters -> String
showsPrec :: Int -> SelectParameters -> ShowS
$cshowsPrec :: Int -> SelectParameters -> ShowS
Prelude.Show, forall x. Rep SelectParameters x -> SelectParameters
forall x. SelectParameters -> Rep SelectParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SelectParameters x -> SelectParameters
$cfrom :: forall x. SelectParameters -> Rep SelectParameters x
Prelude.Generic)

-- |
-- Create a value of 'SelectParameters' 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:
--
-- 'expression', 'selectParameters_expression' - The expression that is used to select the object.
--
-- 'expressionType', 'selectParameters_expressionType' - The type of the provided expression, for example @SQL@.
--
-- 'inputSerialization', 'selectParameters_inputSerialization' - Describes the serialization format of the object.
--
-- 'outputSerialization', 'selectParameters_outputSerialization' - Describes how the results of the select job are serialized.
newSelectParameters ::
  SelectParameters
newSelectParameters :: SelectParameters
newSelectParameters =
  SelectParameters'
    { $sel:expression:SelectParameters' :: Maybe Text
expression = forall a. Maybe a
Prelude.Nothing,
      $sel:expressionType:SelectParameters' :: Maybe ExpressionType
expressionType = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSerialization:SelectParameters' :: Maybe InputSerialization
inputSerialization = forall a. Maybe a
Prelude.Nothing,
      $sel:outputSerialization:SelectParameters' :: Maybe OutputSerialization
outputSerialization = forall a. Maybe a
Prelude.Nothing
    }

-- | The expression that is used to select the object.
selectParameters_expression :: Lens.Lens' SelectParameters (Prelude.Maybe Prelude.Text)
selectParameters_expression :: Lens' SelectParameters (Maybe Text)
selectParameters_expression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SelectParameters' {Maybe Text
expression :: Maybe Text
$sel:expression:SelectParameters' :: SelectParameters -> Maybe Text
expression} -> Maybe Text
expression) (\s :: SelectParameters
s@SelectParameters' {} Maybe Text
a -> SelectParameters
s {$sel:expression:SelectParameters' :: Maybe Text
expression = Maybe Text
a} :: SelectParameters)

-- | The type of the provided expression, for example @SQL@.
selectParameters_expressionType :: Lens.Lens' SelectParameters (Prelude.Maybe ExpressionType)
selectParameters_expressionType :: Lens' SelectParameters (Maybe ExpressionType)
selectParameters_expressionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SelectParameters' {Maybe ExpressionType
expressionType :: Maybe ExpressionType
$sel:expressionType:SelectParameters' :: SelectParameters -> Maybe ExpressionType
expressionType} -> Maybe ExpressionType
expressionType) (\s :: SelectParameters
s@SelectParameters' {} Maybe ExpressionType
a -> SelectParameters
s {$sel:expressionType:SelectParameters' :: Maybe ExpressionType
expressionType = Maybe ExpressionType
a} :: SelectParameters)

-- | Describes the serialization format of the object.
selectParameters_inputSerialization :: Lens.Lens' SelectParameters (Prelude.Maybe InputSerialization)
selectParameters_inputSerialization :: Lens' SelectParameters (Maybe InputSerialization)
selectParameters_inputSerialization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SelectParameters' {Maybe InputSerialization
inputSerialization :: Maybe InputSerialization
$sel:inputSerialization:SelectParameters' :: SelectParameters -> Maybe InputSerialization
inputSerialization} -> Maybe InputSerialization
inputSerialization) (\s :: SelectParameters
s@SelectParameters' {} Maybe InputSerialization
a -> SelectParameters
s {$sel:inputSerialization:SelectParameters' :: Maybe InputSerialization
inputSerialization = Maybe InputSerialization
a} :: SelectParameters)

-- | Describes how the results of the select job are serialized.
selectParameters_outputSerialization :: Lens.Lens' SelectParameters (Prelude.Maybe OutputSerialization)
selectParameters_outputSerialization :: Lens' SelectParameters (Maybe OutputSerialization)
selectParameters_outputSerialization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SelectParameters' {Maybe OutputSerialization
outputSerialization :: Maybe OutputSerialization
$sel:outputSerialization:SelectParameters' :: SelectParameters -> Maybe OutputSerialization
outputSerialization} -> Maybe OutputSerialization
outputSerialization) (\s :: SelectParameters
s@SelectParameters' {} Maybe OutputSerialization
a -> SelectParameters
s {$sel:outputSerialization:SelectParameters' :: Maybe OutputSerialization
outputSerialization = Maybe OutputSerialization
a} :: SelectParameters)

instance Data.FromJSON SelectParameters where
  parseJSON :: Value -> Parser SelectParameters
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SelectParameters"
      ( \Object
x ->
          Maybe Text
-> Maybe ExpressionType
-> Maybe InputSerialization
-> Maybe OutputSerialization
-> SelectParameters
SelectParameters'
            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
"Expression")
            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
"ExpressionType")
            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
"InputSerialization")
            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
"OutputSerialization")
      )

instance Prelude.Hashable SelectParameters where
  hashWithSalt :: Int -> SelectParameters -> Int
hashWithSalt Int
_salt SelectParameters' {Maybe Text
Maybe ExpressionType
Maybe InputSerialization
Maybe OutputSerialization
outputSerialization :: Maybe OutputSerialization
inputSerialization :: Maybe InputSerialization
expressionType :: Maybe ExpressionType
expression :: Maybe Text
$sel:outputSerialization:SelectParameters' :: SelectParameters -> Maybe OutputSerialization
$sel:inputSerialization:SelectParameters' :: SelectParameters -> Maybe InputSerialization
$sel:expressionType:SelectParameters' :: SelectParameters -> Maybe ExpressionType
$sel:expression:SelectParameters' :: SelectParameters -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExpressionType
expressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InputSerialization
inputSerialization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputSerialization
outputSerialization

instance Prelude.NFData SelectParameters where
  rnf :: SelectParameters -> ()
rnf SelectParameters' {Maybe Text
Maybe ExpressionType
Maybe InputSerialization
Maybe OutputSerialization
outputSerialization :: Maybe OutputSerialization
inputSerialization :: Maybe InputSerialization
expressionType :: Maybe ExpressionType
expression :: Maybe Text
$sel:outputSerialization:SelectParameters' :: SelectParameters -> Maybe OutputSerialization
$sel:inputSerialization:SelectParameters' :: SelectParameters -> Maybe InputSerialization
$sel:expressionType:SelectParameters' :: SelectParameters -> Maybe ExpressionType
$sel:expression:SelectParameters' :: SelectParameters -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExpressionType
expressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InputSerialization
inputSerialization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputSerialization
outputSerialization

instance Data.ToJSON SelectParameters where
  toJSON :: SelectParameters -> Value
toJSON SelectParameters' {Maybe Text
Maybe ExpressionType
Maybe InputSerialization
Maybe OutputSerialization
outputSerialization :: Maybe OutputSerialization
inputSerialization :: Maybe InputSerialization
expressionType :: Maybe ExpressionType
expression :: Maybe Text
$sel:outputSerialization:SelectParameters' :: SelectParameters -> Maybe OutputSerialization
$sel:inputSerialization:SelectParameters' :: SelectParameters -> Maybe InputSerialization
$sel:expressionType:SelectParameters' :: SelectParameters -> Maybe ExpressionType
$sel:expression:SelectParameters' :: SelectParameters -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Expression" 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
expression,
            (Key
"ExpressionType" 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 ExpressionType
expressionType,
            (Key
"InputSerialization" 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 InputSerialization
inputSerialization,
            (Key
"OutputSerialization" 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 OutputSerialization
outputSerialization
          ]
      )