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

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

-- |
-- Module      : Amazonka.Glue.GetPlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets code to perform a specified mapping.
module Amazonka.Glue.GetPlan
  ( -- * Creating a Request
    GetPlan (..),
    newGetPlan,

    -- * Request Lenses
    getPlan_additionalPlanOptionsMap,
    getPlan_language,
    getPlan_location,
    getPlan_sinks,
    getPlan_mapping,
    getPlan_source,

    -- * Destructuring the Response
    GetPlanResponse (..),
    newGetPlanResponse,

    -- * Response Lenses
    getPlanResponse_pythonScript,
    getPlanResponse_scalaCode,
    getPlanResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetPlan' smart constructor.
data GetPlan = GetPlan'
  { -- | A map to hold additional optional key-value parameters.
    --
    -- Currently, these key-value pairs are supported:
    --
    -- -   @inferSchema@  —  Specifies whether to set @inferSchema@ to true or
    --     false for the default script generated by an Glue job. For example,
    --     to set @inferSchema@ to true, pass the following key value pair:
    --
    --     @--additional-plan-options-map \'{\"inferSchema\":\"true\"}\'@
    GetPlan -> Maybe (HashMap Text Text)
additionalPlanOptionsMap :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The programming language of the code to perform the mapping.
    GetPlan -> Maybe Language
language :: Prelude.Maybe Language,
    -- | The parameters for the mapping.
    GetPlan -> Maybe Location
location :: Prelude.Maybe Location,
    -- | The target tables.
    GetPlan -> Maybe [CatalogEntry]
sinks :: Prelude.Maybe [CatalogEntry],
    -- | The list of mappings from a source table to target tables.
    GetPlan -> [MappingEntry]
mapping :: [MappingEntry],
    -- | The source table.
    GetPlan -> CatalogEntry
source :: CatalogEntry
  }
  deriving (GetPlan -> GetPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlan -> GetPlan -> Bool
$c/= :: GetPlan -> GetPlan -> Bool
== :: GetPlan -> GetPlan -> Bool
$c== :: GetPlan -> GetPlan -> Bool
Prelude.Eq, ReadPrec [GetPlan]
ReadPrec GetPlan
Int -> ReadS GetPlan
ReadS [GetPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPlan]
$creadListPrec :: ReadPrec [GetPlan]
readPrec :: ReadPrec GetPlan
$creadPrec :: ReadPrec GetPlan
readList :: ReadS [GetPlan]
$creadList :: ReadS [GetPlan]
readsPrec :: Int -> ReadS GetPlan
$creadsPrec :: Int -> ReadS GetPlan
Prelude.Read, Int -> GetPlan -> ShowS
[GetPlan] -> ShowS
GetPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlan] -> ShowS
$cshowList :: [GetPlan] -> ShowS
show :: GetPlan -> String
$cshow :: GetPlan -> String
showsPrec :: Int -> GetPlan -> ShowS
$cshowsPrec :: Int -> GetPlan -> ShowS
Prelude.Show, forall x. Rep GetPlan x -> GetPlan
forall x. GetPlan -> Rep GetPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPlan x -> GetPlan
$cfrom :: forall x. GetPlan -> Rep GetPlan x
Prelude.Generic)

-- |
-- Create a value of 'GetPlan' 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:
--
-- 'additionalPlanOptionsMap', 'getPlan_additionalPlanOptionsMap' - A map to hold additional optional key-value parameters.
--
-- Currently, these key-value pairs are supported:
--
-- -   @inferSchema@  —  Specifies whether to set @inferSchema@ to true or
--     false for the default script generated by an Glue job. For example,
--     to set @inferSchema@ to true, pass the following key value pair:
--
--     @--additional-plan-options-map \'{\"inferSchema\":\"true\"}\'@
--
-- 'language', 'getPlan_language' - The programming language of the code to perform the mapping.
--
-- 'location', 'getPlan_location' - The parameters for the mapping.
--
-- 'sinks', 'getPlan_sinks' - The target tables.
--
-- 'mapping', 'getPlan_mapping' - The list of mappings from a source table to target tables.
--
-- 'source', 'getPlan_source' - The source table.
newGetPlan ::
  -- | 'source'
  CatalogEntry ->
  GetPlan
newGetPlan :: CatalogEntry -> GetPlan
newGetPlan CatalogEntry
pSource_ =
  GetPlan'
    { $sel:additionalPlanOptionsMap:GetPlan' :: Maybe (HashMap Text Text)
additionalPlanOptionsMap =
        forall a. Maybe a
Prelude.Nothing,
      $sel:language:GetPlan' :: Maybe Language
language = forall a. Maybe a
Prelude.Nothing,
      $sel:location:GetPlan' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
      $sel:sinks:GetPlan' :: Maybe [CatalogEntry]
sinks = forall a. Maybe a
Prelude.Nothing,
      $sel:mapping:GetPlan' :: [MappingEntry]
mapping = forall a. Monoid a => a
Prelude.mempty,
      $sel:source:GetPlan' :: CatalogEntry
source = CatalogEntry
pSource_
    }

-- | A map to hold additional optional key-value parameters.
--
-- Currently, these key-value pairs are supported:
--
-- -   @inferSchema@  —  Specifies whether to set @inferSchema@ to true or
--     false for the default script generated by an Glue job. For example,
--     to set @inferSchema@ to true, pass the following key value pair:
--
--     @--additional-plan-options-map \'{\"inferSchema\":\"true\"}\'@
getPlan_additionalPlanOptionsMap :: Lens.Lens' GetPlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getPlan_additionalPlanOptionsMap :: Lens' GetPlan (Maybe (HashMap Text Text))
getPlan_additionalPlanOptionsMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {Maybe (HashMap Text Text)
additionalPlanOptionsMap :: Maybe (HashMap Text Text)
$sel:additionalPlanOptionsMap:GetPlan' :: GetPlan -> Maybe (HashMap Text Text)
additionalPlanOptionsMap} -> Maybe (HashMap Text Text)
additionalPlanOptionsMap) (\s :: GetPlan
s@GetPlan' {} Maybe (HashMap Text Text)
a -> GetPlan
s {$sel:additionalPlanOptionsMap:GetPlan' :: Maybe (HashMap Text Text)
additionalPlanOptionsMap = Maybe (HashMap Text Text)
a} :: GetPlan) 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 programming language of the code to perform the mapping.
getPlan_language :: Lens.Lens' GetPlan (Prelude.Maybe Language)
getPlan_language :: Lens' GetPlan (Maybe Language)
getPlan_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {Maybe Language
language :: Maybe Language
$sel:language:GetPlan' :: GetPlan -> Maybe Language
language} -> Maybe Language
language) (\s :: GetPlan
s@GetPlan' {} Maybe Language
a -> GetPlan
s {$sel:language:GetPlan' :: Maybe Language
language = Maybe Language
a} :: GetPlan)

-- | The parameters for the mapping.
getPlan_location :: Lens.Lens' GetPlan (Prelude.Maybe Location)
getPlan_location :: Lens' GetPlan (Maybe Location)
getPlan_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {Maybe Location
location :: Maybe Location
$sel:location:GetPlan' :: GetPlan -> Maybe Location
location} -> Maybe Location
location) (\s :: GetPlan
s@GetPlan' {} Maybe Location
a -> GetPlan
s {$sel:location:GetPlan' :: Maybe Location
location = Maybe Location
a} :: GetPlan)

-- | The target tables.
getPlan_sinks :: Lens.Lens' GetPlan (Prelude.Maybe [CatalogEntry])
getPlan_sinks :: Lens' GetPlan (Maybe [CatalogEntry])
getPlan_sinks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {Maybe [CatalogEntry]
sinks :: Maybe [CatalogEntry]
$sel:sinks:GetPlan' :: GetPlan -> Maybe [CatalogEntry]
sinks} -> Maybe [CatalogEntry]
sinks) (\s :: GetPlan
s@GetPlan' {} Maybe [CatalogEntry]
a -> GetPlan
s {$sel:sinks:GetPlan' :: Maybe [CatalogEntry]
sinks = Maybe [CatalogEntry]
a} :: GetPlan) 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 list of mappings from a source table to target tables.
getPlan_mapping :: Lens.Lens' GetPlan [MappingEntry]
getPlan_mapping :: Lens' GetPlan [MappingEntry]
getPlan_mapping = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {[MappingEntry]
mapping :: [MappingEntry]
$sel:mapping:GetPlan' :: GetPlan -> [MappingEntry]
mapping} -> [MappingEntry]
mapping) (\s :: GetPlan
s@GetPlan' {} [MappingEntry]
a -> GetPlan
s {$sel:mapping:GetPlan' :: [MappingEntry]
mapping = [MappingEntry]
a} :: GetPlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The source table.
getPlan_source :: Lens.Lens' GetPlan CatalogEntry
getPlan_source :: Lens' GetPlan CatalogEntry
getPlan_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlan' {CatalogEntry
source :: CatalogEntry
$sel:source:GetPlan' :: GetPlan -> CatalogEntry
source} -> CatalogEntry
source) (\s :: GetPlan
s@GetPlan' {} CatalogEntry
a -> GetPlan
s {$sel:source:GetPlan' :: CatalogEntry
source = CatalogEntry
a} :: GetPlan)

instance Core.AWSRequest GetPlan where
  type AWSResponse GetPlan = GetPlanResponse
  request :: (Service -> Service) -> GetPlan -> Request GetPlan
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPlan)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Maybe Text -> Int -> GetPlanResponse
GetPlanResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PythonScript")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScalaCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetPlan where
  hashWithSalt :: Int -> GetPlan -> Int
hashWithSalt Int
_salt GetPlan' {[MappingEntry]
Maybe [CatalogEntry]
Maybe (HashMap Text Text)
Maybe Language
Maybe Location
CatalogEntry
source :: CatalogEntry
mapping :: [MappingEntry]
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
language :: Maybe Language
additionalPlanOptionsMap :: Maybe (HashMap Text Text)
$sel:source:GetPlan' :: GetPlan -> CatalogEntry
$sel:mapping:GetPlan' :: GetPlan -> [MappingEntry]
$sel:sinks:GetPlan' :: GetPlan -> Maybe [CatalogEntry]
$sel:location:GetPlan' :: GetPlan -> Maybe Location
$sel:language:GetPlan' :: GetPlan -> Maybe Language
$sel:additionalPlanOptionsMap:GetPlan' :: GetPlan -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
additionalPlanOptionsMap
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Language
language
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Location
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [CatalogEntry]
sinks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [MappingEntry]
mapping
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` CatalogEntry
source

instance Prelude.NFData GetPlan where
  rnf :: GetPlan -> ()
rnf GetPlan' {[MappingEntry]
Maybe [CatalogEntry]
Maybe (HashMap Text Text)
Maybe Language
Maybe Location
CatalogEntry
source :: CatalogEntry
mapping :: [MappingEntry]
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
language :: Maybe Language
additionalPlanOptionsMap :: Maybe (HashMap Text Text)
$sel:source:GetPlan' :: GetPlan -> CatalogEntry
$sel:mapping:GetPlan' :: GetPlan -> [MappingEntry]
$sel:sinks:GetPlan' :: GetPlan -> Maybe [CatalogEntry]
$sel:location:GetPlan' :: GetPlan -> Maybe Location
$sel:language:GetPlan' :: GetPlan -> Maybe Language
$sel:additionalPlanOptionsMap:GetPlan' :: GetPlan -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
additionalPlanOptionsMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Language
language
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Location
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [CatalogEntry]
sinks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [MappingEntry]
mapping
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CatalogEntry
source

instance Data.ToHeaders GetPlan where
  toHeaders :: GetPlan -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AWSGlue.GetPlan" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetPlan where
  toJSON :: GetPlan -> Value
toJSON GetPlan' {[MappingEntry]
Maybe [CatalogEntry]
Maybe (HashMap Text Text)
Maybe Language
Maybe Location
CatalogEntry
source :: CatalogEntry
mapping :: [MappingEntry]
sinks :: Maybe [CatalogEntry]
location :: Maybe Location
language :: Maybe Language
additionalPlanOptionsMap :: Maybe (HashMap Text Text)
$sel:source:GetPlan' :: GetPlan -> CatalogEntry
$sel:mapping:GetPlan' :: GetPlan -> [MappingEntry]
$sel:sinks:GetPlan' :: GetPlan -> Maybe [CatalogEntry]
$sel:location:GetPlan' :: GetPlan -> Maybe Location
$sel:language:GetPlan' :: GetPlan -> Maybe Language
$sel:additionalPlanOptionsMap:GetPlan' :: GetPlan -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AdditionalPlanOptionsMap" 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 (HashMap Text Text)
additionalPlanOptionsMap,
            (Key
"Language" 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 Language
language,
            (Key
"Location" 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 Location
location,
            (Key
"Sinks" 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 [CatalogEntry]
sinks,
            forall a. a -> Maybe a
Prelude.Just (Key
"Mapping" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [MappingEntry]
mapping),
            forall a. a -> Maybe a
Prelude.Just (Key
"Source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= CatalogEntry
source)
          ]
      )

instance Data.ToPath GetPlan where
  toPath :: GetPlan -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery GetPlan where
  toQuery :: GetPlan -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newGetPlanResponse' smart constructor.
data GetPlanResponse = GetPlanResponse'
  { -- | A Python script to perform the mapping.
    GetPlanResponse -> Maybe Text
pythonScript :: Prelude.Maybe Prelude.Text,
    -- | The Scala code to perform the mapping.
    GetPlanResponse -> Maybe Text
scalaCode :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPlanResponse -> GetPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPlanResponse -> GetPlanResponse -> Bool
$c/= :: GetPlanResponse -> GetPlanResponse -> Bool
== :: GetPlanResponse -> GetPlanResponse -> Bool
$c== :: GetPlanResponse -> GetPlanResponse -> Bool
Prelude.Eq, ReadPrec [GetPlanResponse]
ReadPrec GetPlanResponse
Int -> ReadS GetPlanResponse
ReadS [GetPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPlanResponse]
$creadListPrec :: ReadPrec [GetPlanResponse]
readPrec :: ReadPrec GetPlanResponse
$creadPrec :: ReadPrec GetPlanResponse
readList :: ReadS [GetPlanResponse]
$creadList :: ReadS [GetPlanResponse]
readsPrec :: Int -> ReadS GetPlanResponse
$creadsPrec :: Int -> ReadS GetPlanResponse
Prelude.Read, Int -> GetPlanResponse -> ShowS
[GetPlanResponse] -> ShowS
GetPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPlanResponse] -> ShowS
$cshowList :: [GetPlanResponse] -> ShowS
show :: GetPlanResponse -> String
$cshow :: GetPlanResponse -> String
showsPrec :: Int -> GetPlanResponse -> ShowS
$cshowsPrec :: Int -> GetPlanResponse -> ShowS
Prelude.Show, forall x. Rep GetPlanResponse x -> GetPlanResponse
forall x. GetPlanResponse -> Rep GetPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPlanResponse x -> GetPlanResponse
$cfrom :: forall x. GetPlanResponse -> Rep GetPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPlanResponse' 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:
--
-- 'pythonScript', 'getPlanResponse_pythonScript' - A Python script to perform the mapping.
--
-- 'scalaCode', 'getPlanResponse_scalaCode' - The Scala code to perform the mapping.
--
-- 'httpStatus', 'getPlanResponse_httpStatus' - The response's http status code.
newGetPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPlanResponse
newGetPlanResponse :: Int -> GetPlanResponse
newGetPlanResponse Int
pHttpStatus_ =
  GetPlanResponse'
    { $sel:pythonScript:GetPlanResponse' :: Maybe Text
pythonScript = forall a. Maybe a
Prelude.Nothing,
      $sel:scalaCode:GetPlanResponse' :: Maybe Text
scalaCode = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A Python script to perform the mapping.
getPlanResponse_pythonScript :: Lens.Lens' GetPlanResponse (Prelude.Maybe Prelude.Text)
getPlanResponse_pythonScript :: Lens' GetPlanResponse (Maybe Text)
getPlanResponse_pythonScript = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlanResponse' {Maybe Text
pythonScript :: Maybe Text
$sel:pythonScript:GetPlanResponse' :: GetPlanResponse -> Maybe Text
pythonScript} -> Maybe Text
pythonScript) (\s :: GetPlanResponse
s@GetPlanResponse' {} Maybe Text
a -> GetPlanResponse
s {$sel:pythonScript:GetPlanResponse' :: Maybe Text
pythonScript = Maybe Text
a} :: GetPlanResponse)

-- | The Scala code to perform the mapping.
getPlanResponse_scalaCode :: Lens.Lens' GetPlanResponse (Prelude.Maybe Prelude.Text)
getPlanResponse_scalaCode :: Lens' GetPlanResponse (Maybe Text)
getPlanResponse_scalaCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlanResponse' {Maybe Text
scalaCode :: Maybe Text
$sel:scalaCode:GetPlanResponse' :: GetPlanResponse -> Maybe Text
scalaCode} -> Maybe Text
scalaCode) (\s :: GetPlanResponse
s@GetPlanResponse' {} Maybe Text
a -> GetPlanResponse
s {$sel:scalaCode:GetPlanResponse' :: Maybe Text
scalaCode = Maybe Text
a} :: GetPlanResponse)

-- | The response's http status code.
getPlanResponse_httpStatus :: Lens.Lens' GetPlanResponse Prelude.Int
getPlanResponse_httpStatus :: Lens' GetPlanResponse Int
getPlanResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPlanResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetPlanResponse' :: GetPlanResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetPlanResponse
s@GetPlanResponse' {} Int
a -> GetPlanResponse
s {$sel:httpStatus:GetPlanResponse' :: Int
httpStatus = Int
a} :: GetPlanResponse)

instance Prelude.NFData GetPlanResponse where
  rnf :: GetPlanResponse -> ()
rnf GetPlanResponse' {Int
Maybe Text
httpStatus :: Int
scalaCode :: Maybe Text
pythonScript :: Maybe Text
$sel:httpStatus:GetPlanResponse' :: GetPlanResponse -> Int
$sel:scalaCode:GetPlanResponse' :: GetPlanResponse -> Maybe Text
$sel:pythonScript:GetPlanResponse' :: GetPlanResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pythonScript
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scalaCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus