{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

-- | <http://strava.github.io/api/v3/activities/>
module Strive.Types.Activities
  ( ActivityDetailed (..)
  , ActivitySummary (..)
  , ActivityZoneDetailed (..)
  , ActivityZoneDistributionBucket (..)
  , ActivityLapSummary (..)
  ) where

import Control.Applicative (empty)
import Data.Aeson (FromJSON, Value (Object), parseJSON, (.:))
import Data.Aeson.TH (deriveFromJSON)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Strive.Enums (ActivityType, ActivityZoneType, ResourceState)
import Strive.Internal.TH (options)
import Strive.Types.Athletes (AthleteMeta)
import Strive.Types.Efforts (EffortDetailed)
import Strive.Types.Gear (GearSummary)
import Strive.Types.Polylines (PolylineDetailed, PolylineSummary)

-- | <http://strava.github.io/api/v3/activities/#detailed>
data ActivityDetailed = ActivityDetailed
  { ActivityDetailed -> Integer
activityDetailed_achievementCount      :: Integer
  , ActivityDetailed -> AthleteMeta
activityDetailed_athlete               :: AthleteMeta
  , ActivityDetailed -> Integer
activityDetailed_athleteCount          :: Integer
  , ActivityDetailed -> Double
activityDetailed_averageSpeed          :: Double
  , ActivityDetailed -> Maybe Double
activityDetailed_averageWatts          :: Maybe Double
  , ActivityDetailed -> Maybe Double
activityDetailed_averageHeartrate      :: Maybe Double
  , ActivityDetailed -> Double
activityDetailed_calories              :: Double
  , ActivityDetailed -> Integer
activityDetailed_commentCount          :: Integer
  , ActivityDetailed -> Bool
activityDetailed_commute               :: Bool
  , ActivityDetailed -> Maybe Text
activityDetailed_description           :: Maybe Text
  , ActivityDetailed -> Maybe Bool
activityDetailed_deviceWatts           :: Maybe Bool
  , ActivityDetailed -> Double
activityDetailed_distance              :: Double
  , ActivityDetailed -> Integer
activityDetailed_elapsedTime           :: Integer
  , ActivityDetailed -> Maybe (Double, Double)
activityDetailed_endLatlng             :: Maybe (Double, Double)
  , ActivityDetailed -> Maybe Text
activityDetailed_externalId            :: Maybe Text
  , ActivityDetailed -> Bool
activityDetailed_flagged               :: Bool
  , ActivityDetailed -> GearSummary
activityDetailed_gear                  :: GearSummary
  , ActivityDetailed -> Maybe Text
activityDetailed_gearId                :: Maybe Text
  , ActivityDetailed -> Bool
activityDetailed_hasKudoed             :: Bool
  , ActivityDetailed -> Integer
activityDetailed_id                    :: Integer
  , ActivityDetailed -> Maybe Text
activityDetailed_instagramPrimaryPhoto :: Maybe Text
  , ActivityDetailed -> Maybe Double
activityDetailed_kilojoules            :: Maybe Double
  , ActivityDetailed -> Maybe Text
activityDetailed_locationCity          :: Maybe Text
  , ActivityDetailed -> Maybe Text
activityDetailed_locationCountry       :: Maybe Text
  , ActivityDetailed -> Maybe Text
activityDetailed_locationState         :: Maybe Text
  , ActivityDetailed -> Bool
activityDetailed_manual                :: Bool
  , ActivityDetailed -> PolylineDetailed
activityDetailed_map                   :: PolylineDetailed
  , ActivityDetailed -> Maybe Double
activityDetailed_maxHeartrate          :: Maybe Double
  , ActivityDetailed -> Double
activityDetailed_maxSpeed              :: Double
  , ActivityDetailed -> Integer
activityDetailed_movingTime            :: Integer
  , ActivityDetailed -> Text
activityDetailed_name                  :: Text
  , ActivityDetailed -> Integer
activityDetailed_photoCount            :: Integer
  , ActivityDetailed -> Bool
activityDetailed_private               :: Bool
  , ActivityDetailed -> ResourceState
activityDetailed_resourceState         :: ResourceState
  , ActivityDetailed -> [EffortDetailed]
activityDetailed_segmentEfforts        :: [EffortDetailed]
  , ActivityDetailed -> UTCTime
activityDetailed_startDate             :: UTCTime
  , ActivityDetailed -> UTCTime
activityDetailed_startDateLocal        :: UTCTime
  , ActivityDetailed -> Double
activityDetailed_startLatitude         :: Double
  , ActivityDetailed -> Maybe (Double, Double)
activityDetailed_startLatlng           :: Maybe (Double, Double)
  , ActivityDetailed -> Double
activityDetailed_startLongitude        :: Double
  , ActivityDetailed -> Text
activityDetailed_timezone              :: Text
  , ActivityDetailed -> Double
activityDetailed_totalElevationGain    :: Double
  , ActivityDetailed -> Bool
activityDetailed_trainer               :: Bool
  , ActivityDetailed -> Integer
activityDetailed_truncated             :: Integer
  , ActivityDetailed -> ActivityType
activityDetailed_type                  :: ActivityType
  , ActivityDetailed -> Maybe Integer
activityDetailed_uploadId              :: Maybe Integer
  , ActivityDetailed -> Maybe Integer
activityDetailed_weightedAverageWatts  :: Maybe Integer
  } deriving Int -> ActivityDetailed -> ShowS
[ActivityDetailed] -> ShowS
ActivityDetailed -> String
(Int -> ActivityDetailed -> ShowS)
-> (ActivityDetailed -> String)
-> ([ActivityDetailed] -> ShowS)
-> Show ActivityDetailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityDetailed] -> ShowS
$cshowList :: [ActivityDetailed] -> ShowS
show :: ActivityDetailed -> String
$cshow :: ActivityDetailed -> String
showsPrec :: Int -> ActivityDetailed -> ShowS
$cshowsPrec :: Int -> ActivityDetailed -> ShowS
Show

$(deriveFromJSON options ''ActivityDetailed)

-- | <http://strava.github.io/api/v3/activities/#summary>
data ActivitySummary = ActivitySummary
  { ActivitySummary -> Integer
activitySummary_achievementCount     :: Integer
  , ActivitySummary -> AthleteMeta
activitySummary_athlete              :: AthleteMeta
  , ActivitySummary -> Integer
activitySummary_athleteCount         :: Integer
  , ActivitySummary -> Double
activitySummary_averageSpeed         :: Double
  , ActivitySummary -> Maybe Double
activitySummary_averageWatts         :: Maybe Double
  , ActivitySummary -> Maybe Double
activitySummary_averageHeartrate     :: Maybe Double
  , ActivitySummary -> Integer
activitySummary_commentCount         :: Integer
  , ActivitySummary -> Bool
activitySummary_commute              :: Bool
  , ActivitySummary -> Maybe Bool
activitySummary_deviceWatts          :: Maybe Bool
  , ActivitySummary -> Double
activitySummary_distance             :: Double
  , ActivitySummary -> Integer
activitySummary_elapsedTime          :: Integer
  , ActivitySummary -> Maybe (Double, Double)
activitySummary_endLatlng            :: Maybe (Double, Double)
  , ActivitySummary -> Maybe Text
activitySummary_externalId           :: Maybe Text
  , ActivitySummary -> Bool
activitySummary_flagged              :: Bool
  , ActivitySummary -> Maybe Text
activitySummary_gearId               :: Maybe Text
  , ActivitySummary -> Bool
activitySummary_hasKudoed            :: Bool
  , ActivitySummary -> Integer
activitySummary_id                   :: Integer
  , ActivitySummary -> Maybe Double
activitySummary_kilojoules           :: Maybe Double
  , ActivitySummary -> Integer
activitySummary_kudosCount           :: Integer
  , ActivitySummary -> Maybe Text
activitySummary_locationCity         :: Maybe Text
  , ActivitySummary -> Maybe Text
activitySummary_locationCountry      :: Maybe Text
  , ActivitySummary -> Maybe Text
activitySummary_locationState        :: Maybe Text
  , ActivitySummary -> Bool
activitySummary_manual               :: Bool
  , ActivitySummary -> PolylineSummary
activitySummary_map                  :: PolylineSummary
  , ActivitySummary -> Maybe Double
activitySummary_maxHeartrate         :: Maybe Double
  , ActivitySummary -> Double
activitySummary_maxSpeed             :: Double
  , ActivitySummary -> Integer
activitySummary_movingTime           :: Integer
  , ActivitySummary -> Text
activitySummary_name                 :: Text
  , ActivitySummary -> Integer
activitySummary_photoCount           :: Integer
  , ActivitySummary -> Bool
activitySummary_private              :: Bool
  , ActivitySummary -> ResourceState
activitySummary_resourceState        :: ResourceState
  , ActivitySummary -> UTCTime
activitySummary_startDate            :: UTCTime
  , ActivitySummary -> UTCTime
activitySummary_startDateLocal       :: UTCTime
  , ActivitySummary -> Double
activitySummary_startLatitude        :: Double
  , ActivitySummary -> Maybe (Double, Double)
activitySummary_startLatlng          :: Maybe (Double, Double)
  , ActivitySummary -> Double
activitySummary_startLongitude       :: Double
  , ActivitySummary -> Text
activitySummary_timezone             :: Text
  , ActivitySummary -> Double
activitySummary_totalElevationGain   :: Double
  , ActivitySummary -> Bool
activitySummary_trainer              :: Bool
  , ActivitySummary -> ActivityType
activitySummary_type                 :: ActivityType
  , ActivitySummary -> Maybe Integer
activitySummary_uploadId             :: Maybe Integer
  , ActivitySummary -> Maybe Integer
activitySummary_weightedAverageWatts :: Maybe Integer
  } deriving Int -> ActivitySummary -> ShowS
[ActivitySummary] -> ShowS
ActivitySummary -> String
(Int -> ActivitySummary -> ShowS)
-> (ActivitySummary -> String)
-> ([ActivitySummary] -> ShowS)
-> Show ActivitySummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivitySummary] -> ShowS
$cshowList :: [ActivitySummary] -> ShowS
show :: ActivitySummary -> String
$cshow :: ActivitySummary -> String
showsPrec :: Int -> ActivitySummary -> ShowS
$cshowsPrec :: Int -> ActivitySummary -> ShowS
Show

$(deriveFromJSON options ''ActivitySummary)

-- | <http://strava.github.io/api/v3/activities/#zones>
data ActivityZoneDistributionBucket = ActivityZoneDistributionBucket
  { ActivityZoneDistributionBucket -> Integer
activityZoneDistributionBucket_max  :: Integer
  , ActivityZoneDistributionBucket -> Integer
activityZoneDistributionBucket_min  :: Integer
  , ActivityZoneDistributionBucket -> Integer
activityZoneDistributionBucket_time :: Integer
  } deriving Int -> ActivityZoneDistributionBucket -> ShowS
[ActivityZoneDistributionBucket] -> ShowS
ActivityZoneDistributionBucket -> String
(Int -> ActivityZoneDistributionBucket -> ShowS)
-> (ActivityZoneDistributionBucket -> String)
-> ([ActivityZoneDistributionBucket] -> ShowS)
-> Show ActivityZoneDistributionBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityZoneDistributionBucket] -> ShowS
$cshowList :: [ActivityZoneDistributionBucket] -> ShowS
show :: ActivityZoneDistributionBucket -> String
$cshow :: ActivityZoneDistributionBucket -> String
showsPrec :: Int -> ActivityZoneDistributionBucket -> ShowS
$cshowsPrec :: Int -> ActivityZoneDistributionBucket -> ShowS
Show

$(deriveFromJSON options ''ActivityZoneDistributionBucket)

-- | <http://strava.github.io/api/v3/activities/#zones>
data ActivityZoneDetailed = ActivityZoneDetailed
  { ActivityZoneDetailed -> [ActivityZoneDistributionBucket]
activityZoneDetailed_distributionBuckets :: [ActivityZoneDistributionBucket]
  , ActivityZoneDetailed -> ResourceState
activityZoneDetailed_resourceState       :: ResourceState
  , ActivityZoneDetailed -> Bool
activityZoneDetailed_sensorBased         :: Bool
  , ActivityZoneDetailed -> ActivityZoneType
activityZoneDetailed_type                :: ActivityZoneType
  } deriving Int -> ActivityZoneDetailed -> ShowS
[ActivityZoneDetailed] -> ShowS
ActivityZoneDetailed -> String
(Int -> ActivityZoneDetailed -> ShowS)
-> (ActivityZoneDetailed -> String)
-> ([ActivityZoneDetailed] -> ShowS)
-> Show ActivityZoneDetailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityZoneDetailed] -> ShowS
$cshowList :: [ActivityZoneDetailed] -> ShowS
show :: ActivityZoneDetailed -> String
$cshow :: ActivityZoneDetailed -> String
showsPrec :: Int -> ActivityZoneDetailed -> ShowS
$cshowsPrec :: Int -> ActivityZoneDetailed -> ShowS
Show

$(deriveFromJSON options ''ActivityZoneDetailed)

-- | <http://strava.github.io/api/v3/activities/#laps>
data ActivityLapSummary = ActivityLapSummary
    { ActivityLapSummary -> Integer
activityLapSummary_activityId         :: Integer
    , ActivityLapSummary -> Integer
activityLapSummary_athleteId          :: Integer
    , ActivityLapSummary -> Double
activityLapSummary_averageSpeed       :: Double
    , ActivityLapSummary -> Double
activityLapSummary_averageWatts       :: Double
    , ActivityLapSummary -> Double
activityLapSummary_distance           :: Double
    , ActivityLapSummary -> Integer
activityLapSummary_elapsedTime        :: Integer
    , ActivityLapSummary -> Integer
activityLapSummary_endIndex           :: Integer
    , ActivityLapSummary -> Integer
activityLapSummary_id                 :: Integer
    , ActivityLapSummary -> Integer
activityLapSummary_lapIndex           :: Integer
    , ActivityLapSummary -> Double
activityLapSummary_maxSpeed           :: Double
    , ActivityLapSummary -> Double
activityLapSummary_movingTime         :: Double
    , ActivityLapSummary -> Text
activityLapSummary_name               :: Text
    , ActivityLapSummary -> ResourceState
activityLapSummary_resourceState      :: ResourceState
    , ActivityLapSummary -> UTCTime
activityLapSummary_startDate          :: UTCTime
    , ActivityLapSummary -> UTCTime
activityLapSummary_startDateLocal     :: UTCTime
    , ActivityLapSummary -> Integer
activityLapSummary_startIndex         :: Integer
    , ActivityLapSummary -> Double
activityLapSummary_totalElevationGain :: Double
    } deriving Int -> ActivityLapSummary -> ShowS
[ActivityLapSummary] -> ShowS
ActivityLapSummary -> String
(Int -> ActivityLapSummary -> ShowS)
-> (ActivityLapSummary -> String)
-> ([ActivityLapSummary] -> ShowS)
-> Show ActivityLapSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityLapSummary] -> ShowS
$cshowList :: [ActivityLapSummary] -> ShowS
show :: ActivityLapSummary -> String
$cshow :: ActivityLapSummary -> String
showsPrec :: Int -> ActivityLapSummary -> ShowS
$cshowsPrec :: Int -> ActivityLapSummary -> ShowS
Show

instance FromJSON ActivityLapSummary where
    parseJSON :: Value -> Parser ActivityLapSummary
parseJSON (Object Object
o) = Integer
-> Integer
-> Double
-> Double
-> Double
-> Integer
-> Integer
-> Integer
-> Integer
-> Double
-> Double
-> Text
-> ResourceState
-> UTCTime
-> UTCTime
-> Integer
-> Double
-> ActivityLapSummary
ActivityLapSummary
        (Integer
 -> Integer
 -> Double
 -> Double
 -> Double
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Double
 -> Double
 -> Text
 -> ResourceState
 -> UTCTime
 -> UTCTime
 -> Integer
 -> Double
 -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Integer
      -> Double
      -> Double
      -> Double
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"activity") Parser Object -> (Object -> Parser Integer) -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"))
        Parser
  (Integer
   -> Double
   -> Double
   -> Double
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Double
      -> Double
      -> Double
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"athlete") Parser Object -> (Object -> Parser Integer) -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"))
        Parser
  (Double
   -> Double
   -> Double
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Double
-> Parser
     (Double
      -> Double
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"average_speed"
        Parser
  (Double
   -> Double
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Double
-> Parser
     (Double
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"average_watts"
        Parser
  (Double
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Double
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"distance"
        Parser
  (Integer
   -> Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"elapsed_time"
        Parser
  (Integer
   -> Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Integer
      -> Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end_index"
        Parser
  (Integer
   -> Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Integer
      -> Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser
  (Integer
   -> Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Integer
-> Parser
     (Double
      -> Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"lap_index"
        Parser
  (Double
   -> Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Double
-> Parser
     (Double
      -> Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"max_speed"
        Parser
  (Double
   -> Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Double
-> Parser
     (Text
      -> ResourceState
      -> UTCTime
      -> UTCTime
      -> Integer
      -> Double
      -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"moving_time"
        Parser
  (Text
   -> ResourceState
   -> UTCTime
   -> UTCTime
   -> Integer
   -> Double
   -> ActivityLapSummary)
-> Parser Text
-> Parser
     (ResourceState
      -> UTCTime -> UTCTime -> Integer -> Double -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
        Parser
  (ResourceState
   -> UTCTime -> UTCTime -> Integer -> Double -> ActivityLapSummary)
-> Parser ResourceState
-> Parser
     (UTCTime -> UTCTime -> Integer -> Double -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser ResourceState
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"resource_state"
        Parser
  (UTCTime -> UTCTime -> Integer -> Double -> ActivityLapSummary)
-> Parser UTCTime
-> Parser (UTCTime -> Integer -> Double -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"start_date"
        Parser (UTCTime -> Integer -> Double -> ActivityLapSummary)
-> Parser UTCTime
-> Parser (Integer -> Double -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"start_date_local"
        Parser (Integer -> Double -> ActivityLapSummary)
-> Parser Integer -> Parser (Double -> ActivityLapSummary)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"start_index"
        Parser (Double -> ActivityLapSummary)
-> Parser Double -> Parser ActivityLapSummary
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total_elevation_gain"
    parseJSON Value
_ = Parser ActivityLapSummary
forall (f :: * -> *) a. Alternative f => f a
empty