-- | <http://strava.github.io/api/v3/streams/>
module Strive.Actions.Streams
  ( getActivityStreams
  , getEffortStreams
  , getSegmentStreams
  ) where

import Data.Aeson (FromJSON)
import Data.List (intercalate)
import Network.HTTP.Types (toQuery)
import Strive.Aliases (Result, StreamId)
import Strive.Client (Client)
import Strive.Enums (StreamType)
import Strive.Internal.HTTP (get)
import Strive.Options (GetStreamsOptions)
import Strive.Types (StreamDetailed)

-- | <http://strava.github.io/api/v3/streams/#activity>
getActivityStreams :: Client -> StreamId -> [StreamType] -> GetStreamsOptions -> IO (Result [StreamDetailed])
getActivityStreams :: Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
getActivityStreams = (Client
 -> String
 -> StreamId
 -> [StreamType]
 -> GetStreamsOptions
 -> IO (Result [StreamDetailed]))
-> String
-> Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a.
FromJSON a =>
Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result a)
getStreams String
"activities"

-- | <http://strava.github.io/api/v3/streams/#effort>
getEffortStreams :: Client -> StreamId -> [StreamType] -> GetStreamsOptions -> IO (Result [StreamDetailed])
getEffortStreams :: Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
getEffortStreams = (Client
 -> String
 -> StreamId
 -> [StreamType]
 -> GetStreamsOptions
 -> IO (Result [StreamDetailed]))
-> String
-> Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a.
FromJSON a =>
Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result a)
getStreams String
"segment_efforts"

-- | <http://strava.github.io/api/v3/streams/#segment>
getSegmentStreams :: Client -> StreamId -> [StreamType] -> GetStreamsOptions -> IO (Result [StreamDetailed])
getSegmentStreams :: Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
getSegmentStreams = (Client
 -> String
 -> StreamId
 -> [StreamType]
 -> GetStreamsOptions
 -> IO (Result [StreamDetailed]))
-> String
-> Client
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result [StreamDetailed])
forall a.
FromJSON a =>
Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result a)
getStreams String
"segments"

getStreams :: FromJSON a => Client -> String -> StreamId -> [StreamType] -> GetStreamsOptions -> IO (Result a)
getStreams :: Client
-> String
-> StreamId
-> [StreamType]
-> GetStreamsOptions
-> IO (Result a)
getStreams Client
client String
kind StreamId
id_ [StreamType]
types GetStreamsOptions
options = Client -> String -> Query -> IO (Result a)
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] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"api/v3/"
        , String
kind
        , String
"/"
        , StreamId -> String
forall a. Show a => a -> String
show StreamId
id_
        , String
"/streams/"
        , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((StreamType -> String) -> [StreamType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map StreamType -> String
forall a. Show a => a -> String
show [StreamType]
types)
        ]
    query :: Query
query = GetStreamsOptions -> Query
forall a. QueryLike a => a -> Query
toQuery GetStreamsOptions
options