{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.SearchForTextResult
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Location.Types.SearchForTextResult 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.Place
import qualified Amazonka.Prelude as Prelude

-- | Contains a search result from a text search query that is run on a place
-- index resource.
--
-- /See:/ 'newSearchForTextResult' smart constructor.
data SearchForTextResult = SearchForTextResult'
  { -- | The distance in meters of a great-circle arc between the bias position
    -- specified and the result. @Distance@ will be returned only if a bias
    -- position was specified in the query.
    --
    -- A great-circle arc is the shortest path on a sphere, in this case the
    -- Earth. This returns the shortest distance between two locations.
    SearchForTextResult -> Maybe Double
distance :: Prelude.Maybe Prelude.Double,
    -- | The unique identifier of the place. You can use this with the @GetPlace@
    -- operation to find the place again later.
    --
    -- For @SearchPlaceIndexForText@ operations, the @PlaceId@ is returned only
    -- by place indexes that use HERE as a data provider.
    SearchForTextResult -> Maybe Text
placeId :: Prelude.Maybe Prelude.Text,
    -- | The relative confidence in the match for a result among the results
    -- returned. For example, if more fields for an address match (including
    -- house number, street, city, country\/region, and postal code), the
    -- relevance score is closer to 1.
    --
    -- Returned only when the partner selected is Esri.
    SearchForTextResult -> Maybe Double
relevance :: Prelude.Maybe Prelude.Double,
    -- | Details about the search result, such as its address and position.
    SearchForTextResult -> Place
place :: Place
  }
  deriving (SearchForTextResult -> SearchForTextResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchForTextResult -> SearchForTextResult -> Bool
$c/= :: SearchForTextResult -> SearchForTextResult -> Bool
== :: SearchForTextResult -> SearchForTextResult -> Bool
$c== :: SearchForTextResult -> SearchForTextResult -> Bool
Prelude.Eq, Int -> SearchForTextResult -> ShowS
[SearchForTextResult] -> ShowS
SearchForTextResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchForTextResult] -> ShowS
$cshowList :: [SearchForTextResult] -> ShowS
show :: SearchForTextResult -> String
$cshow :: SearchForTextResult -> String
showsPrec :: Int -> SearchForTextResult -> ShowS
$cshowsPrec :: Int -> SearchForTextResult -> ShowS
Prelude.Show, forall x. Rep SearchForTextResult x -> SearchForTextResult
forall x. SearchForTextResult -> Rep SearchForTextResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchForTextResult x -> SearchForTextResult
$cfrom :: forall x. SearchForTextResult -> Rep SearchForTextResult x
Prelude.Generic)

-- |
-- Create a value of 'SearchForTextResult' 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:
--
-- 'distance', 'searchForTextResult_distance' - The distance in meters of a great-circle arc between the bias position
-- specified and the result. @Distance@ will be returned only if a bias
-- position was specified in the query.
--
-- A great-circle arc is the shortest path on a sphere, in this case the
-- Earth. This returns the shortest distance between two locations.
--
-- 'placeId', 'searchForTextResult_placeId' - The unique identifier of the place. You can use this with the @GetPlace@
-- operation to find the place again later.
--
-- For @SearchPlaceIndexForText@ operations, the @PlaceId@ is returned only
-- by place indexes that use HERE as a data provider.
--
-- 'relevance', 'searchForTextResult_relevance' - The relative confidence in the match for a result among the results
-- returned. For example, if more fields for an address match (including
-- house number, street, city, country\/region, and postal code), the
-- relevance score is closer to 1.
--
-- Returned only when the partner selected is Esri.
--
-- 'place', 'searchForTextResult_place' - Details about the search result, such as its address and position.
newSearchForTextResult ::
  -- | 'place'
  Place ->
  SearchForTextResult
newSearchForTextResult :: Place -> SearchForTextResult
newSearchForTextResult Place
pPlace_ =
  SearchForTextResult'
    { $sel:distance:SearchForTextResult' :: Maybe Double
distance = forall a. Maybe a
Prelude.Nothing,
      $sel:placeId:SearchForTextResult' :: Maybe Text
placeId = forall a. Maybe a
Prelude.Nothing,
      $sel:relevance:SearchForTextResult' :: Maybe Double
relevance = forall a. Maybe a
Prelude.Nothing,
      $sel:place:SearchForTextResult' :: Place
place = Place
pPlace_
    }

-- | The distance in meters of a great-circle arc between the bias position
-- specified and the result. @Distance@ will be returned only if a bias
-- position was specified in the query.
--
-- A great-circle arc is the shortest path on a sphere, in this case the
-- Earth. This returns the shortest distance between two locations.
searchForTextResult_distance :: Lens.Lens' SearchForTextResult (Prelude.Maybe Prelude.Double)
searchForTextResult_distance :: Lens' SearchForTextResult (Maybe Double)
searchForTextResult_distance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchForTextResult' {Maybe Double
distance :: Maybe Double
$sel:distance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
distance} -> Maybe Double
distance) (\s :: SearchForTextResult
s@SearchForTextResult' {} Maybe Double
a -> SearchForTextResult
s {$sel:distance:SearchForTextResult' :: Maybe Double
distance = Maybe Double
a} :: SearchForTextResult)

-- | The unique identifier of the place. You can use this with the @GetPlace@
-- operation to find the place again later.
--
-- For @SearchPlaceIndexForText@ operations, the @PlaceId@ is returned only
-- by place indexes that use HERE as a data provider.
searchForTextResult_placeId :: Lens.Lens' SearchForTextResult (Prelude.Maybe Prelude.Text)
searchForTextResult_placeId :: Lens' SearchForTextResult (Maybe Text)
searchForTextResult_placeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchForTextResult' {Maybe Text
placeId :: Maybe Text
$sel:placeId:SearchForTextResult' :: SearchForTextResult -> Maybe Text
placeId} -> Maybe Text
placeId) (\s :: SearchForTextResult
s@SearchForTextResult' {} Maybe Text
a -> SearchForTextResult
s {$sel:placeId:SearchForTextResult' :: Maybe Text
placeId = Maybe Text
a} :: SearchForTextResult)

-- | The relative confidence in the match for a result among the results
-- returned. For example, if more fields for an address match (including
-- house number, street, city, country\/region, and postal code), the
-- relevance score is closer to 1.
--
-- Returned only when the partner selected is Esri.
searchForTextResult_relevance :: Lens.Lens' SearchForTextResult (Prelude.Maybe Prelude.Double)
searchForTextResult_relevance :: Lens' SearchForTextResult (Maybe Double)
searchForTextResult_relevance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchForTextResult' {Maybe Double
relevance :: Maybe Double
$sel:relevance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
relevance} -> Maybe Double
relevance) (\s :: SearchForTextResult
s@SearchForTextResult' {} Maybe Double
a -> SearchForTextResult
s {$sel:relevance:SearchForTextResult' :: Maybe Double
relevance = Maybe Double
a} :: SearchForTextResult)

-- | Details about the search result, such as its address and position.
searchForTextResult_place :: Lens.Lens' SearchForTextResult Place
searchForTextResult_place :: Lens' SearchForTextResult Place
searchForTextResult_place = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchForTextResult' {Place
place :: Place
$sel:place:SearchForTextResult' :: SearchForTextResult -> Place
place} -> Place
place) (\s :: SearchForTextResult
s@SearchForTextResult' {} Place
a -> SearchForTextResult
s {$sel:place:SearchForTextResult' :: Place
place = Place
a} :: SearchForTextResult)

instance Data.FromJSON SearchForTextResult where
  parseJSON :: Value -> Parser SearchForTextResult
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SearchForTextResult"
      ( \Object
x ->
          Maybe Double
-> Maybe Text -> Maybe Double -> Place -> SearchForTextResult
SearchForTextResult'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Distance")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PlaceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Relevance")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Place")
      )

instance Prelude.Hashable SearchForTextResult where
  hashWithSalt :: Int -> SearchForTextResult -> Int
hashWithSalt Int
_salt SearchForTextResult' {Maybe Double
Maybe Text
Place
place :: Place
relevance :: Maybe Double
placeId :: Maybe Text
distance :: Maybe Double
$sel:place:SearchForTextResult' :: SearchForTextResult -> Place
$sel:relevance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
$sel:placeId:SearchForTextResult' :: SearchForTextResult -> Maybe Text
$sel:distance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
distance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
placeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
relevance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Place
place

instance Prelude.NFData SearchForTextResult where
  rnf :: SearchForTextResult -> ()
rnf SearchForTextResult' {Maybe Double
Maybe Text
Place
place :: Place
relevance :: Maybe Double
placeId :: Maybe Text
distance :: Maybe Double
$sel:place:SearchForTextResult' :: SearchForTextResult -> Place
$sel:relevance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
$sel:placeId:SearchForTextResult' :: SearchForTextResult -> Maybe Text
$sel:distance:SearchForTextResult' :: SearchForTextResult -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
distance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
placeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
relevance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Place
place