-- | 'Strive.Actions.Athletes'
module Strive.Options.Athletes
  ( UpdateCurrentAthleteOptions (..),
    GetAthleteCrsOptions,
  )
where

import Data.Default (Default, def)
import Network.HTTP.Types (QueryLike, toQuery)
import Strive.Enums (Gender)
import Strive.Internal.Options (PaginationOptions)

-- | 'Strive.Actions.updateCurrentAthlete'
data UpdateCurrentAthleteOptions = UpdateCurrentAthleteOptions
  { UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_city :: Maybe String,
    UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_state :: Maybe String,
    UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_country :: Maybe String,
    UpdateCurrentAthleteOptions -> Maybe Gender
updateCurrentAthleteOptions_sex :: Maybe Gender,
    UpdateCurrentAthleteOptions -> Maybe Double
updateCurrentAthleteOptions_weight :: Maybe Double
  }
  deriving (Int -> UpdateCurrentAthleteOptions -> ShowS
[UpdateCurrentAthleteOptions] -> ShowS
UpdateCurrentAthleteOptions -> String
(Int -> UpdateCurrentAthleteOptions -> ShowS)
-> (UpdateCurrentAthleteOptions -> String)
-> ([UpdateCurrentAthleteOptions] -> ShowS)
-> Show UpdateCurrentAthleteOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateCurrentAthleteOptions -> ShowS
showsPrec :: Int -> UpdateCurrentAthleteOptions -> ShowS
$cshow :: UpdateCurrentAthleteOptions -> String
show :: UpdateCurrentAthleteOptions -> String
$cshowList :: [UpdateCurrentAthleteOptions] -> ShowS
showList :: [UpdateCurrentAthleteOptions] -> ShowS
Show)

instance Default UpdateCurrentAthleteOptions where
  def :: UpdateCurrentAthleteOptions
def =
    UpdateCurrentAthleteOptions
      { updateCurrentAthleteOptions_city :: Maybe String
updateCurrentAthleteOptions_city = Maybe String
forall a. Maybe a
Nothing,
        updateCurrentAthleteOptions_state :: Maybe String
updateCurrentAthleteOptions_state = Maybe String
forall a. Maybe a
Nothing,
        updateCurrentAthleteOptions_country :: Maybe String
updateCurrentAthleteOptions_country = Maybe String
forall a. Maybe a
Nothing,
        updateCurrentAthleteOptions_sex :: Maybe Gender
updateCurrentAthleteOptions_sex = Maybe Gender
forall a. Maybe a
Nothing,
        updateCurrentAthleteOptions_weight :: Maybe Double
updateCurrentAthleteOptions_weight = Maybe Double
forall a. Maybe a
Nothing
      }

instance QueryLike UpdateCurrentAthleteOptions where
  toQuery :: UpdateCurrentAthleteOptions -> Query
toQuery UpdateCurrentAthleteOptions
options =
    [(String, Maybe String)] -> Query
forall a. QueryLike a => a -> Query
toQuery
      [ (String
"city", UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_city UpdateCurrentAthleteOptions
options),
        (String
"state", UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_state UpdateCurrentAthleteOptions
options),
        (String
"country", UpdateCurrentAthleteOptions -> Maybe String
updateCurrentAthleteOptions_country UpdateCurrentAthleteOptions
options),
        (String
"sex", (Gender -> String) -> Maybe Gender -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gender -> String
forall a. Show a => a -> String
show (UpdateCurrentAthleteOptions -> Maybe Gender
updateCurrentAthleteOptions_sex UpdateCurrentAthleteOptions
options)),
        (String
"weight", (Double -> String) -> Maybe Double -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> String
forall a. Show a => a -> String
show (UpdateCurrentAthleteOptions -> Maybe Double
updateCurrentAthleteOptions_weight UpdateCurrentAthleteOptions
options))
      ]

-- | 'Strive.Actions.getAthleteCrs'
type GetAthleteCrsOptions = PaginationOptions