-- | <http://strava.github.io/api/v3/clubs/>
module Strive.Actions.Clubs
  ( getClub
  , getCurrentClubs
  , getClubMembers
  , getClubActivities
  , joinClub
  , leaveClub
  ) where

import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (toStrict)
import Network.HTTP.Client (responseBody, responseStatus)
import Network.HTTP.Types (Query, methodPost, ok200, toQuery)
import Strive.Aliases (ClubId, Result)
import Strive.Client (Client)
import Strive.Internal.HTTP (buildRequest, get, performRequest)
import Strive.Options (GetClubActivitiesOptions, GetClubMembersOptions)
import Strive.Types
  (ActivitySummary, AthleteSummary, ClubDetailed, ClubSummary)

-- | <http://strava.github.io/api/v3/clubs/#get-details>
getClub :: Client -> ClubId -> IO (Result ClubDetailed)
getClub :: Client -> ClubId -> IO (Result ClubDetailed)
getClub Client
client ClubId
clubId = Client -> String -> Query -> IO (Result ClubDetailed)
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/clubs/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClubId -> String
forall a. Show a => a -> String
show ClubId
clubId
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#get-athletes>
getCurrentClubs :: Client -> IO (Result [ClubSummary])
getCurrentClubs :: Client -> IO (Result [ClubSummary])
getCurrentClubs Client
client = Client -> String -> Query -> IO (Result [ClubSummary])
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/clubs"
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#get-members>
getClubMembers
  :: Client -> ClubId -> GetClubMembersOptions -> IO (Result [AthleteSummary])
getClubMembers :: Client
-> ClubId -> GetClubMembersOptions -> IO (Result [AthleteSummary])
getClubMembers Client
client ClubId
clubId GetClubMembersOptions
options = 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/clubs/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClubId -> String
forall a. Show a => a -> String
show ClubId
clubId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/members"
  query :: Query
query = GetClubMembersOptions -> Query
forall a. QueryLike a => a -> Query
toQuery GetClubMembersOptions
options

-- | <http://strava.github.io/api/v3/clubs/#get-activities>
getClubActivities
  :: Client
  -> ClubId
  -> GetClubActivitiesOptions
  -> IO (Result [ActivitySummary])
getClubActivities :: Client
-> ClubId
-> GetClubActivitiesOptions
-> IO (Result [ActivitySummary])
getClubActivities Client
client ClubId
clubId GetClubActivitiesOptions
options = Client -> String -> Query -> IO (Result [ActivitySummary])
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/clubs/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClubId -> String
forall a. Show a => a -> String
show ClubId
clubId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/activities"
  query :: Query
query = GetClubActivitiesOptions -> Query
forall a. QueryLike a => a -> Query
toQuery GetClubActivitiesOptions
options

-- | <http://strava.github.io/api/v3/clubs/#join>
joinClub :: Client -> ClubId -> IO (Result ())
joinClub :: Client -> ClubId -> IO (Result ())
joinClub Client
client ClubId
clubId = do
  Request
request <- Method -> Client -> String -> Query -> IO Request
forall q.
QueryLike q =>
Method -> Client -> String -> q -> IO Request
buildRequest Method
methodPost Client
client String
resource Query
query
  Response ByteString
response <- Client -> Request -> IO (Response ByteString)
performRequest Client
client Request
request
  Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
return
    (if Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
ok200
      then () -> Result ()
forall a b. b -> Either a b
Right ()
      else (Response ByteString, String) -> Result ()
forall a b. a -> Either a b
Left (Response ByteString
response, (Method -> String
unpack (Method -> String)
-> (Response ByteString -> Method) -> Response ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
toStrict (ByteString -> Method)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody) Response ByteString
response)
    )
 where
  resource :: String
resource = String
"api/v3/clubs/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClubId -> String
forall a. Show a => a -> String
show ClubId
clubId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/join"
  query :: Query
query = [] :: Query

-- | <http://strava.github.io/api/v3/clubs/#leave>
leaveClub :: Client -> ClubId -> IO (Result ())
leaveClub :: Client -> ClubId -> IO (Result ())
leaveClub Client
client ClubId
clubId = do
  Request
request <- Method -> Client -> String -> Query -> IO Request
forall q.
QueryLike q =>
Method -> Client -> String -> q -> IO Request
buildRequest Method
methodPost Client
client String
resource Query
query
  Response ByteString
response <- Client -> Request -> IO (Response ByteString)
performRequest Client
client Request
request
  Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
return
    (if Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
ok200
      then () -> Result ()
forall a b. b -> Either a b
Right ()
      else (Response ByteString, String) -> Result ()
forall a b. a -> Either a b
Left (Response ByteString
response, (Method -> String
unpack (Method -> String)
-> (Response ByteString -> Method) -> Response ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
toStrict (ByteString -> Method)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody) Response ByteString
response)
    )
 where
  resource :: String
resource = String
"api/v3/clubs/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClubId -> String
forall a. Show a => a -> String
show ClubId
clubId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/leave"
  query :: Query
query = [] :: Query