{-# 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.Location.DeleteMap
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a map resource from your AWS account.
--
-- This operation deletes the resource permanently. If the map is being
-- used in an application, the map may not render.
module Amazonka.Location.DeleteMap
  ( -- * Creating a Request
    DeleteMap (..),
    newDeleteMap,

    -- * Request Lenses
    deleteMap_mapName,

    -- * Destructuring the Response
    DeleteMapResponse (..),
    newDeleteMapResponse,

    -- * Response Lenses
    deleteMapResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteMap' smart constructor.
data DeleteMap = DeleteMap'
  { -- | The name of the map resource to be deleted.
    DeleteMap -> Text
mapName :: Prelude.Text
  }
  deriving (DeleteMap -> DeleteMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteMap -> DeleteMap -> Bool
$c/= :: DeleteMap -> DeleteMap -> Bool
== :: DeleteMap -> DeleteMap -> Bool
$c== :: DeleteMap -> DeleteMap -> Bool
Prelude.Eq, ReadPrec [DeleteMap]
ReadPrec DeleteMap
Int -> ReadS DeleteMap
ReadS [DeleteMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteMap]
$creadListPrec :: ReadPrec [DeleteMap]
readPrec :: ReadPrec DeleteMap
$creadPrec :: ReadPrec DeleteMap
readList :: ReadS [DeleteMap]
$creadList :: ReadS [DeleteMap]
readsPrec :: Int -> ReadS DeleteMap
$creadsPrec :: Int -> ReadS DeleteMap
Prelude.Read, Int -> DeleteMap -> ShowS
[DeleteMap] -> ShowS
DeleteMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteMap] -> ShowS
$cshowList :: [DeleteMap] -> ShowS
show :: DeleteMap -> String
$cshow :: DeleteMap -> String
showsPrec :: Int -> DeleteMap -> ShowS
$cshowsPrec :: Int -> DeleteMap -> ShowS
Prelude.Show, forall x. Rep DeleteMap x -> DeleteMap
forall x. DeleteMap -> Rep DeleteMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteMap x -> DeleteMap
$cfrom :: forall x. DeleteMap -> Rep DeleteMap x
Prelude.Generic)

-- |
-- Create a value of 'DeleteMap' 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:
--
-- 'mapName', 'deleteMap_mapName' - The name of the map resource to be deleted.
newDeleteMap ::
  -- | 'mapName'
  Prelude.Text ->
  DeleteMap
newDeleteMap :: Text -> DeleteMap
newDeleteMap Text
pMapName_ =
  DeleteMap' {$sel:mapName:DeleteMap' :: Text
mapName = Text
pMapName_}

-- | The name of the map resource to be deleted.
deleteMap_mapName :: Lens.Lens' DeleteMap Prelude.Text
deleteMap_mapName :: Lens' DeleteMap Text
deleteMap_mapName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMap' {Text
mapName :: Text
$sel:mapName:DeleteMap' :: DeleteMap -> Text
mapName} -> Text
mapName) (\s :: DeleteMap
s@DeleteMap' {} Text
a -> DeleteMap
s {$sel:mapName:DeleteMap' :: Text
mapName = Text
a} :: DeleteMap)

instance Core.AWSRequest DeleteMap where
  type AWSResponse DeleteMap = DeleteMapResponse
  request :: (Service -> Service) -> DeleteMap -> Request DeleteMap
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteMap
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteMap)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteMapResponse
DeleteMapResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteMap where
  hashWithSalt :: Int -> DeleteMap -> Int
hashWithSalt Int
_salt DeleteMap' {Text
mapName :: Text
$sel:mapName:DeleteMap' :: DeleteMap -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mapName

instance Prelude.NFData DeleteMap where
  rnf :: DeleteMap -> ()
rnf DeleteMap' {Text
mapName :: Text
$sel:mapName:DeleteMap' :: DeleteMap -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
mapName

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

instance Data.ToPath DeleteMap where
  toPath :: DeleteMap -> ByteString
toPath DeleteMap' {Text
mapName :: Text
$sel:mapName:DeleteMap' :: DeleteMap -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/maps/v0/maps/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
mapName]

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

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

-- |
-- Create a value of 'DeleteMapResponse' 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:
--
-- 'httpStatus', 'deleteMapResponse_httpStatus' - The response's http status code.
newDeleteMapResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteMapResponse
newDeleteMapResponse :: Int -> DeleteMapResponse
newDeleteMapResponse Int
pHttpStatus_ =
  DeleteMapResponse' {$sel:httpStatus:DeleteMapResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData DeleteMapResponse where
  rnf :: DeleteMapResponse -> ()
rnf DeleteMapResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteMapResponse' :: DeleteMapResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus