{-# 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.CalculateRoute
-- 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.html Calculates a route>
-- given the following required parameters: @DeparturePosition@ and
-- @DestinationPosition@. 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 the route.
--
-- 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 a route
--     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@.
--
--     If you specify @walking@ for the travel mode and your data provider
--     is Esri, the start and destination must be within 40km.
module Amazonka.Location.CalculateRoute
  ( -- * Creating a Request
    CalculateRoute (..),
    newCalculateRoute,

    -- * Request Lenses
    calculateRoute_carModeOptions,
    calculateRoute_departNow,
    calculateRoute_departureTime,
    calculateRoute_distanceUnit,
    calculateRoute_includeLegGeometry,
    calculateRoute_travelMode,
    calculateRoute_truckModeOptions,
    calculateRoute_waypointPositions,
    calculateRoute_calculatorName,
    calculateRoute_departurePosition,
    calculateRoute_destinationPosition,

    -- * Destructuring the Response
    CalculateRouteResponse (..),
    newCalculateRouteResponse,

    -- * Response Lenses
    calculateRouteResponse_httpStatus,
    calculateRouteResponse_legs,
    calculateRouteResponse_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:/ 'newCalculateRoute' smart constructor.
data CalculateRoute = CalculateRoute'
  { -- | Specifies route preferences when traveling by @Car@, such as avoiding
    -- routes that use ferries or tolls.
    --
    -- Requirements: @TravelMode@ must be specified as @Car@.
    CalculateRoute -> Maybe CalculateRouteCarModeOptions
carModeOptions :: Prelude.Maybe CalculateRouteCarModeOptions,
    -- | Sets the time of departure as the current time. Uses the current time to
    -- calculate a route. Otherwise, the best time of day to travel with the
    -- best traffic conditions is used to calculate the route.
    --
    -- Default Value: @false@
    --
    -- Valid Values: @false@ | @true@
    CalculateRoute -> Maybe Bool
departNow :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the desired time of departure. Uses the given time to
    -- calculate the route. Otherwise, the best time of day to travel with the
    -- best traffic conditions is used to calculate the route.
    --
    -- 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@
    CalculateRoute -> Maybe ISO8601
departureTime :: Prelude.Maybe Data.ISO8601,
    -- | Set the unit system to specify the distance.
    --
    -- Default Value: @Kilometers@
    CalculateRoute -> Maybe DistanceUnit
distanceUnit :: Prelude.Maybe DistanceUnit,
    -- | Set to include the geometry details in the result for each path between
    -- a pair of positions.
    --
    -- Default Value: @false@
    --
    -- Valid Values: @false@ | @true@
    CalculateRoute -> Maybe Bool
includeLegGeometry :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the mode of transport when calculating a route. Used in
    -- estimating the speed of travel and road compatibility. You can choose
    -- @Car@, @Truck@, or @Walking@ as options for the @TravelMode@.
    --
    -- 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@
    CalculateRoute -> 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@.
    CalculateRoute -> Maybe CalculateRouteTruckModeOptions
truckModeOptions :: Prelude.Maybe CalculateRouteTruckModeOptions,
    -- | Specifies an ordered list of up to 23 intermediate positions to include
    -- along a route between the departure position and destination position.
    --
    -- -   For example, from the @DeparturePosition@ @[-123.115, 49.285]@, the
    --     route follows the order that the waypoint positions are given
    --     @[[-122.757, 49.0021],[-122.349, 47.620]]@
    --
    -- If you specify a waypoint position 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>.
    --
    -- Specifying more than 23 waypoints returns a @400 ValidationException@
    -- error.
    --
    -- If Esri is the provider for your route calculator, specifying a route
    -- that is longer than 400 km returns a @400 RoutesValidationException@
    -- error.
    --
    -- Valid Values: @[-180 to 180,-90 to 90]@
    CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
waypointPositions :: Prelude.Maybe [Data.Sensitive (Prelude.NonEmpty Prelude.Double)],
    -- | The name of the route calculator resource that you want to use to
    -- calculate the route.
    CalculateRoute -> Text
calculatorName :: Prelude.Text,
    -- | The start position for the route. Defined in
    -- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
    -- format: @[longitude, latitude]@.
    --
    -- -   For example, @[-123.115, 49.285]@
    --
    -- 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>.
    -- If Esri is the provider for your route calculator, specifying a route
    -- that is longer than 400 km returns a @400 RoutesValidationException@
    -- error.
    --
    -- Valid Values: @[-180 to 180,-90 to 90]@
    CalculateRoute -> Sensitive (NonEmpty Double)
departurePosition :: Data.Sensitive (Prelude.NonEmpty Prelude.Double),
    -- | The finish position for the route. Defined in
    -- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
    -- format: @[longitude, latitude]@.
    --
    -- -   For example, @[-122.339, 47.615]@
    --
    -- 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>.
    --
    -- Valid Values: @[-180 to 180,-90 to 90]@
    CalculateRoute -> Sensitive (NonEmpty Double)
destinationPosition :: Data.Sensitive (Prelude.NonEmpty Prelude.Double)
  }
  deriving (CalculateRoute -> CalculateRoute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalculateRoute -> CalculateRoute -> Bool
$c/= :: CalculateRoute -> CalculateRoute -> Bool
== :: CalculateRoute -> CalculateRoute -> Bool
$c== :: CalculateRoute -> CalculateRoute -> Bool
Prelude.Eq, Int -> CalculateRoute -> ShowS
[CalculateRoute] -> ShowS
CalculateRoute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalculateRoute] -> ShowS
$cshowList :: [CalculateRoute] -> ShowS
show :: CalculateRoute -> String
$cshow :: CalculateRoute -> String
showsPrec :: Int -> CalculateRoute -> ShowS
$cshowsPrec :: Int -> CalculateRoute -> ShowS
Prelude.Show, forall x. Rep CalculateRoute x -> CalculateRoute
forall x. CalculateRoute -> Rep CalculateRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalculateRoute x -> CalculateRoute
$cfrom :: forall x. CalculateRoute -> Rep CalculateRoute x
Prelude.Generic)

-- |
-- Create a value of 'CalculateRoute' 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', 'calculateRoute_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', 'calculateRoute_departNow' - Sets the time of departure as the current time. Uses the current time to
-- calculate a route. Otherwise, the best time of day to travel with the
-- best traffic conditions is used to calculate the route.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
--
-- 'departureTime', 'calculateRoute_departureTime' - Specifies the desired time of departure. Uses the given time to
-- calculate the route. Otherwise, the best time of day to travel with the
-- best traffic conditions is used to calculate the route.
--
-- 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', 'calculateRoute_distanceUnit' - Set the unit system to specify the distance.
--
-- Default Value: @Kilometers@
--
-- 'includeLegGeometry', 'calculateRoute_includeLegGeometry' - Set to include the geometry details in the result for each path between
-- a pair of positions.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
--
-- 'travelMode', 'calculateRoute_travelMode' - Specifies the mode of transport when calculating a route. Used in
-- estimating the speed of travel and road compatibility. You can choose
-- @Car@, @Truck@, or @Walking@ as options for the @TravelMode@.
--
-- 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', 'calculateRoute_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@.
--
-- 'waypointPositions', 'calculateRoute_waypointPositions' - Specifies an ordered list of up to 23 intermediate positions to include
-- along a route between the departure position and destination position.
--
-- -   For example, from the @DeparturePosition@ @[-123.115, 49.285]@, the
--     route follows the order that the waypoint positions are given
--     @[[-122.757, 49.0021],[-122.349, 47.620]]@
--
-- If you specify a waypoint position 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>.
--
-- Specifying more than 23 waypoints returns a @400 ValidationException@
-- error.
--
-- If Esri is the provider for your route calculator, specifying a route
-- that is longer than 400 km returns a @400 RoutesValidationException@
-- error.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
--
-- 'calculatorName', 'calculateRoute_calculatorName' - The name of the route calculator resource that you want to use to
-- calculate the route.
--
-- 'departurePosition', 'calculateRoute_departurePosition' - The start position for the route. Defined in
-- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
-- format: @[longitude, latitude]@.
--
-- -   For example, @[-123.115, 49.285]@
--
-- 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>.
-- If Esri is the provider for your route calculator, specifying a route
-- that is longer than 400 km returns a @400 RoutesValidationException@
-- error.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
--
-- 'destinationPosition', 'calculateRoute_destinationPosition' - The finish position for the route. Defined in
-- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
-- format: @[longitude, latitude]@.
--
-- -   For example, @[-122.339, 47.615]@
--
-- 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>.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
newCalculateRoute ::
  -- | 'calculatorName'
  Prelude.Text ->
  -- | 'departurePosition'
  Prelude.NonEmpty Prelude.Double ->
  -- | 'destinationPosition'
  Prelude.NonEmpty Prelude.Double ->
  CalculateRoute
newCalculateRoute :: Text -> NonEmpty Double -> NonEmpty Double -> CalculateRoute
newCalculateRoute
  Text
pCalculatorName_
  NonEmpty Double
pDeparturePosition_
  NonEmpty Double
pDestinationPosition_ =
    CalculateRoute'
      { $sel:carModeOptions:CalculateRoute' :: Maybe CalculateRouteCarModeOptions
carModeOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:departNow:CalculateRoute' :: Maybe Bool
departNow = forall a. Maybe a
Prelude.Nothing,
        $sel:departureTime:CalculateRoute' :: Maybe ISO8601
departureTime = forall a. Maybe a
Prelude.Nothing,
        $sel:distanceUnit:CalculateRoute' :: Maybe DistanceUnit
distanceUnit = forall a. Maybe a
Prelude.Nothing,
        $sel:includeLegGeometry:CalculateRoute' :: Maybe Bool
includeLegGeometry = forall a. Maybe a
Prelude.Nothing,
        $sel:travelMode:CalculateRoute' :: Maybe TravelMode
travelMode = forall a. Maybe a
Prelude.Nothing,
        $sel:truckModeOptions:CalculateRoute' :: Maybe CalculateRouteTruckModeOptions
truckModeOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:waypointPositions:CalculateRoute' :: Maybe [Sensitive (NonEmpty Double)]
waypointPositions = forall a. Maybe a
Prelude.Nothing,
        $sel:calculatorName:CalculateRoute' :: Text
calculatorName = Text
pCalculatorName_,
        $sel:departurePosition:CalculateRoute' :: Sensitive (NonEmpty Double)
departurePosition =
          forall a. Iso' (Sensitive a) a
Data._Sensitive
            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
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty Double
pDeparturePosition_,
        $sel:destinationPosition:CalculateRoute' :: Sensitive (NonEmpty Double)
destinationPosition =
          forall a. Iso' (Sensitive a) a
Data._Sensitive
            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
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty Double
pDestinationPosition_
      }

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

-- | Sets the time of departure as the current time. Uses the current time to
-- calculate a route. Otherwise, the best time of day to travel with the
-- best traffic conditions is used to calculate the route.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
calculateRoute_departNow :: Lens.Lens' CalculateRoute (Prelude.Maybe Prelude.Bool)
calculateRoute_departNow :: Lens' CalculateRoute (Maybe Bool)
calculateRoute_departNow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe Bool
departNow :: Maybe Bool
$sel:departNow:CalculateRoute' :: CalculateRoute -> Maybe Bool
departNow} -> Maybe Bool
departNow) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe Bool
a -> CalculateRoute
s {$sel:departNow:CalculateRoute' :: Maybe Bool
departNow = Maybe Bool
a} :: CalculateRoute)

-- | Specifies the desired time of departure. Uses the given time to
-- calculate the route. Otherwise, the best time of day to travel with the
-- best traffic conditions is used to calculate the route.
--
-- 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@
calculateRoute_departureTime :: Lens.Lens' CalculateRoute (Prelude.Maybe Prelude.UTCTime)
calculateRoute_departureTime :: Lens' CalculateRoute (Maybe UTCTime)
calculateRoute_departureTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe ISO8601
departureTime :: Maybe ISO8601
$sel:departureTime:CalculateRoute' :: CalculateRoute -> Maybe ISO8601
departureTime} -> Maybe ISO8601
departureTime) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe ISO8601
a -> CalculateRoute
s {$sel:departureTime:CalculateRoute' :: Maybe ISO8601
departureTime = Maybe ISO8601
a} :: CalculateRoute) 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@
calculateRoute_distanceUnit :: Lens.Lens' CalculateRoute (Prelude.Maybe DistanceUnit)
calculateRoute_distanceUnit :: Lens' CalculateRoute (Maybe DistanceUnit)
calculateRoute_distanceUnit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe DistanceUnit
distanceUnit :: Maybe DistanceUnit
$sel:distanceUnit:CalculateRoute' :: CalculateRoute -> Maybe DistanceUnit
distanceUnit} -> Maybe DistanceUnit
distanceUnit) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe DistanceUnit
a -> CalculateRoute
s {$sel:distanceUnit:CalculateRoute' :: Maybe DistanceUnit
distanceUnit = Maybe DistanceUnit
a} :: CalculateRoute)

-- | Set to include the geometry details in the result for each path between
-- a pair of positions.
--
-- Default Value: @false@
--
-- Valid Values: @false@ | @true@
calculateRoute_includeLegGeometry :: Lens.Lens' CalculateRoute (Prelude.Maybe Prelude.Bool)
calculateRoute_includeLegGeometry :: Lens' CalculateRoute (Maybe Bool)
calculateRoute_includeLegGeometry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe Bool
includeLegGeometry :: Maybe Bool
$sel:includeLegGeometry:CalculateRoute' :: CalculateRoute -> Maybe Bool
includeLegGeometry} -> Maybe Bool
includeLegGeometry) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe Bool
a -> CalculateRoute
s {$sel:includeLegGeometry:CalculateRoute' :: Maybe Bool
includeLegGeometry = Maybe Bool
a} :: CalculateRoute)

-- | Specifies the mode of transport when calculating a route. Used in
-- estimating the speed of travel and road compatibility. You can choose
-- @Car@, @Truck@, or @Walking@ as options for the @TravelMode@.
--
-- 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@
calculateRoute_travelMode :: Lens.Lens' CalculateRoute (Prelude.Maybe TravelMode)
calculateRoute_travelMode :: Lens' CalculateRoute (Maybe TravelMode)
calculateRoute_travelMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe TravelMode
travelMode :: Maybe TravelMode
$sel:travelMode:CalculateRoute' :: CalculateRoute -> Maybe TravelMode
travelMode} -> Maybe TravelMode
travelMode) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe TravelMode
a -> CalculateRoute
s {$sel:travelMode:CalculateRoute' :: Maybe TravelMode
travelMode = Maybe TravelMode
a} :: CalculateRoute)

-- | 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@.
calculateRoute_truckModeOptions :: Lens.Lens' CalculateRoute (Prelude.Maybe CalculateRouteTruckModeOptions)
calculateRoute_truckModeOptions :: Lens' CalculateRoute (Maybe CalculateRouteTruckModeOptions)
calculateRoute_truckModeOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe CalculateRouteTruckModeOptions
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
$sel:truckModeOptions:CalculateRoute' :: CalculateRoute -> Maybe CalculateRouteTruckModeOptions
truckModeOptions} -> Maybe CalculateRouteTruckModeOptions
truckModeOptions) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe CalculateRouteTruckModeOptions
a -> CalculateRoute
s {$sel:truckModeOptions:CalculateRoute' :: Maybe CalculateRouteTruckModeOptions
truckModeOptions = Maybe CalculateRouteTruckModeOptions
a} :: CalculateRoute)

-- | Specifies an ordered list of up to 23 intermediate positions to include
-- along a route between the departure position and destination position.
--
-- -   For example, from the @DeparturePosition@ @[-123.115, 49.285]@, the
--     route follows the order that the waypoint positions are given
--     @[[-122.757, 49.0021],[-122.349, 47.620]]@
--
-- If you specify a waypoint position 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>.
--
-- Specifying more than 23 waypoints returns a @400 ValidationException@
-- error.
--
-- If Esri is the provider for your route calculator, specifying a route
-- that is longer than 400 km returns a @400 RoutesValidationException@
-- error.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
calculateRoute_waypointPositions :: Lens.Lens' CalculateRoute (Prelude.Maybe [Prelude.NonEmpty Prelude.Double])
calculateRoute_waypointPositions :: Lens' CalculateRoute (Maybe [NonEmpty Double])
calculateRoute_waypointPositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Maybe [Sensitive (NonEmpty Double)]
waypointPositions :: Maybe [Sensitive (NonEmpty Double)]
$sel:waypointPositions:CalculateRoute' :: CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
waypointPositions} -> Maybe [Sensitive (NonEmpty Double)]
waypointPositions) (\s :: CalculateRoute
s@CalculateRoute' {} Maybe [Sensitive (NonEmpty Double)]
a -> CalculateRoute
s {$sel:waypointPositions:CalculateRoute' :: Maybe [Sensitive (NonEmpty Double)]
waypointPositions = Maybe [Sensitive (NonEmpty Double)]
a} :: CalculateRoute) 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 name of the route calculator resource that you want to use to
-- calculate the route.
calculateRoute_calculatorName :: Lens.Lens' CalculateRoute Prelude.Text
calculateRoute_calculatorName :: Lens' CalculateRoute Text
calculateRoute_calculatorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Text
calculatorName :: Text
$sel:calculatorName:CalculateRoute' :: CalculateRoute -> Text
calculatorName} -> Text
calculatorName) (\s :: CalculateRoute
s@CalculateRoute' {} Text
a -> CalculateRoute
s {$sel:calculatorName:CalculateRoute' :: Text
calculatorName = Text
a} :: CalculateRoute)

-- | The start position for the route. Defined in
-- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
-- format: @[longitude, latitude]@.
--
-- -   For example, @[-123.115, 49.285]@
--
-- 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>.
-- If Esri is the provider for your route calculator, specifying a route
-- that is longer than 400 km returns a @400 RoutesValidationException@
-- error.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
calculateRoute_departurePosition :: Lens.Lens' CalculateRoute (Prelude.NonEmpty Prelude.Double)
calculateRoute_departurePosition :: Lens' CalculateRoute (NonEmpty Double)
calculateRoute_departurePosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Sensitive (NonEmpty Double)
departurePosition :: Sensitive (NonEmpty Double)
$sel:departurePosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
departurePosition} -> Sensitive (NonEmpty Double)
departurePosition) (\s :: CalculateRoute
s@CalculateRoute' {} Sensitive (NonEmpty Double)
a -> CalculateRoute
s {$sel:departurePosition:CalculateRoute' :: Sensitive (NonEmpty Double)
departurePosition = Sensitive (NonEmpty Double)
a} :: CalculateRoute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive 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 finish position for the route. Defined in
-- <https://earth-info.nga.mil/index.php?dir=wgs84&action=wgs84 World Geodetic System (WGS 84)>
-- format: @[longitude, latitude]@.
--
-- -   For example, @[-122.339, 47.615]@
--
-- 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>.
--
-- Valid Values: @[-180 to 180,-90 to 90]@
calculateRoute_destinationPosition :: Lens.Lens' CalculateRoute (Prelude.NonEmpty Prelude.Double)
calculateRoute_destinationPosition :: Lens' CalculateRoute (NonEmpty Double)
calculateRoute_destinationPosition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRoute' {Sensitive (NonEmpty Double)
destinationPosition :: Sensitive (NonEmpty Double)
$sel:destinationPosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
destinationPosition} -> Sensitive (NonEmpty Double)
destinationPosition) (\s :: CalculateRoute
s@CalculateRoute' {} Sensitive (NonEmpty Double)
a -> CalculateRoute
s {$sel:destinationPosition:CalculateRoute' :: Sensitive (NonEmpty Double)
destinationPosition = Sensitive (NonEmpty Double)
a} :: CalculateRoute) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive 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 CalculateRoute where
  type
    AWSResponse CalculateRoute =
      CalculateRouteResponse
  request :: (Service -> Service) -> CalculateRoute -> Request CalculateRoute
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 CalculateRoute
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CalculateRoute)))
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 ->
          Int -> [Leg] -> CalculateRouteSummary -> CalculateRouteResponse
CalculateRouteResponse'
            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))
            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
"Legs" 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 CalculateRoute where
  hashWithSalt :: Int -> CalculateRoute -> Int
hashWithSalt Int
_salt CalculateRoute' {Maybe Bool
Maybe [Sensitive (NonEmpty Double)]
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
Text
Sensitive (NonEmpty Double)
destinationPosition :: Sensitive (NonEmpty Double)
departurePosition :: Sensitive (NonEmpty Double)
calculatorName :: Text
waypointPositions :: Maybe [Sensitive (NonEmpty Double)]
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
includeLegGeometry :: Maybe Bool
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:departurePosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:calculatorName:CalculateRoute' :: CalculateRoute -> Text
$sel:waypointPositions:CalculateRoute' :: CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
$sel:truckModeOptions:CalculateRoute' :: CalculateRoute -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRoute' :: CalculateRoute -> Maybe TravelMode
$sel:includeLegGeometry:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:distanceUnit:CalculateRoute' :: CalculateRoute -> Maybe DistanceUnit
$sel:departureTime:CalculateRoute' :: CalculateRoute -> Maybe ISO8601
$sel:departNow:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:carModeOptions:CalculateRoute' :: CalculateRoute -> 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 Bool
includeLegGeometry
      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` Maybe [Sensitive (NonEmpty Double)]
waypointPositions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
calculatorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive (NonEmpty Double)
departurePosition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive (NonEmpty Double)
destinationPosition

instance Prelude.NFData CalculateRoute where
  rnf :: CalculateRoute -> ()
rnf CalculateRoute' {Maybe Bool
Maybe [Sensitive (NonEmpty Double)]
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
Text
Sensitive (NonEmpty Double)
destinationPosition :: Sensitive (NonEmpty Double)
departurePosition :: Sensitive (NonEmpty Double)
calculatorName :: Text
waypointPositions :: Maybe [Sensitive (NonEmpty Double)]
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
includeLegGeometry :: Maybe Bool
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:departurePosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:calculatorName:CalculateRoute' :: CalculateRoute -> Text
$sel:waypointPositions:CalculateRoute' :: CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
$sel:truckModeOptions:CalculateRoute' :: CalculateRoute -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRoute' :: CalculateRoute -> Maybe TravelMode
$sel:includeLegGeometry:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:distanceUnit:CalculateRoute' :: CalculateRoute -> Maybe DistanceUnit
$sel:departureTime:CalculateRoute' :: CalculateRoute -> Maybe ISO8601
$sel:departNow:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:carModeOptions:CalculateRoute' :: CalculateRoute -> 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 Bool
includeLegGeometry
      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 Maybe [Sensitive (NonEmpty Double)]
waypointPositions
      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 Sensitive (NonEmpty Double)
departurePosition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive (NonEmpty Double)
destinationPosition

instance Data.ToHeaders CalculateRoute where
  toHeaders :: CalculateRoute -> 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 CalculateRoute where
  toJSON :: CalculateRoute -> Value
toJSON CalculateRoute' {Maybe Bool
Maybe [Sensitive (NonEmpty Double)]
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
Text
Sensitive (NonEmpty Double)
destinationPosition :: Sensitive (NonEmpty Double)
departurePosition :: Sensitive (NonEmpty Double)
calculatorName :: Text
waypointPositions :: Maybe [Sensitive (NonEmpty Double)]
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
includeLegGeometry :: Maybe Bool
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:departurePosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:calculatorName:CalculateRoute' :: CalculateRoute -> Text
$sel:waypointPositions:CalculateRoute' :: CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
$sel:truckModeOptions:CalculateRoute' :: CalculateRoute -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRoute' :: CalculateRoute -> Maybe TravelMode
$sel:includeLegGeometry:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:distanceUnit:CalculateRoute' :: CalculateRoute -> Maybe DistanceUnit
$sel:departureTime:CalculateRoute' :: CalculateRoute -> Maybe ISO8601
$sel:departNow:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:carModeOptions:CalculateRoute' :: CalculateRoute -> 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
"IncludeLegGeometry" 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
includeLegGeometry,
            (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,
            (Key
"WaypointPositions" 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 [Sensitive (NonEmpty Double)]
waypointPositions,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DeparturePosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive (NonEmpty Double)
departurePosition),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationPosition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive (NonEmpty Double)
destinationPosition)
          ]
      )

instance Data.ToPath CalculateRoute where
  toPath :: CalculateRoute -> ByteString
toPath CalculateRoute' {Maybe Bool
Maybe [Sensitive (NonEmpty Double)]
Maybe ISO8601
Maybe CalculateRouteCarModeOptions
Maybe DistanceUnit
Maybe TravelMode
Maybe CalculateRouteTruckModeOptions
Text
Sensitive (NonEmpty Double)
destinationPosition :: Sensitive (NonEmpty Double)
departurePosition :: Sensitive (NonEmpty Double)
calculatorName :: Text
waypointPositions :: Maybe [Sensitive (NonEmpty Double)]
truckModeOptions :: Maybe CalculateRouteTruckModeOptions
travelMode :: Maybe TravelMode
includeLegGeometry :: Maybe Bool
distanceUnit :: Maybe DistanceUnit
departureTime :: Maybe ISO8601
departNow :: Maybe Bool
carModeOptions :: Maybe CalculateRouteCarModeOptions
$sel:destinationPosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:departurePosition:CalculateRoute' :: CalculateRoute -> Sensitive (NonEmpty Double)
$sel:calculatorName:CalculateRoute' :: CalculateRoute -> Text
$sel:waypointPositions:CalculateRoute' :: CalculateRoute -> Maybe [Sensitive (NonEmpty Double)]
$sel:truckModeOptions:CalculateRoute' :: CalculateRoute -> Maybe CalculateRouteTruckModeOptions
$sel:travelMode:CalculateRoute' :: CalculateRoute -> Maybe TravelMode
$sel:includeLegGeometry:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:distanceUnit:CalculateRoute' :: CalculateRoute -> Maybe DistanceUnit
$sel:departureTime:CalculateRoute' :: CalculateRoute -> Maybe ISO8601
$sel:departNow:CalculateRoute' :: CalculateRoute -> Maybe Bool
$sel:carModeOptions:CalculateRoute' :: CalculateRoute -> 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"
      ]

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

-- | Returns the result of the route calculation. Metadata includes legs and
-- route summary.
--
-- /See:/ 'newCalculateRouteResponse' smart constructor.
data CalculateRouteResponse = CalculateRouteResponse'
  { -- | The response's http status code.
    CalculateRouteResponse -> Int
httpStatus :: Prelude.Int,
    -- | Contains details about each path between a pair of positions included
    -- along a route such as: @StartPosition@, @EndPosition@, @Distance@,
    -- @DurationSeconds@, @Geometry@, and @Steps@. The number of legs returned
    -- corresponds to one fewer than the total number of positions in the
    -- request.
    --
    -- For example, a route with a departure position and destination position
    -- returns one leg with the positions
    -- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html snapped to a nearby road>:
    --
    -- -   The @StartPosition@ is the departure position.
    --
    -- -   The @EndPosition@ is the destination position.
    --
    -- A route with a waypoint between the departure and destination position
    -- returns two legs with the positions snapped to a nearby road:
    --
    -- -   Leg 1: The @StartPosition@ is the departure position . The
    --     @EndPosition@ is the waypoint positon.
    --
    -- -   Leg 2: The @StartPosition@ is the waypoint position. The
    --     @EndPosition@ is the destination position.
    CalculateRouteResponse -> [Leg]
legs :: [Leg],
    -- | Contains information about the whole route, such as: @RouteBBox@,
    -- @DataSource@, @Distance@, @DistanceUnit@, and @DurationSeconds@.
    CalculateRouteResponse -> CalculateRouteSummary
summary :: CalculateRouteSummary
  }
  deriving (CalculateRouteResponse -> CalculateRouteResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalculateRouteResponse -> CalculateRouteResponse -> Bool
$c/= :: CalculateRouteResponse -> CalculateRouteResponse -> Bool
== :: CalculateRouteResponse -> CalculateRouteResponse -> Bool
$c== :: CalculateRouteResponse -> CalculateRouteResponse -> Bool
Prelude.Eq, Int -> CalculateRouteResponse -> ShowS
[CalculateRouteResponse] -> ShowS
CalculateRouteResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalculateRouteResponse] -> ShowS
$cshowList :: [CalculateRouteResponse] -> ShowS
show :: CalculateRouteResponse -> String
$cshow :: CalculateRouteResponse -> String
showsPrec :: Int -> CalculateRouteResponse -> ShowS
$cshowsPrec :: Int -> CalculateRouteResponse -> ShowS
Prelude.Show, forall x. Rep CalculateRouteResponse x -> CalculateRouteResponse
forall x. CalculateRouteResponse -> Rep CalculateRouteResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalculateRouteResponse x -> CalculateRouteResponse
$cfrom :: forall x. CalculateRouteResponse -> Rep CalculateRouteResponse x
Prelude.Generic)

-- |
-- Create a value of 'CalculateRouteResponse' 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', 'calculateRouteResponse_httpStatus' - The response's http status code.
--
-- 'legs', 'calculateRouteResponse_legs' - Contains details about each path between a pair of positions included
-- along a route such as: @StartPosition@, @EndPosition@, @Distance@,
-- @DurationSeconds@, @Geometry@, and @Steps@. The number of legs returned
-- corresponds to one fewer than the total number of positions in the
-- request.
--
-- For example, a route with a departure position and destination position
-- returns one leg with the positions
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html snapped to a nearby road>:
--
-- -   The @StartPosition@ is the departure position.
--
-- -   The @EndPosition@ is the destination position.
--
-- A route with a waypoint between the departure and destination position
-- returns two legs with the positions snapped to a nearby road:
--
-- -   Leg 1: The @StartPosition@ is the departure position . The
--     @EndPosition@ is the waypoint positon.
--
-- -   Leg 2: The @StartPosition@ is the waypoint position. The
--     @EndPosition@ is the destination position.
--
-- 'summary', 'calculateRouteResponse_summary' - Contains information about the whole route, such as: @RouteBBox@,
-- @DataSource@, @Distance@, @DistanceUnit@, and @DurationSeconds@.
newCalculateRouteResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'summary'
  CalculateRouteSummary ->
  CalculateRouteResponse
newCalculateRouteResponse :: Int -> CalculateRouteSummary -> CalculateRouteResponse
newCalculateRouteResponse Int
pHttpStatus_ CalculateRouteSummary
pSummary_ =
  CalculateRouteResponse'
    { $sel:httpStatus:CalculateRouteResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:legs:CalculateRouteResponse' :: [Leg]
legs = forall a. Monoid a => a
Prelude.mempty,
      $sel:summary:CalculateRouteResponse' :: CalculateRouteSummary
summary = CalculateRouteSummary
pSummary_
    }

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

-- | Contains details about each path between a pair of positions included
-- along a route such as: @StartPosition@, @EndPosition@, @Distance@,
-- @DurationSeconds@, @Geometry@, and @Steps@. The number of legs returned
-- corresponds to one fewer than the total number of positions in the
-- request.
--
-- For example, a route with a departure position and destination position
-- returns one leg with the positions
-- <https://docs.aws.amazon.com/location/latest/developerguide/snap-to-nearby-road.html snapped to a nearby road>:
--
-- -   The @StartPosition@ is the departure position.
--
-- -   The @EndPosition@ is the destination position.
--
-- A route with a waypoint between the departure and destination position
-- returns two legs with the positions snapped to a nearby road:
--
-- -   Leg 1: The @StartPosition@ is the departure position . The
--     @EndPosition@ is the waypoint positon.
--
-- -   Leg 2: The @StartPosition@ is the waypoint position. The
--     @EndPosition@ is the destination position.
calculateRouteResponse_legs :: Lens.Lens' CalculateRouteResponse [Leg]
calculateRouteResponse_legs :: Lens' CalculateRouteResponse [Leg]
calculateRouteResponse_legs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteResponse' {[Leg]
legs :: [Leg]
$sel:legs:CalculateRouteResponse' :: CalculateRouteResponse -> [Leg]
legs} -> [Leg]
legs) (\s :: CalculateRouteResponse
s@CalculateRouteResponse' {} [Leg]
a -> CalculateRouteResponse
s {$sel:legs:CalculateRouteResponse' :: [Leg]
legs = [Leg]
a} :: CalculateRouteResponse) 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 whole route, such as: @RouteBBox@,
-- @DataSource@, @Distance@, @DistanceUnit@, and @DurationSeconds@.
calculateRouteResponse_summary :: Lens.Lens' CalculateRouteResponse CalculateRouteSummary
calculateRouteResponse_summary :: Lens' CalculateRouteResponse CalculateRouteSummary
calculateRouteResponse_summary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CalculateRouteResponse' {CalculateRouteSummary
summary :: CalculateRouteSummary
$sel:summary:CalculateRouteResponse' :: CalculateRouteResponse -> CalculateRouteSummary
summary} -> CalculateRouteSummary
summary) (\s :: CalculateRouteResponse
s@CalculateRouteResponse' {} CalculateRouteSummary
a -> CalculateRouteResponse
s {$sel:summary:CalculateRouteResponse' :: CalculateRouteSummary
summary = CalculateRouteSummary
a} :: CalculateRouteResponse)

instance Prelude.NFData CalculateRouteResponse where
  rnf :: CalculateRouteResponse -> ()
rnf CalculateRouteResponse' {Int
[Leg]
CalculateRouteSummary
summary :: CalculateRouteSummary
legs :: [Leg]
httpStatus :: Int
$sel:summary:CalculateRouteResponse' :: CalculateRouteResponse -> CalculateRouteSummary
$sel:legs:CalculateRouteResponse' :: CalculateRouteResponse -> [Leg]
$sel:httpStatus:CalculateRouteResponse' :: CalculateRouteResponse -> Int
..} =
    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 [Leg]
legs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CalculateRouteSummary
summary