{-# 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.ListCustomEntityTypes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all the custom patterns that have been created.
module Amazonka.Glue.ListCustomEntityTypes
  ( -- * Creating a Request
    ListCustomEntityTypes (..),
    newListCustomEntityTypes,

    -- * Request Lenses
    listCustomEntityTypes_maxResults,
    listCustomEntityTypes_nextToken,

    -- * Destructuring the Response
    ListCustomEntityTypesResponse (..),
    newListCustomEntityTypesResponse,

    -- * Response Lenses
    listCustomEntityTypesResponse_customEntityTypes,
    listCustomEntityTypesResponse_nextToken,
    listCustomEntityTypesResponse_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:/ 'newListCustomEntityTypes' smart constructor.
data ListCustomEntityTypes = ListCustomEntityTypes'
  { -- | The maximum number of results to return.
    ListCustomEntityTypes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A paginated token to offset the results.
    ListCustomEntityTypes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCustomEntityTypes -> ListCustomEntityTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomEntityTypes -> ListCustomEntityTypes -> Bool
$c/= :: ListCustomEntityTypes -> ListCustomEntityTypes -> Bool
== :: ListCustomEntityTypes -> ListCustomEntityTypes -> Bool
$c== :: ListCustomEntityTypes -> ListCustomEntityTypes -> Bool
Prelude.Eq, ReadPrec [ListCustomEntityTypes]
ReadPrec ListCustomEntityTypes
Int -> ReadS ListCustomEntityTypes
ReadS [ListCustomEntityTypes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomEntityTypes]
$creadListPrec :: ReadPrec [ListCustomEntityTypes]
readPrec :: ReadPrec ListCustomEntityTypes
$creadPrec :: ReadPrec ListCustomEntityTypes
readList :: ReadS [ListCustomEntityTypes]
$creadList :: ReadS [ListCustomEntityTypes]
readsPrec :: Int -> ReadS ListCustomEntityTypes
$creadsPrec :: Int -> ReadS ListCustomEntityTypes
Prelude.Read, Int -> ListCustomEntityTypes -> ShowS
[ListCustomEntityTypes] -> ShowS
ListCustomEntityTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomEntityTypes] -> ShowS
$cshowList :: [ListCustomEntityTypes] -> ShowS
show :: ListCustomEntityTypes -> String
$cshow :: ListCustomEntityTypes -> String
showsPrec :: Int -> ListCustomEntityTypes -> ShowS
$cshowsPrec :: Int -> ListCustomEntityTypes -> ShowS
Prelude.Show, forall x. Rep ListCustomEntityTypes x -> ListCustomEntityTypes
forall x. ListCustomEntityTypes -> Rep ListCustomEntityTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCustomEntityTypes x -> ListCustomEntityTypes
$cfrom :: forall x. ListCustomEntityTypes -> Rep ListCustomEntityTypes x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomEntityTypes' 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:
--
-- 'maxResults', 'listCustomEntityTypes_maxResults' - The maximum number of results to return.
--
-- 'nextToken', 'listCustomEntityTypes_nextToken' - A paginated token to offset the results.
newListCustomEntityTypes ::
  ListCustomEntityTypes
newListCustomEntityTypes :: ListCustomEntityTypes
newListCustomEntityTypes =
  ListCustomEntityTypes'
    { $sel:maxResults:ListCustomEntityTypes' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomEntityTypes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to return.
listCustomEntityTypes_maxResults :: Lens.Lens' ListCustomEntityTypes (Prelude.Maybe Prelude.Natural)
listCustomEntityTypes_maxResults :: Lens' ListCustomEntityTypes (Maybe Natural)
listCustomEntityTypes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomEntityTypes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCustomEntityTypes
s@ListCustomEntityTypes' {} Maybe Natural
a -> ListCustomEntityTypes
s {$sel:maxResults:ListCustomEntityTypes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCustomEntityTypes)

-- | A paginated token to offset the results.
listCustomEntityTypes_nextToken :: Lens.Lens' ListCustomEntityTypes (Prelude.Maybe Prelude.Text)
listCustomEntityTypes_nextToken :: Lens' ListCustomEntityTypes (Maybe Text)
listCustomEntityTypes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomEntityTypes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomEntityTypes
s@ListCustomEntityTypes' {} Maybe Text
a -> ListCustomEntityTypes
s {$sel:nextToken:ListCustomEntityTypes' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomEntityTypes)

instance Core.AWSRequest ListCustomEntityTypes where
  type
    AWSResponse ListCustomEntityTypes =
      ListCustomEntityTypesResponse
  request :: (Service -> Service)
-> ListCustomEntityTypes -> Request ListCustomEntityTypes
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 ListCustomEntityTypes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCustomEntityTypes)))
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 [CustomEntityType]
-> Maybe Text -> Int -> ListCustomEntityTypesResponse
ListCustomEntityTypesResponse'
            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
"CustomEntityTypes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 ListCustomEntityTypes where
  hashWithSalt :: Int -> ListCustomEntityTypes -> Int
hashWithSalt Int
_salt ListCustomEntityTypes' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Text
$sel:maxResults:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListCustomEntityTypes where
  rnf :: ListCustomEntityTypes -> ()
rnf ListCustomEntityTypes' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Text
$sel:maxResults:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListCustomEntityTypes where
  toHeaders :: ListCustomEntityTypes -> 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.ListCustomEntityTypes" ::
                          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 ListCustomEntityTypes where
  toJSON :: ListCustomEntityTypes -> Value
toJSON ListCustomEntityTypes' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Text
$sel:maxResults:ListCustomEntityTypes' :: ListCustomEntityTypes -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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
maxResults,
            (Key
"NextToken" 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
nextToken
          ]
      )

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

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

-- | /See:/ 'newListCustomEntityTypesResponse' smart constructor.
data ListCustomEntityTypesResponse = ListCustomEntityTypesResponse'
  { -- | A list of @CustomEntityType@ objects representing custom patterns.
    ListCustomEntityTypesResponse -> Maybe [CustomEntityType]
customEntityTypes :: Prelude.Maybe [CustomEntityType],
    -- | A pagination token, if more results are available.
    ListCustomEntityTypesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCustomEntityTypesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCustomEntityTypesResponse
-> ListCustomEntityTypesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomEntityTypesResponse
-> ListCustomEntityTypesResponse -> Bool
$c/= :: ListCustomEntityTypesResponse
-> ListCustomEntityTypesResponse -> Bool
== :: ListCustomEntityTypesResponse
-> ListCustomEntityTypesResponse -> Bool
$c== :: ListCustomEntityTypesResponse
-> ListCustomEntityTypesResponse -> Bool
Prelude.Eq, ReadPrec [ListCustomEntityTypesResponse]
ReadPrec ListCustomEntityTypesResponse
Int -> ReadS ListCustomEntityTypesResponse
ReadS [ListCustomEntityTypesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomEntityTypesResponse]
$creadListPrec :: ReadPrec [ListCustomEntityTypesResponse]
readPrec :: ReadPrec ListCustomEntityTypesResponse
$creadPrec :: ReadPrec ListCustomEntityTypesResponse
readList :: ReadS [ListCustomEntityTypesResponse]
$creadList :: ReadS [ListCustomEntityTypesResponse]
readsPrec :: Int -> ReadS ListCustomEntityTypesResponse
$creadsPrec :: Int -> ReadS ListCustomEntityTypesResponse
Prelude.Read, Int -> ListCustomEntityTypesResponse -> ShowS
[ListCustomEntityTypesResponse] -> ShowS
ListCustomEntityTypesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomEntityTypesResponse] -> ShowS
$cshowList :: [ListCustomEntityTypesResponse] -> ShowS
show :: ListCustomEntityTypesResponse -> String
$cshow :: ListCustomEntityTypesResponse -> String
showsPrec :: Int -> ListCustomEntityTypesResponse -> ShowS
$cshowsPrec :: Int -> ListCustomEntityTypesResponse -> ShowS
Prelude.Show, forall x.
Rep ListCustomEntityTypesResponse x
-> ListCustomEntityTypesResponse
forall x.
ListCustomEntityTypesResponse
-> Rep ListCustomEntityTypesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomEntityTypesResponse x
-> ListCustomEntityTypesResponse
$cfrom :: forall x.
ListCustomEntityTypesResponse
-> Rep ListCustomEntityTypesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomEntityTypesResponse' 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:
--
-- 'customEntityTypes', 'listCustomEntityTypesResponse_customEntityTypes' - A list of @CustomEntityType@ objects representing custom patterns.
--
-- 'nextToken', 'listCustomEntityTypesResponse_nextToken' - A pagination token, if more results are available.
--
-- 'httpStatus', 'listCustomEntityTypesResponse_httpStatus' - The response's http status code.
newListCustomEntityTypesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCustomEntityTypesResponse
newListCustomEntityTypesResponse :: Int -> ListCustomEntityTypesResponse
newListCustomEntityTypesResponse Int
pHttpStatus_ =
  ListCustomEntityTypesResponse'
    { $sel:customEntityTypes:ListCustomEntityTypesResponse' :: Maybe [CustomEntityType]
customEntityTypes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomEntityTypesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCustomEntityTypesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @CustomEntityType@ objects representing custom patterns.
listCustomEntityTypesResponse_customEntityTypes :: Lens.Lens' ListCustomEntityTypesResponse (Prelude.Maybe [CustomEntityType])
listCustomEntityTypesResponse_customEntityTypes :: Lens' ListCustomEntityTypesResponse (Maybe [CustomEntityType])
listCustomEntityTypesResponse_customEntityTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomEntityTypesResponse' {Maybe [CustomEntityType]
customEntityTypes :: Maybe [CustomEntityType]
$sel:customEntityTypes:ListCustomEntityTypesResponse' :: ListCustomEntityTypesResponse -> Maybe [CustomEntityType]
customEntityTypes} -> Maybe [CustomEntityType]
customEntityTypes) (\s :: ListCustomEntityTypesResponse
s@ListCustomEntityTypesResponse' {} Maybe [CustomEntityType]
a -> ListCustomEntityTypesResponse
s {$sel:customEntityTypes:ListCustomEntityTypesResponse' :: Maybe [CustomEntityType]
customEntityTypes = Maybe [CustomEntityType]
a} :: ListCustomEntityTypesResponse) 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

-- | A pagination token, if more results are available.
listCustomEntityTypesResponse_nextToken :: Lens.Lens' ListCustomEntityTypesResponse (Prelude.Maybe Prelude.Text)
listCustomEntityTypesResponse_nextToken :: Lens' ListCustomEntityTypesResponse (Maybe Text)
listCustomEntityTypesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomEntityTypesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomEntityTypesResponse' :: ListCustomEntityTypesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomEntityTypesResponse
s@ListCustomEntityTypesResponse' {} Maybe Text
a -> ListCustomEntityTypesResponse
s {$sel:nextToken:ListCustomEntityTypesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomEntityTypesResponse)

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

instance Prelude.NFData ListCustomEntityTypesResponse where
  rnf :: ListCustomEntityTypesResponse -> ()
rnf ListCustomEntityTypesResponse' {Int
Maybe [CustomEntityType]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
customEntityTypes :: Maybe [CustomEntityType]
$sel:httpStatus:ListCustomEntityTypesResponse' :: ListCustomEntityTypesResponse -> Int
$sel:nextToken:ListCustomEntityTypesResponse' :: ListCustomEntityTypesResponse -> Maybe Text
$sel:customEntityTypes:ListCustomEntityTypesResponse' :: ListCustomEntityTypesResponse -> Maybe [CustomEntityType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CustomEntityType]
customEntityTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus