{-# 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.Personalize.ListRecipes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of available recipes. The response provides the
-- properties for each recipe, including the recipe\'s Amazon Resource Name
-- (ARN).
--
-- This operation returns paginated results.
module Amazonka.Personalize.ListRecipes
  ( -- * Creating a Request
    ListRecipes (..),
    newListRecipes,

    -- * Request Lenses
    listRecipes_domain,
    listRecipes_maxResults,
    listRecipes_nextToken,
    listRecipes_recipeProvider,

    -- * Destructuring the Response
    ListRecipesResponse (..),
    newListRecipesResponse,

    -- * Response Lenses
    listRecipesResponse_nextToken,
    listRecipesResponse_recipes,
    listRecipesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListRecipes' smart constructor.
data ListRecipes = ListRecipes'
  { -- | Filters returned recipes by domain for a Domain dataset group. Only
    -- recipes (Domain dataset group use cases) for this domain are included in
    -- the response. If you don\'t specify a domain, all recipes are returned.
    ListRecipes -> Maybe Domain
domain :: Prelude.Maybe Domain,
    -- | The maximum number of recipes to return.
    ListRecipes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token returned from the previous call to @ListRecipes@ for getting the
    -- next set of recipes (if they exist).
    ListRecipes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The default is @SERVICE@.
    ListRecipes -> Maybe RecipeProvider
recipeProvider :: Prelude.Maybe RecipeProvider
  }
  deriving (ListRecipes -> ListRecipes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListRecipes -> ListRecipes -> Bool
$c/= :: ListRecipes -> ListRecipes -> Bool
== :: ListRecipes -> ListRecipes -> Bool
$c== :: ListRecipes -> ListRecipes -> Bool
Prelude.Eq, ReadPrec [ListRecipes]
ReadPrec ListRecipes
Int -> ReadS ListRecipes
ReadS [ListRecipes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListRecipes]
$creadListPrec :: ReadPrec [ListRecipes]
readPrec :: ReadPrec ListRecipes
$creadPrec :: ReadPrec ListRecipes
readList :: ReadS [ListRecipes]
$creadList :: ReadS [ListRecipes]
readsPrec :: Int -> ReadS ListRecipes
$creadsPrec :: Int -> ReadS ListRecipes
Prelude.Read, Int -> ListRecipes -> ShowS
[ListRecipes] -> ShowS
ListRecipes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRecipes] -> ShowS
$cshowList :: [ListRecipes] -> ShowS
show :: ListRecipes -> String
$cshow :: ListRecipes -> String
showsPrec :: Int -> ListRecipes -> ShowS
$cshowsPrec :: Int -> ListRecipes -> ShowS
Prelude.Show, forall x. Rep ListRecipes x -> ListRecipes
forall x. ListRecipes -> Rep ListRecipes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListRecipes x -> ListRecipes
$cfrom :: forall x. ListRecipes -> Rep ListRecipes x
Prelude.Generic)

-- |
-- Create a value of 'ListRecipes' 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:
--
-- 'domain', 'listRecipes_domain' - Filters returned recipes by domain for a Domain dataset group. Only
-- recipes (Domain dataset group use cases) for this domain are included in
-- the response. If you don\'t specify a domain, all recipes are returned.
--
-- 'maxResults', 'listRecipes_maxResults' - The maximum number of recipes to return.
--
-- 'nextToken', 'listRecipes_nextToken' - A token returned from the previous call to @ListRecipes@ for getting the
-- next set of recipes (if they exist).
--
-- 'recipeProvider', 'listRecipes_recipeProvider' - The default is @SERVICE@.
newListRecipes ::
  ListRecipes
newListRecipes :: ListRecipes
newListRecipes =
  ListRecipes'
    { $sel:domain:ListRecipes' :: Maybe Domain
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListRecipes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListRecipes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:recipeProvider:ListRecipes' :: Maybe RecipeProvider
recipeProvider = forall a. Maybe a
Prelude.Nothing
    }

-- | Filters returned recipes by domain for a Domain dataset group. Only
-- recipes (Domain dataset group use cases) for this domain are included in
-- the response. If you don\'t specify a domain, all recipes are returned.
listRecipes_domain :: Lens.Lens' ListRecipes (Prelude.Maybe Domain)
listRecipes_domain :: Lens' ListRecipes (Maybe Domain)
listRecipes_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipes' {Maybe Domain
domain :: Maybe Domain
$sel:domain:ListRecipes' :: ListRecipes -> Maybe Domain
domain} -> Maybe Domain
domain) (\s :: ListRecipes
s@ListRecipes' {} Maybe Domain
a -> ListRecipes
s {$sel:domain:ListRecipes' :: Maybe Domain
domain = Maybe Domain
a} :: ListRecipes)

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

-- | A token returned from the previous call to @ListRecipes@ for getting the
-- next set of recipes (if they exist).
listRecipes_nextToken :: Lens.Lens' ListRecipes (Prelude.Maybe Prelude.Text)
listRecipes_nextToken :: Lens' ListRecipes (Maybe Text)
listRecipes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListRecipes' :: ListRecipes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListRecipes
s@ListRecipes' {} Maybe Text
a -> ListRecipes
s {$sel:nextToken:ListRecipes' :: Maybe Text
nextToken = Maybe Text
a} :: ListRecipes)

-- | The default is @SERVICE@.
listRecipes_recipeProvider :: Lens.Lens' ListRecipes (Prelude.Maybe RecipeProvider)
listRecipes_recipeProvider :: Lens' ListRecipes (Maybe RecipeProvider)
listRecipes_recipeProvider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipes' {Maybe RecipeProvider
recipeProvider :: Maybe RecipeProvider
$sel:recipeProvider:ListRecipes' :: ListRecipes -> Maybe RecipeProvider
recipeProvider} -> Maybe RecipeProvider
recipeProvider) (\s :: ListRecipes
s@ListRecipes' {} Maybe RecipeProvider
a -> ListRecipes
s {$sel:recipeProvider:ListRecipes' :: Maybe RecipeProvider
recipeProvider = Maybe RecipeProvider
a} :: ListRecipes)

instance Core.AWSPager ListRecipes where
  page :: ListRecipes -> AWSResponse ListRecipes -> Maybe ListRecipes
page ListRecipes
rq AWSResponse ListRecipes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListRecipes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListRecipesResponse (Maybe Text)
listRecipesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListRecipes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListRecipesResponse (Maybe [RecipeSummary])
listRecipesResponse_recipes
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListRecipes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListRecipes (Maybe Text)
listRecipes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListRecipes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListRecipesResponse (Maybe Text)
listRecipesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListRecipes where
  type AWSResponse ListRecipes = ListRecipesResponse
  request :: (Service -> Service) -> ListRecipes -> Request ListRecipes
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 ListRecipes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListRecipes)))
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 [RecipeSummary] -> Int -> ListRecipesResponse
ListRecipesResponse'
            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
"nextToken")
            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
"recipes" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListRecipes where
  hashWithSalt :: Int -> ListRecipes -> Int
hashWithSalt Int
_salt ListRecipes' {Maybe Natural
Maybe Text
Maybe Domain
Maybe RecipeProvider
recipeProvider :: Maybe RecipeProvider
nextToken :: Maybe Text
maxResults :: Maybe Natural
domain :: Maybe Domain
$sel:recipeProvider:ListRecipes' :: ListRecipes -> Maybe RecipeProvider
$sel:nextToken:ListRecipes' :: ListRecipes -> Maybe Text
$sel:maxResults:ListRecipes' :: ListRecipes -> Maybe Natural
$sel:domain:ListRecipes' :: ListRecipes -> Maybe Domain
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Domain
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecipeProvider
recipeProvider

instance Prelude.NFData ListRecipes where
  rnf :: ListRecipes -> ()
rnf ListRecipes' {Maybe Natural
Maybe Text
Maybe Domain
Maybe RecipeProvider
recipeProvider :: Maybe RecipeProvider
nextToken :: Maybe Text
maxResults :: Maybe Natural
domain :: Maybe Domain
$sel:recipeProvider:ListRecipes' :: ListRecipes -> Maybe RecipeProvider
$sel:nextToken:ListRecipes' :: ListRecipes -> Maybe Text
$sel:maxResults:ListRecipes' :: ListRecipes -> Maybe Natural
$sel:domain:ListRecipes' :: ListRecipes -> Maybe Domain
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Domain
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecipeProvider
recipeProvider

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

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

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

-- | /See:/ 'newListRecipesResponse' smart constructor.
data ListRecipesResponse = ListRecipesResponse'
  { -- | A token for getting the next set of recipes.
    ListRecipesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of available recipes.
    ListRecipesResponse -> Maybe [RecipeSummary]
recipes :: Prelude.Maybe [RecipeSummary],
    -- | The response's http status code.
    ListRecipesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListRecipesResponse -> ListRecipesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListRecipesResponse -> ListRecipesResponse -> Bool
$c/= :: ListRecipesResponse -> ListRecipesResponse -> Bool
== :: ListRecipesResponse -> ListRecipesResponse -> Bool
$c== :: ListRecipesResponse -> ListRecipesResponse -> Bool
Prelude.Eq, ReadPrec [ListRecipesResponse]
ReadPrec ListRecipesResponse
Int -> ReadS ListRecipesResponse
ReadS [ListRecipesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListRecipesResponse]
$creadListPrec :: ReadPrec [ListRecipesResponse]
readPrec :: ReadPrec ListRecipesResponse
$creadPrec :: ReadPrec ListRecipesResponse
readList :: ReadS [ListRecipesResponse]
$creadList :: ReadS [ListRecipesResponse]
readsPrec :: Int -> ReadS ListRecipesResponse
$creadsPrec :: Int -> ReadS ListRecipesResponse
Prelude.Read, Int -> ListRecipesResponse -> ShowS
[ListRecipesResponse] -> ShowS
ListRecipesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListRecipesResponse] -> ShowS
$cshowList :: [ListRecipesResponse] -> ShowS
show :: ListRecipesResponse -> String
$cshow :: ListRecipesResponse -> String
showsPrec :: Int -> ListRecipesResponse -> ShowS
$cshowsPrec :: Int -> ListRecipesResponse -> ShowS
Prelude.Show, forall x. Rep ListRecipesResponse x -> ListRecipesResponse
forall x. ListRecipesResponse -> Rep ListRecipesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListRecipesResponse x -> ListRecipesResponse
$cfrom :: forall x. ListRecipesResponse -> Rep ListRecipesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListRecipesResponse' 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:
--
-- 'nextToken', 'listRecipesResponse_nextToken' - A token for getting the next set of recipes.
--
-- 'recipes', 'listRecipesResponse_recipes' - The list of available recipes.
--
-- 'httpStatus', 'listRecipesResponse_httpStatus' - The response's http status code.
newListRecipesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListRecipesResponse
newListRecipesResponse :: Int -> ListRecipesResponse
newListRecipesResponse Int
pHttpStatus_ =
  ListRecipesResponse'
    { $sel:nextToken:ListRecipesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:recipes:ListRecipesResponse' :: Maybe [RecipeSummary]
recipes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListRecipesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A token for getting the next set of recipes.
listRecipesResponse_nextToken :: Lens.Lens' ListRecipesResponse (Prelude.Maybe Prelude.Text)
listRecipesResponse_nextToken :: Lens' ListRecipesResponse (Maybe Text)
listRecipesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListRecipesResponse' :: ListRecipesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListRecipesResponse
s@ListRecipesResponse' {} Maybe Text
a -> ListRecipesResponse
s {$sel:nextToken:ListRecipesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListRecipesResponse)

-- | The list of available recipes.
listRecipesResponse_recipes :: Lens.Lens' ListRecipesResponse (Prelude.Maybe [RecipeSummary])
listRecipesResponse_recipes :: Lens' ListRecipesResponse (Maybe [RecipeSummary])
listRecipesResponse_recipes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipesResponse' {Maybe [RecipeSummary]
recipes :: Maybe [RecipeSummary]
$sel:recipes:ListRecipesResponse' :: ListRecipesResponse -> Maybe [RecipeSummary]
recipes} -> Maybe [RecipeSummary]
recipes) (\s :: ListRecipesResponse
s@ListRecipesResponse' {} Maybe [RecipeSummary]
a -> ListRecipesResponse
s {$sel:recipes:ListRecipesResponse' :: Maybe [RecipeSummary]
recipes = Maybe [RecipeSummary]
a} :: ListRecipesResponse) 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 response's http status code.
listRecipesResponse_httpStatus :: Lens.Lens' ListRecipesResponse Prelude.Int
listRecipesResponse_httpStatus :: Lens' ListRecipesResponse Int
listRecipesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListRecipesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListRecipesResponse' :: ListRecipesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListRecipesResponse
s@ListRecipesResponse' {} Int
a -> ListRecipesResponse
s {$sel:httpStatus:ListRecipesResponse' :: Int
httpStatus = Int
a} :: ListRecipesResponse)

instance Prelude.NFData ListRecipesResponse where
  rnf :: ListRecipesResponse -> ()
rnf ListRecipesResponse' {Int
Maybe [RecipeSummary]
Maybe Text
httpStatus :: Int
recipes :: Maybe [RecipeSummary]
nextToken :: Maybe Text
$sel:httpStatus:ListRecipesResponse' :: ListRecipesResponse -> Int
$sel:recipes:ListRecipesResponse' :: ListRecipesResponse -> Maybe [RecipeSummary]
$sel:nextToken:ListRecipesResponse' :: ListRecipesResponse -> Maybe Text
..} =
    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 Maybe [RecipeSummary]
recipes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus