-- | <http://strava.github.io/api/v3/athlete/>
module Strive.Actions.Athletes
  ( getCurrentAthlete
  , getAthlete
  , updateCurrentAthlete
  , getAthleteStats
  , getAthleteCrs
  ) where

import Network.HTTP.Types (Query, toQuery)
import Strive.Aliases (AthleteId, Result)
import Strive.Client (Client)
import Strive.Internal.HTTP (get, put)
import Strive.Options (GetAthleteCrsOptions, UpdateCurrentAthleteOptions)
import Strive.Types (AthleteDetailed, AthleteStats, AthleteSummary,
                     EffortDetailed)

-- | <http://strava.github.io/api/v3/athlete/#get-details>
getCurrentAthlete :: Client -> IO (Result AthleteDetailed)
getCurrentAthlete :: Client -> IO (Result AthleteDetailed)
getCurrentAthlete Client
client = Client -> String -> Query -> IO (Result AthleteDetailed)
forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
 where
  resource :: String
resource = String
"api/v3/athlete"
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/athlete/#get-another-details>
getAthlete :: Client -> AthleteId -> IO (Result AthleteSummary)
getAthlete :: Client -> AthleteId -> IO (Result AthleteSummary)
getAthlete Client
client AthleteId
athleteId = Client -> String -> Query -> IO (Result AthleteSummary)
forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
 where
  resource :: String
resource = String
"api/v3/athletes/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AthleteId -> String
forall a. Show a => a -> String
show AthleteId
athleteId
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/athlete/#update>
updateCurrentAthlete :: Client -> UpdateCurrentAthleteOptions -> IO (Result AthleteDetailed)
updateCurrentAthlete :: Client
-> UpdateCurrentAthleteOptions -> IO (Result AthleteDetailed)
updateCurrentAthlete Client
client UpdateCurrentAthleteOptions
options = Client -> String -> Query -> IO (Result AthleteDetailed)
forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
put Client
client String
resource Query
query
 where
  resource :: String
resource = String
"api/v3/athlete"
  query :: Query
query = UpdateCurrentAthleteOptions -> Query
forall a. QueryLike a => a -> Query
toQuery UpdateCurrentAthleteOptions
options

-- | <http://strava.github.io/api/v3/athlete/#stats>
getAthleteStats :: Client -> Integer -> IO (Result AthleteStats)
getAthleteStats :: Client -> AthleteId -> IO (Result AthleteStats)
getAthleteStats Client
client AthleteId
athleteId = Client -> String -> Query -> IO (Result AthleteStats)
forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
 where
  resource :: String
resource = String
"api/v3/athletes/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AthleteId -> String
forall a. Show a => a -> String
show AthleteId
athleteId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/stats"
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/athlete/#koms>
getAthleteCrs :: Client -> AthleteId -> GetAthleteCrsOptions -> IO (Result [EffortDetailed])
getAthleteCrs :: Client
-> AthleteId
-> GetAthleteCrsOptions
-> IO (Result [EffortDetailed])
getAthleteCrs Client
client AthleteId
athleteId GetAthleteCrsOptions
options = Client -> String -> Query -> IO (Result [EffortDetailed])
forall q j.
(QueryLike q, FromJSON j) =>
Client -> String -> q -> IO (Result j)
get Client
client String
resource Query
query
 where
  resource :: String
resource = String
"api/v3/athletes/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AthleteId -> String
forall a. Show a => a -> String
show AthleteId
athleteId String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/koms"
  query :: Query
query = GetAthleteCrsOptions -> Query
forall a. QueryLike a => a -> Query
toQuery GetAthleteCrsOptions
options