{-# 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.Kendra.CreateThesaurus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a thesaurus for an index. The thesaurus contains a list of
-- synonyms in Solr format.
--
-- For an example of adding a thesaurus file to an index, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/index-synonyms-adding-thesaurus-file.html Adding custom synonyms to an index>.
module Amazonka.Kendra.CreateThesaurus
  ( -- * Creating a Request
    CreateThesaurus (..),
    newCreateThesaurus,

    -- * Request Lenses
    createThesaurus_clientToken,
    createThesaurus_description,
    createThesaurus_tags,
    createThesaurus_indexId,
    createThesaurus_name,
    createThesaurus_roleArn,
    createThesaurus_sourceS3Path,

    -- * Destructuring the Response
    CreateThesaurusResponse (..),
    newCreateThesaurusResponse,

    -- * Response Lenses
    createThesaurusResponse_id,
    createThesaurusResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateThesaurus' smart constructor.
data CreateThesaurus = CreateThesaurus'
  { -- | A token that you provide to identify the request to create a thesaurus.
    -- Multiple calls to the @CreateThesaurus@ API with the same client token
    -- will create only one thesaurus.
    CreateThesaurus -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the thesaurus.
    CreateThesaurus -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of key-value pairs that identify the thesaurus. You can use the
    -- tags to identify and organize your resources and to control access to
    -- resources.
    CreateThesaurus -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier of the index for the thesaurus.
    CreateThesaurus -> Text
indexId :: Prelude.Text,
    -- | A name for the thesaurus.
    CreateThesaurus -> Text
name :: Prelude.Text,
    -- | An IAM role that gives Amazon Kendra permissions to access thesaurus
    -- file specified in @SourceS3Path@.
    CreateThesaurus -> Text
roleArn :: Prelude.Text,
    -- | The path to the thesaurus file in S3.
    CreateThesaurus -> S3Path
sourceS3Path :: S3Path
  }
  deriving (CreateThesaurus -> CreateThesaurus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateThesaurus -> CreateThesaurus -> Bool
$c/= :: CreateThesaurus -> CreateThesaurus -> Bool
== :: CreateThesaurus -> CreateThesaurus -> Bool
$c== :: CreateThesaurus -> CreateThesaurus -> Bool
Prelude.Eq, ReadPrec [CreateThesaurus]
ReadPrec CreateThesaurus
Int -> ReadS CreateThesaurus
ReadS [CreateThesaurus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateThesaurus]
$creadListPrec :: ReadPrec [CreateThesaurus]
readPrec :: ReadPrec CreateThesaurus
$creadPrec :: ReadPrec CreateThesaurus
readList :: ReadS [CreateThesaurus]
$creadList :: ReadS [CreateThesaurus]
readsPrec :: Int -> ReadS CreateThesaurus
$creadsPrec :: Int -> ReadS CreateThesaurus
Prelude.Read, Int -> CreateThesaurus -> ShowS
[CreateThesaurus] -> ShowS
CreateThesaurus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateThesaurus] -> ShowS
$cshowList :: [CreateThesaurus] -> ShowS
show :: CreateThesaurus -> String
$cshow :: CreateThesaurus -> String
showsPrec :: Int -> CreateThesaurus -> ShowS
$cshowsPrec :: Int -> CreateThesaurus -> ShowS
Prelude.Show, forall x. Rep CreateThesaurus x -> CreateThesaurus
forall x. CreateThesaurus -> Rep CreateThesaurus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateThesaurus x -> CreateThesaurus
$cfrom :: forall x. CreateThesaurus -> Rep CreateThesaurus x
Prelude.Generic)

-- |
-- Create a value of 'CreateThesaurus' 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:
--
-- 'clientToken', 'createThesaurus_clientToken' - A token that you provide to identify the request to create a thesaurus.
-- Multiple calls to the @CreateThesaurus@ API with the same client token
-- will create only one thesaurus.
--
-- 'description', 'createThesaurus_description' - A description for the thesaurus.
--
-- 'tags', 'createThesaurus_tags' - A list of key-value pairs that identify the thesaurus. You can use the
-- tags to identify and organize your resources and to control access to
-- resources.
--
-- 'indexId', 'createThesaurus_indexId' - The identifier of the index for the thesaurus.
--
-- 'name', 'createThesaurus_name' - A name for the thesaurus.
--
-- 'roleArn', 'createThesaurus_roleArn' - An IAM role that gives Amazon Kendra permissions to access thesaurus
-- file specified in @SourceS3Path@.
--
-- 'sourceS3Path', 'createThesaurus_sourceS3Path' - The path to the thesaurus file in S3.
newCreateThesaurus ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'sourceS3Path'
  S3Path ->
  CreateThesaurus
newCreateThesaurus :: Text -> Text -> Text -> S3Path -> CreateThesaurus
newCreateThesaurus
  Text
pIndexId_
  Text
pName_
  Text
pRoleArn_
  S3Path
pSourceS3Path_ =
    CreateThesaurus'
      { $sel:clientToken:CreateThesaurus' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateThesaurus' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateThesaurus' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:indexId:CreateThesaurus' :: Text
indexId = Text
pIndexId_,
        $sel:name:CreateThesaurus' :: Text
name = Text
pName_,
        $sel:roleArn:CreateThesaurus' :: Text
roleArn = Text
pRoleArn_,
        $sel:sourceS3Path:CreateThesaurus' :: S3Path
sourceS3Path = S3Path
pSourceS3Path_
      }

-- | A token that you provide to identify the request to create a thesaurus.
-- Multiple calls to the @CreateThesaurus@ API with the same client token
-- will create only one thesaurus.
createThesaurus_clientToken :: Lens.Lens' CreateThesaurus (Prelude.Maybe Prelude.Text)
createThesaurus_clientToken :: Lens' CreateThesaurus (Maybe Text)
createThesaurus_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateThesaurus' :: CreateThesaurus -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateThesaurus
s@CreateThesaurus' {} Maybe Text
a -> CreateThesaurus
s {$sel:clientToken:CreateThesaurus' :: Maybe Text
clientToken = Maybe Text
a} :: CreateThesaurus)

-- | A description for the thesaurus.
createThesaurus_description :: Lens.Lens' CreateThesaurus (Prelude.Maybe Prelude.Text)
createThesaurus_description :: Lens' CreateThesaurus (Maybe Text)
createThesaurus_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Maybe Text
description :: Maybe Text
$sel:description:CreateThesaurus' :: CreateThesaurus -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateThesaurus
s@CreateThesaurus' {} Maybe Text
a -> CreateThesaurus
s {$sel:description:CreateThesaurus' :: Maybe Text
description = Maybe Text
a} :: CreateThesaurus)

-- | A list of key-value pairs that identify the thesaurus. You can use the
-- tags to identify and organize your resources and to control access to
-- resources.
createThesaurus_tags :: Lens.Lens' CreateThesaurus (Prelude.Maybe [Tag])
createThesaurus_tags :: Lens' CreateThesaurus (Maybe [Tag])
createThesaurus_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateThesaurus' :: CreateThesaurus -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateThesaurus
s@CreateThesaurus' {} Maybe [Tag]
a -> CreateThesaurus
s {$sel:tags:CreateThesaurus' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateThesaurus) 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 identifier of the index for the thesaurus.
createThesaurus_indexId :: Lens.Lens' CreateThesaurus Prelude.Text
createThesaurus_indexId :: Lens' CreateThesaurus Text
createThesaurus_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Text
indexId :: Text
$sel:indexId:CreateThesaurus' :: CreateThesaurus -> Text
indexId} -> Text
indexId) (\s :: CreateThesaurus
s@CreateThesaurus' {} Text
a -> CreateThesaurus
s {$sel:indexId:CreateThesaurus' :: Text
indexId = Text
a} :: CreateThesaurus)

-- | A name for the thesaurus.
createThesaurus_name :: Lens.Lens' CreateThesaurus Prelude.Text
createThesaurus_name :: Lens' CreateThesaurus Text
createThesaurus_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Text
name :: Text
$sel:name:CreateThesaurus' :: CreateThesaurus -> Text
name} -> Text
name) (\s :: CreateThesaurus
s@CreateThesaurus' {} Text
a -> CreateThesaurus
s {$sel:name:CreateThesaurus' :: Text
name = Text
a} :: CreateThesaurus)

-- | An IAM role that gives Amazon Kendra permissions to access thesaurus
-- file specified in @SourceS3Path@.
createThesaurus_roleArn :: Lens.Lens' CreateThesaurus Prelude.Text
createThesaurus_roleArn :: Lens' CreateThesaurus Text
createThesaurus_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {Text
roleArn :: Text
$sel:roleArn:CreateThesaurus' :: CreateThesaurus -> Text
roleArn} -> Text
roleArn) (\s :: CreateThesaurus
s@CreateThesaurus' {} Text
a -> CreateThesaurus
s {$sel:roleArn:CreateThesaurus' :: Text
roleArn = Text
a} :: CreateThesaurus)

-- | The path to the thesaurus file in S3.
createThesaurus_sourceS3Path :: Lens.Lens' CreateThesaurus S3Path
createThesaurus_sourceS3Path :: Lens' CreateThesaurus S3Path
createThesaurus_sourceS3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurus' {S3Path
sourceS3Path :: S3Path
$sel:sourceS3Path:CreateThesaurus' :: CreateThesaurus -> S3Path
sourceS3Path} -> S3Path
sourceS3Path) (\s :: CreateThesaurus
s@CreateThesaurus' {} S3Path
a -> CreateThesaurus
s {$sel:sourceS3Path:CreateThesaurus' :: S3Path
sourceS3Path = S3Path
a} :: CreateThesaurus)

instance Core.AWSRequest CreateThesaurus where
  type
    AWSResponse CreateThesaurus =
      CreateThesaurusResponse
  request :: (Service -> Service) -> CreateThesaurus -> Request CreateThesaurus
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 CreateThesaurus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateThesaurus)))
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 -> Int -> CreateThesaurusResponse
CreateThesaurusResponse'
            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
"Id")
            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 CreateThesaurus where
  hashWithSalt :: Int -> CreateThesaurus -> Int
hashWithSalt Int
_salt CreateThesaurus' {Maybe [Tag]
Maybe Text
Text
S3Path
sourceS3Path :: S3Path
roleArn :: Text
name :: Text
indexId :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientToken :: Maybe Text
$sel:sourceS3Path:CreateThesaurus' :: CreateThesaurus -> S3Path
$sel:roleArn:CreateThesaurus' :: CreateThesaurus -> Text
$sel:name:CreateThesaurus' :: CreateThesaurus -> Text
$sel:indexId:CreateThesaurus' :: CreateThesaurus -> Text
$sel:tags:CreateThesaurus' :: CreateThesaurus -> Maybe [Tag]
$sel:description:CreateThesaurus' :: CreateThesaurus -> Maybe Text
$sel:clientToken:CreateThesaurus' :: CreateThesaurus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Path
sourceS3Path

instance Prelude.NFData CreateThesaurus where
  rnf :: CreateThesaurus -> ()
rnf CreateThesaurus' {Maybe [Tag]
Maybe Text
Text
S3Path
sourceS3Path :: S3Path
roleArn :: Text
name :: Text
indexId :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientToken :: Maybe Text
$sel:sourceS3Path:CreateThesaurus' :: CreateThesaurus -> S3Path
$sel:roleArn:CreateThesaurus' :: CreateThesaurus -> Text
$sel:name:CreateThesaurus' :: CreateThesaurus -> Text
$sel:indexId:CreateThesaurus' :: CreateThesaurus -> Text
$sel:tags:CreateThesaurus' :: CreateThesaurus -> Maybe [Tag]
$sel:description:CreateThesaurus' :: CreateThesaurus -> Maybe Text
$sel:clientToken:CreateThesaurus' :: CreateThesaurus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Path
sourceS3Path

instance Data.ToHeaders CreateThesaurus where
  toHeaders :: CreateThesaurus -> 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
"AWSKendraFrontendService.CreateThesaurus" ::
                          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 CreateThesaurus where
  toJSON :: CreateThesaurus -> Value
toJSON CreateThesaurus' {Maybe [Tag]
Maybe Text
Text
S3Path
sourceS3Path :: S3Path
roleArn :: Text
name :: Text
indexId :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientToken :: Maybe Text
$sel:sourceS3Path:CreateThesaurus' :: CreateThesaurus -> S3Path
$sel:roleArn:CreateThesaurus' :: CreateThesaurus -> Text
$sel:name:CreateThesaurus' :: CreateThesaurus -> Text
$sel:indexId:CreateThesaurus' :: CreateThesaurus -> Text
$sel:tags:CreateThesaurus' :: CreateThesaurus -> Maybe [Tag]
$sel:description:CreateThesaurus' :: CreateThesaurus -> Maybe Text
$sel:clientToken:CreateThesaurus' :: CreateThesaurus -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"Description" 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
description,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"SourceS3Path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Path
sourceS3Path)
          ]
      )

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

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

-- | /See:/ 'newCreateThesaurusResponse' smart constructor.
data CreateThesaurusResponse = CreateThesaurusResponse'
  { -- | The identifier of the thesaurus.
    CreateThesaurusResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateThesaurusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateThesaurusResponse -> CreateThesaurusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateThesaurusResponse -> CreateThesaurusResponse -> Bool
$c/= :: CreateThesaurusResponse -> CreateThesaurusResponse -> Bool
== :: CreateThesaurusResponse -> CreateThesaurusResponse -> Bool
$c== :: CreateThesaurusResponse -> CreateThesaurusResponse -> Bool
Prelude.Eq, ReadPrec [CreateThesaurusResponse]
ReadPrec CreateThesaurusResponse
Int -> ReadS CreateThesaurusResponse
ReadS [CreateThesaurusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateThesaurusResponse]
$creadListPrec :: ReadPrec [CreateThesaurusResponse]
readPrec :: ReadPrec CreateThesaurusResponse
$creadPrec :: ReadPrec CreateThesaurusResponse
readList :: ReadS [CreateThesaurusResponse]
$creadList :: ReadS [CreateThesaurusResponse]
readsPrec :: Int -> ReadS CreateThesaurusResponse
$creadsPrec :: Int -> ReadS CreateThesaurusResponse
Prelude.Read, Int -> CreateThesaurusResponse -> ShowS
[CreateThesaurusResponse] -> ShowS
CreateThesaurusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateThesaurusResponse] -> ShowS
$cshowList :: [CreateThesaurusResponse] -> ShowS
show :: CreateThesaurusResponse -> String
$cshow :: CreateThesaurusResponse -> String
showsPrec :: Int -> CreateThesaurusResponse -> ShowS
$cshowsPrec :: Int -> CreateThesaurusResponse -> ShowS
Prelude.Show, forall x. Rep CreateThesaurusResponse x -> CreateThesaurusResponse
forall x. CreateThesaurusResponse -> Rep CreateThesaurusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateThesaurusResponse x -> CreateThesaurusResponse
$cfrom :: forall x. CreateThesaurusResponse -> Rep CreateThesaurusResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateThesaurusResponse' 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:
--
-- 'id', 'createThesaurusResponse_id' - The identifier of the thesaurus.
--
-- 'httpStatus', 'createThesaurusResponse_httpStatus' - The response's http status code.
newCreateThesaurusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateThesaurusResponse
newCreateThesaurusResponse :: Int -> CreateThesaurusResponse
newCreateThesaurusResponse Int
pHttpStatus_ =
  CreateThesaurusResponse'
    { $sel:id:CreateThesaurusResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateThesaurusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the thesaurus.
createThesaurusResponse_id :: Lens.Lens' CreateThesaurusResponse (Prelude.Maybe Prelude.Text)
createThesaurusResponse_id :: Lens' CreateThesaurusResponse (Maybe Text)
createThesaurusResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateThesaurusResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateThesaurusResponse' :: CreateThesaurusResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateThesaurusResponse
s@CreateThesaurusResponse' {} Maybe Text
a -> CreateThesaurusResponse
s {$sel:id:CreateThesaurusResponse' :: Maybe Text
id = Maybe Text
a} :: CreateThesaurusResponse)

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

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