{-# 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.CalculateRouteMatrix
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html Calculates a route matrix>
-- given the following required parameters: @DeparturePositions@ and
-- @DestinationPositions@. @CalculateRouteMatrix@ calculates routes and
-- returns the travel time and travel distance from each departure position
-- to each destination position in the request. For example, given
-- departure positions A and B, and destination positions X and Y,
-- @CalculateRouteMatrix@ will return time and distance for routes from A
-- to X, A to Y, B to X, and B to Y (in that order). The number of results
-- returned (and routes calculated) will be the number of
-- @DeparturePositions@ times the number of @DestinationPositions@.
--
-- Your account is charged for each route calculated, not the number of
-- requests.
--
-- Requires that you first
-- <https://docs.aws.amazon.com/location-routes/latest/APIReference/API_CreateRouteCalculator.html create a route calculator resource>.
--
-- By default, a request that doesn\'t specify a departure time uses the
-- best time of day to travel with the best traffic conditions when
-- calculating routes.
--
-- Additional options include:
--
-- -   <https://docs.aws.amazon.com/location/latest/developerguide/departure-time.html Specifying a departure time>
--     using either @DepartureTime@ or @DepartNow@. This calculates routes
--     based on predictive traffic data at the given time.
--
--     You can\'t specify both @DepartureTime@ and @DepartNow@ in a single
--     request. Specifying both parameters returns a validation error.
--
-- -   <https://docs.aws.amazon.com/location/latest/developerguide/travel-mode.html Specifying a travel mode>
--     using TravelMode sets the transportation mode used to calculate the
--     routes. This also lets you specify additional route preferences in
--     @CarModeOptions@ if traveling by @Car@, or @TruckModeOptions@ if
--     traveling by @Truck@.
module Amazonka.Location.CalculateRouteMatrix
  ( -- * Creating a Request
    CalculateRouteMatrix (..),
    newCalculateRouteMatrix,

    -- * Request Lenses
    calculateRouteMatrix_carModeOptions,
    calculateRouteMatrix_departNow,
    calculateRouteMatrix_departureTime,
    calculateRouteMatrix_distanceUnit,
    calculateRouteMatrix_travelMode,
    calculateRouteMatrix_truckModeOptions,
    calculateRouteMatrix_calculatorName,
    calculateRouteMatrix_departurePositions,
    calculateRouteMatrix_destinationPositions,

    -- * Destructuring the Response
    CalculateRouteMatrixResponse (..),
    newCalculateRouteMatrixResponse,

    -- * Response Lenses
    calculateRouteMatrixResponse_snappedDeparturePositions,
    calculateRouteMatrixResponse_snappedDestinationPositions,
    calculateRouteMatrixResponse_httpStatus,
    calculateRouteMatrixResponse_routeMatrix,
    calculateRouteMatrixResponse_summary,
  )
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:/ 'newCalculateRouteMatrix' smart constructor.
data CalculateRouteMatrix = CalculateRouteMatrix'
  { -- | Specifies route preferences when traveling by @Car@, such as avoiding
    -- routes that use ferries or tolls.
    --
    -- Requirements: @TravelMode@ must be specified as @Car@.
    CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
carModeOptions :: Prelude.Maybe CalculateRouteCarModeOptions,
    -- | Sets the time of departure as the current time. Uses the current time to
    -- calculate the route matrix. You can\'t set both @DepartureTime@ and
    -- @DepartNow@. If neither is set, the best time of day to travel with the
    -- best traffic conditions is used to calculate the route matrix.
    --
    -- Default Value: @false@
    --
    -- Valid Values: @false@ | @true@
    CalculateRouteMatrix -> Maybe Bool
departNow :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the desired time of departure. Uses the given time to
    -- calculate the route matrix. You can\'t set both @DepartureTime@ and
    -- @DepartNow@. If neither is set, the best time of day to travel with the
    -- best traffic conditions is used to calculate the route matrix.
    --
    -- Setting a departure time in the past returns a @400 ValidationException@
    -- error.
    --
    -- -   In <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    --     format: @YYYY-MM-DDThh:mm:ss.sssZ@. For example,
    --     @2020–07-2T12:15:20.000Z+01:00@
    CalculateRouteMatrix -> Maybe ISO8601
departureTime :: Prelude.Maybe Data.ISO8601,
    -- | Set the unit system to specify the distance.
    --
    -- Default Value: @Kilometers@
    CalculateRouteMatrix -> Maybe DistanceUnit
distanceUnit :: Prelude.Maybe DistanceUnit,
    -- | Specifies the mode of transport when calculating a route. Used in
    -- estimating the speed of travel and road compatibility.
    --
    -- The @TravelMode@ you specify also determines how you specify route
    -- preferences:
    --
    -- -   If traveling by @Car@ use the @CarModeOptions@ parameter.
    --
    -- -   If traveling by @Truck@ use the @TruckModeOptions@ parameter.
    --
    -- Default Value: @Car@
    CalculateRouteMatrix -> Maybe TravelMode
travelMode :: Prelude.Maybe TravelMode,
    -- | Specifies route preferences when traveling by @Truck@, such as avoiding
    -- routes that use ferries or tolls, and truck specifications to consider
    -- when choosing an optimal road.
    --
    -- Requirements: @TravelMode@ must be specified as @Truck@.
    CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
truckModeOptions :: Prelude.Maybe CalculateRouteTruckModeOptions,
    -- | The name of the route calculator resource that you want to use to
    -- calculate the route matrix.
    CalculateRouteMatrix -> Text
calculatorName :: Prelude.Text,
    -- | The list of departure (origin) positions for the route matrix. An array
    -- of points, each of which is itself a 2-value array defined in
    -- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
    -- @[longitude, latitude]@. For example, @[-123.115, 49.285]@.
    --
    -- Depending on the data provider selected in the route calculator resource
    -- there may be additional restrictions on the inputs you can choose. See
    -- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
    -- in the /Amazon Location Service Developer Guide/.
    --
    -- For route calculators that use Esri as the data provider, if you specify
    -- a departure that\'s not located on a road, Amazon Location
    -- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
    -- The snapped value is available in the result in
    -- @SnappedDeparturePositions@.
    --
    -- Valid Values: @[-180 to 180,-90 to 90]@
    CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: Prelude.NonEmpty (Data.Sensitive (Prelude.NonEmpty Prelude.Double)),
    -- | The list of destination positions for the route matrix. An array of
    -- points, each of which is itself a 2-value array defined in
    -- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
    -- @[longitude, latitude]@. For example, @[-122.339, 47.615]@
    --
    -- Depending on the data provider selected in the route calculator resource
    -- there may be additional restrictions on the inputs you can choose. See
    -- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
    -- in the /Amazon Location Service Developer Guide/.
    --
    -- For route calculators that use Esri as the data provider, if you specify
    -- a destination that\'s not located on a road, Amazon Location
    -- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
    -- The snapped value is available in the result in
    -- @SnappedDestinationPositions@.
    --
    -- Valid Values: @[-180 to 180,-90 to 90]@
    CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
destinationPositions :: Prelude.NonEmpty (Data.Sensitive (Prelude.NonEmpty Prelude.Double))
  }
  deriving (CalculateRouteMatrix -> CalculateRouteMatrix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalculateRouteMatrix -> CalculateRouteMatrix -> Bool
$c/= :: CalculateRouteMatrix -> CalculateRouteMatrix -> Bool
== :: CalculateRouteMatrix -> CalculateRouteMatrix -> Bool
$c== :: CalculateRouteMatrix -> CalculateRouteMatrix -> Bool
Prelude.Eq, Int -> CalculateRouteMatrix -> ShowS
[CalculateRouteMatrix] -> ShowS
CalculateRouteMatrix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalculateRouteMatrix] -> ShowS
$cshowList :: [CalculateRouteMatrix] -> ShowS
show :: CalculateRouteMatrix -> String
$cshow :: CalculateRouteMatrix -> String
showsPrec :: Int -> CalculateRouteMatrix -> ShowS
$cshowsPrec :: Int -> CalculateRouteMatrix -> ShowS
Prelude.Show, forall x. Rep CalculateRouteMatrix x -> CalculateRouteMatrix
forall x. CalculateRouteMatrix -> Rep CalculateRouteMatrix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalculateRouteMatrix x -> CalculateRouteMatrix
$cfrom :: forall x. CalculateRouteMatrix -> Rep CalculateRouteMatrix x
Prelude.Generic)

-- |
-- Create a value of 'CalculateRouteMatrix' 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:
--
-- 'carModeOptions', 'calculateRouteMatrix_carModeOptions' - Specifies route preferences when traveling by @Car@, such as avoiding
-- routes that use ferries or tolls.
--
-- Requirements: @TravelMode@ must be specified as @Car@.
--
-- 'departNow', 'calculateRouteMatrix_departNow' - Sets the time of departure as the current time. Uses the current time to
-- calculate the route matrix. You can\'t set both @DepartureTime@ and
-- @DepartNow@. If neither is set, the best time of day to travel with the
-- best traffic conditions is used to calculate the route matrix.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
--
-- 'departureTime', 'calculateRouteMatrix_departureTime' - Specifies the desired time of departure. Uses the given time to
-- calculate the route matrix. You can\'t set both @DepartureTime@ and
-- @DepartNow@. If neither is set, the best time of day to travel with the
-- best traffic conditions is used to calculate the route matrix.
--
-- Setting a departure time in the past returns a @400 ValidationException@
-- error.
--
-- -   In <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
--     format: @YYYY-MM-DDThh:mm:ss.sssZ@. For example,
--     @2020–07-2T12:15:20.000Z+01:00@
--
-- 'distanceUnit', 'calculateRouteMatrix_distanceUnit' - Set the unit system to specify the distance.
--
-- Default Value: @Kilometers@
--
-- 'travelMode', 'calculateRouteMatrix_travelMode' - Specifies the mode of transport when calculating a route. Used in
-- estimating the speed of travel and road compatibility.
--
-- The @TravelMode@ you specify also determines how you specify route
-- preferences:
--
-- -   If traveling by @Car@ use the @CarModeOptions@ parameter.
--
-- -   If traveling by @Truck@ use the @TruckModeOptions@ parameter.
--
-- Default Value: @Car@
--
-- 'truckModeOptions', 'calculateRouteMatrix_truckModeOptions' - Specifies route preferences when traveling by @Truck@, such as avoiding
-- routes that use ferries or tolls, and truck specifications to consider
-- when choosing an optimal road.
--
-- Requirements: @TravelMode@ must be specified as @Truck@.
--
-- 'calculatorName', 'calculateRouteMatrix_calculatorName' - The name of the route calculator resource that you want to use to
-- calculate the route matrix.
--
-- 'departurePositions', 'calculateRouteMatrix_departurePositions' - The list of departure (origin) positions for the route matrix. An array
-- of points, each of which is itself a 2-value array defined in
-- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
-- @[longitude, latitude]@. For example, @[-123.115, 49.285]@.
--
-- Depending on the data provider selected in the route calculator resource
-- there may be additional restrictions on the inputs you can choose. See
-- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
-- in the /Amazon Location Service Developer Guide/.
--
-- For route calculators that use Esri as the data provider, if you specify
-- a departure that\'s not located on a road, Amazon Location
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
-- The snapped value is available in the result in
-- @SnappedDeparturePositions@.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
--
-- 'destinationPositions', 'calculateRouteMatrix_destinationPositions' - The list of destination positions for the route matrix. An array of
-- points, each of which is itself a 2-value array defined in
-- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
-- @[longitude, latitude]@. For example, @[-122.339, 47.615]@
--
-- Depending on the data provider selected in the route calculator resource
-- there may be additional restrictions on the inputs you can choose. See
-- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
-- in the /Amazon Location Service Developer Guide/.
--
-- For route calculators that use Esri as the data provider, if you specify
-- a destination that\'s not located on a road, Amazon Location
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
-- The snapped value is available in the result in
-- @SnappedDestinationPositions@.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
newCalculateRouteMatrix ::
  -- | 'calculatorName'
  Prelude.Text ->
  -- | 'departurePositions'
  Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double) ->
  -- | 'destinationPositions'
  Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double) ->
  CalculateRouteMatrix
newCalculateRouteMatrix :: Text
-> NonEmpty (NonEmpty Double)
-> NonEmpty (NonEmpty Double)
-> CalculateRouteMatrix
newCalculateRouteMatrix
  Text
pCalculatorName_
  NonEmpty (NonEmpty Double)
pDeparturePositions_
  NonEmpty (NonEmpty Double)
pDestinationPositions_ =
    CalculateRouteMatrix'
      { $sel:carModeOptions:CalculateRouteMatrix' :: Maybe CalculateRouteCarModeOptions
carModeOptions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:departNow:CalculateRouteMatrix' :: Maybe Bool
departNow = forall a. Maybe a
Prelude.Nothing,
        $sel:departureTime:CalculateRouteMatrix' :: Maybe ISO8601
departureTime = forall a. Maybe a
Prelude.Nothing,
        $sel:distanceUnit:CalculateRouteMatrix' :: Maybe DistanceUnit
distanceUnit = forall a. Maybe a
Prelude.Nothing,
        $sel:travelMode:CalculateRouteMatrix' :: Maybe TravelMode
travelMode = forall a. Maybe a
Prelude.Nothing,
        $sel:truckModeOptions:CalculateRouteMatrix' :: Maybe CalculateRouteTruckModeOptions
truckModeOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:calculatorName:CalculateRouteMatrix' :: Text
calculatorName = Text
pCalculatorName_,
        $sel:departurePositions:CalculateRouteMatrix' :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty (NonEmpty Double)
pDeparturePositions_,
        $sel:destinationPositions:CalculateRouteMatrix' :: NonEmpty (Sensitive (NonEmpty Double))
destinationPositions =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty (NonEmpty Double)
pDestinationPositions_
      }

-- | Specifies route preferences when traveling by @Car@, such as avoiding
-- routes that use ferries or tolls.
--
-- Requirements: @TravelMode@ must be specified as @Car@.
calculateRouteMatrix_carModeOptions :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe CalculateRouteCarModeOptions)
calculateRouteMatrix_carModeOptions :: Lens' CalculateRouteMatrix (Maybe CalculateRouteCarModeOptions)
calculateRouteMatrix_carModeOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe CalculateRouteCarModeOptions
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:carModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
carModeOptions} -> Maybe CalculateRouteCarModeOptions
carModeOptions) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe CalculateRouteCarModeOptions
a -> CalculateRouteMatrix
s {$sel:carModeOptions:CalculateRouteMatrix' :: Maybe CalculateRouteCarModeOptions
carModeOptions = Maybe CalculateRouteCarModeOptions
a} :: CalculateRouteMatrix)

-- | Sets the time of departure as the current time. Uses the current time to
-- calculate the route matrix. You can\'t set both @DepartureTime@ and
-- @DepartNow@. If neither is set, the best time of day to travel with the
-- best traffic conditions is used to calculate the route matrix.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
calculateRouteMatrix_departNow :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe Prelude.Bool)
calculateRouteMatrix_departNow :: Lens' CalculateRouteMatrix (Maybe Bool)
calculateRouteMatrix_departNow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe Bool
departNow :: Maybe Bool
$sel:departNow:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe Bool
departNow} -> Maybe Bool
departNow) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe Bool
a -> CalculateRouteMatrix
s {$sel:departNow:CalculateRouteMatrix' :: Maybe Bool
departNow = Maybe Bool
a} :: CalculateRouteMatrix)

-- | Specifies the desired time of departure. Uses the given time to
-- calculate the route matrix. You can\'t set both @DepartureTime@ and
-- @DepartNow@. If neither is set, the best time of day to travel with the
-- best traffic conditions is used to calculate the route matrix.
--
-- Setting a departure time in the past returns a @400 ValidationException@
-- error.
--
-- -   In <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
--     format: @YYYY-MM-DDThh:mm:ss.sssZ@. For example,
--     @2020–07-2T12:15:20.000Z+01:00@
calculateRouteMatrix_departureTime :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe Prelude.UTCTime)
calculateRouteMatrix_departureTime :: Lens' CalculateRouteMatrix (Maybe UTCTime)
calculateRouteMatrix_departureTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe ISO8601
departureTime :: Maybe ISO8601
$sel:departureTime:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe ISO8601
departureTime} -> Maybe ISO8601
departureTime) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe ISO8601
a -> CalculateRouteMatrix
s {$sel:departureTime:CalculateRouteMatrix' :: Maybe ISO8601
departureTime = Maybe ISO8601
a} :: CalculateRouteMatrix) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Set the unit system to specify the distance.
--
-- Default Value: @Kilometers@
calculateRouteMatrix_distanceUnit :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe DistanceUnit)
calculateRouteMatrix_distanceUnit :: Lens' CalculateRouteMatrix (Maybe DistanceUnit)
calculateRouteMatrix_distanceUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe DistanceUnit
distanceUnit :: Maybe DistanceUnit
$sel:distanceUnit:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe DistanceUnit
distanceUnit} -> Maybe DistanceUnit
distanceUnit) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe DistanceUnit
a -> CalculateRouteMatrix
s {$sel:distanceUnit:CalculateRouteMatrix' :: Maybe DistanceUnit
distanceUnit = Maybe DistanceUnit
a} :: CalculateRouteMatrix)

-- | Specifies the mode of transport when calculating a route. Used in
-- estimating the speed of travel and road compatibility.
--
-- The @TravelMode@ you specify also determines how you specify route
-- preferences:
--
-- -   If traveling by @Car@ use the @CarModeOptions@ parameter.
--
-- -   If traveling by @Truck@ use the @TruckModeOptions@ parameter.
--
-- Default Value: @Car@
calculateRouteMatrix_travelMode :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe TravelMode)
calculateRouteMatrix_travelMode :: Lens' CalculateRouteMatrix (Maybe TravelMode)
calculateRouteMatrix_travelMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe TravelMode
travelMode :: Maybe TravelMode
$sel:travelMode:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe TravelMode
travelMode} -> Maybe TravelMode
travelMode) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe TravelMode
a -> CalculateRouteMatrix
s {$sel:travelMode:CalculateRouteMatrix' :: Maybe TravelMode
travelMode = Maybe TravelMode
a} :: CalculateRouteMatrix)

-- | Specifies route preferences when traveling by @Truck@, such as avoiding
-- routes that use ferries or tolls, and truck specifications to consider
-- when choosing an optimal road.
--
-- Requirements: @TravelMode@ must be specified as @Truck@.
calculateRouteMatrix_truckModeOptions :: Lens.Lens' CalculateRouteMatrix (Prelude.Maybe CalculateRouteTruckModeOptions)
calculateRouteMatrix_truckModeOptions :: Lens' CalculateRouteMatrix (Maybe CalculateRouteTruckModeOptions)
calculateRouteMatrix_truckModeOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Maybe CalculateRouteTruckModeOptions
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
$sel:truckModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
truckModeOptions} -> Maybe CalculateRouteTruckModeOptions
truckModeOptions) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Maybe CalculateRouteTruckModeOptions
a -> CalculateRouteMatrix
s {$sel:truckModeOptions:CalculateRouteMatrix' :: Maybe CalculateRouteTruckModeOptions
truckModeOptions = Maybe CalculateRouteTruckModeOptions
a} :: CalculateRouteMatrix)

-- | The name of the route calculator resource that you want to use to
-- calculate the route matrix.
calculateRouteMatrix_calculatorName :: Lens.Lens' CalculateRouteMatrix Prelude.Text
calculateRouteMatrix_calculatorName :: Lens' CalculateRouteMatrix Text
calculateRouteMatrix_calculatorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {Text
calculatorName :: Text
$sel:calculatorName:CalculateRouteMatrix' :: CalculateRouteMatrix -> Text
calculatorName} -> Text
calculatorName) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} Text
a -> CalculateRouteMatrix
s {$sel:calculatorName:CalculateRouteMatrix' :: Text
calculatorName = Text
a} :: CalculateRouteMatrix)

-- | The list of departure (origin) positions for the route matrix. An array
-- of points, each of which is itself a 2-value array defined in
-- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
-- @[longitude, latitude]@. For example, @[-123.115, 49.285]@.
--
-- Depending on the data provider selected in the route calculator resource
-- there may be additional restrictions on the inputs you can choose. See
-- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
-- in the /Amazon Location Service Developer Guide/.
--
-- For route calculators that use Esri as the data provider, if you specify
-- a departure that\'s not located on a road, Amazon Location
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
-- The snapped value is available in the result in
-- @SnappedDeparturePositions@.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
calculateRouteMatrix_departurePositions :: Lens.Lens' CalculateRouteMatrix (Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double))
calculateRouteMatrix_departurePositions :: Lens' CalculateRouteMatrix (NonEmpty (NonEmpty Double))
calculateRouteMatrix_departurePositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: NonEmpty (Sensitive (NonEmpty Double))
$sel:departurePositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
departurePositions} -> NonEmpty (Sensitive (NonEmpty Double))
departurePositions) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} NonEmpty (Sensitive (NonEmpty Double))
a -> CalculateRouteMatrix
s {$sel:departurePositions:CalculateRouteMatrix' :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions = NonEmpty (Sensitive (NonEmpty Double))
a} :: CalculateRouteMatrix) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The list of destination positions for the route matrix. An array of
-- points, each of which is itself a 2-value array defined in
-- <https://earth-info.nga.mil/GandG/wgs84/index.html WGS 84> format:
-- @[longitude, latitude]@. For example, @[-122.339, 47.615]@
--
-- Depending on the data provider selected in the route calculator resource
-- there may be additional restrictions on the inputs you can choose. See
-- <https://docs.aws.amazon.com/location/latest/developerguide/calculate-route-matrix.html#matrix-routing-position-limits Position restrictions>
-- in the /Amazon Location Service Developer Guide/.
--
-- For route calculators that use Esri as the data provider, if you specify
-- a destination that\'s not located on a road, Amazon Location
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html moves the position to the nearest road>.
-- The snapped value is available in the result in
-- @SnappedDestinationPositions@.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
calculateRouteMatrix_destinationPositions :: Lens.Lens' CalculateRouteMatrix (Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double))
calculateRouteMatrix_destinationPositions :: Lens' CalculateRouteMatrix (NonEmpty (NonEmpty Double))
calculateRouteMatrix_destinationPositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrix' {NonEmpty (Sensitive (NonEmpty Double))
destinationPositions :: NonEmpty (Sensitive (NonEmpty Double))
$sel:destinationPositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
destinationPositions} -> NonEmpty (Sensitive (NonEmpty Double))
destinationPositions) (\s :: CalculateRouteMatrix
s@CalculateRouteMatrix' {} NonEmpty (Sensitive (NonEmpty Double))
a -> CalculateRouteMatrix
s {$sel:destinationPositions:CalculateRouteMatrix' :: NonEmpty (Sensitive (NonEmpty Double))
destinationPositions = NonEmpty (Sensitive (NonEmpty Double))
a} :: CalculateRouteMatrix) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CalculateRouteMatrix where
  type
    AWSResponse CalculateRouteMatrix =
      CalculateRouteMatrixResponse
  request :: (Service -> Service)
-> CalculateRouteMatrix -> Request CalculateRouteMatrix
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 CalculateRouteMatrix
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CalculateRouteMatrix)))
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 (NonEmpty (Sensitive (NonEmpty Double)))
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
-> Int
-> [[RouteMatrixEntry]]
-> CalculateRouteMatrixSummary
-> CalculateRouteMatrixResponse
CalculateRouteMatrixResponse'
            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
"SnappedDeparturePositions")
            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
"SnappedDestinationPositions")
            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))
            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
"RouteMatrix" 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 a
Data..:> Key
"Summary")
      )

instance Prelude.Hashable CalculateRouteMatrix where
  hashWithSalt :: Int -> CalculateRouteMatrix -> Int
hashWithSalt Int
_salt CalculateRouteMatrix' {Maybe Bool
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
NonEmpty (Sensitive (NonEmpty Double))
Text
destinationPositions :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: NonEmpty (Sensitive (NonEmpty Double))
calculatorName :: Text
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:departurePositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:calculatorName:CalculateRouteMatrix' :: CalculateRouteMatrix -> Text
$sel:truckModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe TravelMode
$sel:distanceUnit:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe DistanceUnit
$sel:departureTime:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe ISO8601
$sel:departNow:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe Bool
$sel:carModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CalculateRouteCarModeOptions
carModeOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
departNow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
departureTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DistanceUnit
distanceUnit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TravelMode
travelMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CalculateRouteTruckModeOptions
truckModeOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
calculatorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty (Sensitive (NonEmpty Double))
departurePositions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty (Sensitive (NonEmpty Double))
destinationPositions

instance Prelude.NFData CalculateRouteMatrix where
  rnf :: CalculateRouteMatrix -> ()
rnf CalculateRouteMatrix' {Maybe Bool
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
NonEmpty (Sensitive (NonEmpty Double))
Text
destinationPositions :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: NonEmpty (Sensitive (NonEmpty Double))
calculatorName :: Text
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:departurePositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:calculatorName:CalculateRouteMatrix' :: CalculateRouteMatrix -> Text
$sel:truckModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe TravelMode
$sel:distanceUnit:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe DistanceUnit
$sel:departureTime:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe ISO8601
$sel:departNow:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe Bool
$sel:carModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculateRouteCarModeOptions
carModeOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
departNow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
departureTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DistanceUnit
distanceUnit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TravelMode
travelMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculateRouteTruckModeOptions
truckModeOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
calculatorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty (Sensitive (NonEmpty Double))
departurePositions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty (Sensitive (NonEmpty Double))
destinationPositions

instance Data.ToHeaders CalculateRouteMatrix where
  toHeaders :: CalculateRouteMatrix -> 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.ToJSON CalculateRouteMatrix where
  toJSON :: CalculateRouteMatrix -> Value
toJSON CalculateRouteMatrix' {Maybe Bool
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
NonEmpty (Sensitive (NonEmpty Double))
Text
destinationPositions :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: NonEmpty (Sensitive (NonEmpty Double))
calculatorName :: Text
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:departurePositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:calculatorName:CalculateRouteMatrix' :: CalculateRouteMatrix -> Text
$sel:truckModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe TravelMode
$sel:distanceUnit:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe DistanceUnit
$sel:departureTime:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe ISO8601
$sel:departNow:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe Bool
$sel:carModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CarModeOptions" 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 CalculateRouteCarModeOptions
carModeOptions,
            (Key
"DepartNow" 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 Bool
departNow,
            (Key
"DepartureTime" 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 ISO8601
departureTime,
            (Key
"DistanceUnit" 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 DistanceUnit
distanceUnit,
            (Key
"TravelMode" 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 TravelMode
travelMode,
            (Key
"TruckModeOptions" 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 CalculateRouteTruckModeOptions
truckModeOptions,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DeparturePositions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty (Sensitive (NonEmpty Double))
departurePositions),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DestinationPositions"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty (Sensitive (NonEmpty Double))
destinationPositions
              )
          ]
      )

instance Data.ToPath CalculateRouteMatrix where
  toPath :: CalculateRouteMatrix -> ByteString
toPath CalculateRouteMatrix' {Maybe Bool
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
NonEmpty (Sensitive (NonEmpty Double))
Text
destinationPositions :: NonEmpty (Sensitive (NonEmpty Double))
departurePositions :: NonEmpty (Sensitive (NonEmpty Double))
calculatorName :: Text
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:departurePositions:CalculateRouteMatrix' :: CalculateRouteMatrix -> NonEmpty (Sensitive (NonEmpty Double))
$sel:calculatorName:CalculateRouteMatrix' :: CalculateRouteMatrix -> Text
$sel:truckModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe TravelMode
$sel:distanceUnit:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe DistanceUnit
$sel:departureTime:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe ISO8601
$sel:departNow:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe Bool
$sel:carModeOptions:CalculateRouteMatrix' :: CalculateRouteMatrix -> Maybe CalculateRouteCarModeOptions
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/routes/v0/calculators/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
calculatorName,
        ByteString
"/calculate/route-matrix"
      ]

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

-- | Returns the result of the route matrix calculation.
--
-- /See:/ 'newCalculateRouteMatrixResponse' smart constructor.
data CalculateRouteMatrixResponse = CalculateRouteMatrixResponse'
  { -- | For routes calculated using an Esri route calculator resource, departure
    -- positions are snapped to the closest road. For Esri route calculator
    -- resources, this returns the list of departure\/origin positions used for
    -- calculation of the @RouteMatrix@.
    CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions :: Prelude.Maybe (Prelude.NonEmpty (Data.Sensitive (Prelude.NonEmpty Prelude.Double))),
    -- | The list of destination positions for the route matrix used for
    -- calculation of the @RouteMatrix@.
    CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions :: Prelude.Maybe (Prelude.NonEmpty (Data.Sensitive (Prelude.NonEmpty Prelude.Double))),
    -- | The response's http status code.
    CalculateRouteMatrixResponse -> Int
httpStatus :: Prelude.Int,
    -- | The calculated route matrix containing the results for all pairs of
    -- @DeparturePositions@ to @DestinationPositions@. Each row corresponds to
    -- one entry in @DeparturePositions@. Each entry in the row corresponds to
    -- the route from that entry in @DeparturePositions@ to an entry in
    -- @DestinationPositions@.
    CalculateRouteMatrixResponse -> [[RouteMatrixEntry]]
routeMatrix :: [[RouteMatrixEntry]],
    -- | Contains information about the route matrix, @DataSource@,
    -- @DistanceUnit@, @RouteCount@ and @ErrorCount@.
    CalculateRouteMatrixResponse -> CalculateRouteMatrixSummary
summary :: CalculateRouteMatrixSummary
  }
  deriving (CalculateRouteMatrixResponse
-> CalculateRouteMatrixResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalculateRouteMatrixResponse
-> CalculateRouteMatrixResponse -> Bool
$c/= :: CalculateRouteMatrixResponse
-> CalculateRouteMatrixResponse -> Bool
== :: CalculateRouteMatrixResponse
-> CalculateRouteMatrixResponse -> Bool
$c== :: CalculateRouteMatrixResponse
-> CalculateRouteMatrixResponse -> Bool
Prelude.Eq, Int -> CalculateRouteMatrixResponse -> ShowS
[CalculateRouteMatrixResponse] -> ShowS
CalculateRouteMatrixResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalculateRouteMatrixResponse] -> ShowS
$cshowList :: [CalculateRouteMatrixResponse] -> ShowS
show :: CalculateRouteMatrixResponse -> String
$cshow :: CalculateRouteMatrixResponse -> String
showsPrec :: Int -> CalculateRouteMatrixResponse -> ShowS
$cshowsPrec :: Int -> CalculateRouteMatrixResponse -> ShowS
Prelude.Show, forall x.
Rep CalculateRouteMatrixResponse x -> CalculateRouteMatrixResponse
forall x.
CalculateRouteMatrixResponse -> Rep CalculateRouteMatrixResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CalculateRouteMatrixResponse x -> CalculateRouteMatrixResponse
$cfrom :: forall x.
CalculateRouteMatrixResponse -> Rep CalculateRouteMatrixResponse x
Prelude.Generic)

-- |
-- Create a value of 'CalculateRouteMatrixResponse' 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:
--
-- 'snappedDeparturePositions', 'calculateRouteMatrixResponse_snappedDeparturePositions' - For routes calculated using an Esri route calculator resource, departure
-- positions are snapped to the closest road. For Esri route calculator
-- resources, this returns the list of departure\/origin positions used for
-- calculation of the @RouteMatrix@.
--
-- 'snappedDestinationPositions', 'calculateRouteMatrixResponse_snappedDestinationPositions' - The list of destination positions for the route matrix used for
-- calculation of the @RouteMatrix@.
--
-- 'httpStatus', 'calculateRouteMatrixResponse_httpStatus' - The response's http status code.
--
-- 'routeMatrix', 'calculateRouteMatrixResponse_routeMatrix' - The calculated route matrix containing the results for all pairs of
-- @DeparturePositions@ to @DestinationPositions@. Each row corresponds to
-- one entry in @DeparturePositions@. Each entry in the row corresponds to
-- the route from that entry in @DeparturePositions@ to an entry in
-- @DestinationPositions@.
--
-- 'summary', 'calculateRouteMatrixResponse_summary' - Contains information about the route matrix, @DataSource@,
-- @DistanceUnit@, @RouteCount@ and @ErrorCount@.
newCalculateRouteMatrixResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'summary'
  CalculateRouteMatrixSummary ->
  CalculateRouteMatrixResponse
newCalculateRouteMatrixResponse :: Int -> CalculateRouteMatrixSummary -> CalculateRouteMatrixResponse
newCalculateRouteMatrixResponse
  Int
pHttpStatus_
  CalculateRouteMatrixSummary
pSummary_ =
    CalculateRouteMatrixResponse'
      { $sel:snappedDeparturePositions:CalculateRouteMatrixResponse' :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:snappedDestinationPositions:CalculateRouteMatrixResponse' :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CalculateRouteMatrixResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:routeMatrix:CalculateRouteMatrixResponse' :: [[RouteMatrixEntry]]
routeMatrix = forall a. Monoid a => a
Prelude.mempty,
        $sel:summary:CalculateRouteMatrixResponse' :: CalculateRouteMatrixSummary
summary = CalculateRouteMatrixSummary
pSummary_
      }

-- | For routes calculated using an Esri route calculator resource, departure
-- positions are snapped to the closest road. For Esri route calculator
-- resources, this returns the list of departure\/origin positions used for
-- calculation of the @RouteMatrix@.
calculateRouteMatrixResponse_snappedDeparturePositions :: Lens.Lens' CalculateRouteMatrixResponse (Prelude.Maybe (Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double)))
calculateRouteMatrixResponse_snappedDeparturePositions :: Lens'
  CalculateRouteMatrixResponse (Maybe (NonEmpty (NonEmpty Double)))
calculateRouteMatrixResponse_snappedDeparturePositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrixResponse' {Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
$sel:snappedDeparturePositions:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions} -> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions) (\s :: CalculateRouteMatrixResponse
s@CalculateRouteMatrixResponse' {} Maybe (NonEmpty (Sensitive (NonEmpty Double)))
a -> CalculateRouteMatrixResponse
s {$sel:snappedDeparturePositions:CalculateRouteMatrixResponse' :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions = Maybe (NonEmpty (Sensitive (NonEmpty Double)))
a} :: CalculateRouteMatrixResponse) 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 list of destination positions for the route matrix used for
-- calculation of the @RouteMatrix@.
calculateRouteMatrixResponse_snappedDestinationPositions :: Lens.Lens' CalculateRouteMatrixResponse (Prelude.Maybe (Prelude.NonEmpty (Prelude.NonEmpty Prelude.Double)))
calculateRouteMatrixResponse_snappedDestinationPositions :: Lens'
  CalculateRouteMatrixResponse (Maybe (NonEmpty (NonEmpty Double)))
calculateRouteMatrixResponse_snappedDestinationPositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrixResponse' {Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
$sel:snappedDestinationPositions:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions} -> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions) (\s :: CalculateRouteMatrixResponse
s@CalculateRouteMatrixResponse' {} Maybe (NonEmpty (Sensitive (NonEmpty Double)))
a -> CalculateRouteMatrixResponse
s {$sel:snappedDestinationPositions:CalculateRouteMatrixResponse' :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions = Maybe (NonEmpty (Sensitive (NonEmpty Double)))
a} :: CalculateRouteMatrixResponse) 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.
calculateRouteMatrixResponse_httpStatus :: Lens.Lens' CalculateRouteMatrixResponse Prelude.Int
calculateRouteMatrixResponse_httpStatus :: Lens' CalculateRouteMatrixResponse Int
calculateRouteMatrixResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrixResponse' {Int
httpStatus :: Int
$sel:httpStatus:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CalculateRouteMatrixResponse
s@CalculateRouteMatrixResponse' {} Int
a -> CalculateRouteMatrixResponse
s {$sel:httpStatus:CalculateRouteMatrixResponse' :: Int
httpStatus = Int
a} :: CalculateRouteMatrixResponse)

-- | The calculated route matrix containing the results for all pairs of
-- @DeparturePositions@ to @DestinationPositions@. Each row corresponds to
-- one entry in @DeparturePositions@. Each entry in the row corresponds to
-- the route from that entry in @DeparturePositions@ to an entry in
-- @DestinationPositions@.
calculateRouteMatrixResponse_routeMatrix :: Lens.Lens' CalculateRouteMatrixResponse [[RouteMatrixEntry]]
calculateRouteMatrixResponse_routeMatrix :: Lens' CalculateRouteMatrixResponse [[RouteMatrixEntry]]
calculateRouteMatrixResponse_routeMatrix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrixResponse' {[[RouteMatrixEntry]]
routeMatrix :: [[RouteMatrixEntry]]
$sel:routeMatrix:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> [[RouteMatrixEntry]]
routeMatrix} -> [[RouteMatrixEntry]]
routeMatrix) (\s :: CalculateRouteMatrixResponse
s@CalculateRouteMatrixResponse' {} [[RouteMatrixEntry]]
a -> CalculateRouteMatrixResponse
s {$sel:routeMatrix:CalculateRouteMatrixResponse' :: [[RouteMatrixEntry]]
routeMatrix = [[RouteMatrixEntry]]
a} :: CalculateRouteMatrixResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Contains information about the route matrix, @DataSource@,
-- @DistanceUnit@, @RouteCount@ and @ErrorCount@.
calculateRouteMatrixResponse_summary :: Lens.Lens' CalculateRouteMatrixResponse CalculateRouteMatrixSummary
calculateRouteMatrixResponse_summary :: Lens' CalculateRouteMatrixResponse CalculateRouteMatrixSummary
calculateRouteMatrixResponse_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteMatrixResponse' {CalculateRouteMatrixSummary
summary :: CalculateRouteMatrixSummary
$sel:summary:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> CalculateRouteMatrixSummary
summary} -> CalculateRouteMatrixSummary
summary) (\s :: CalculateRouteMatrixResponse
s@CalculateRouteMatrixResponse' {} CalculateRouteMatrixSummary
a -> CalculateRouteMatrixResponse
s {$sel:summary:CalculateRouteMatrixResponse' :: CalculateRouteMatrixSummary
summary = CalculateRouteMatrixSummary
a} :: CalculateRouteMatrixResponse)

instance Prelude.NFData CalculateRouteMatrixResponse where
  rnf :: CalculateRouteMatrixResponse -> ()
rnf CalculateRouteMatrixResponse' {Int
[[RouteMatrixEntry]]
Maybe (NonEmpty (Sensitive (NonEmpty Double)))
CalculateRouteMatrixSummary
summary :: CalculateRouteMatrixSummary
routeMatrix :: [[RouteMatrixEntry]]
httpStatus :: Int
snappedDestinationPositions :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions :: Maybe (NonEmpty (Sensitive (NonEmpty Double)))
$sel:summary:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> CalculateRouteMatrixSummary
$sel:routeMatrix:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> [[RouteMatrixEntry]]
$sel:httpStatus:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse -> Int
$sel:snappedDestinationPositions:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
$sel:snappedDeparturePositions:CalculateRouteMatrixResponse' :: CalculateRouteMatrixResponse
-> Maybe (NonEmpty (Sensitive (NonEmpty Double)))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDeparturePositions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty (Sensitive (NonEmpty Double)))
snappedDestinationPositions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [[RouteMatrixEntry]]
routeMatrix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CalculateRouteMatrixSummary
summary