{-# LANGUAGE OverloadedStrings #-}

-- | Types for choosing an option from a limited set.
module Strive.Enums
  ( ActivityType(..)
  , ActivityZoneType(..)
  , AgeGroup(..)
  , ClubType(..)
  , FrameType(..)
  , Gender(..)
  , MeasurementPreference(..)
  , PhotoType(..)
  , Resolution(..)
  , ResourceState(..)
  , SegmentActivityType(..)
  , SeriesType(..)
  , SportType(..)
  , StreamType(..)
  , WeightClass(..)
  ) where

import Control.Applicative (empty)
import Data.Aeson (FromJSON, Value(Number, String), parseJSON)

-- | An activity's type.
data ActivityType
  = AlpineSki
  | BackcountrySki
  | Canoeing
  | CrossCountrySkiing
  | Crossfit
  | Elliptical
  | Hike
  | IceSkate
  | InlineSkate
  | Kayaking
  | KiteSurf
  | NordicSki
  | Ride
  | RockClimbing
  | RollerSki
  | Rowing
  | Run
  | Snowboard
  | Snowshoe
  | StairStepper
  | StandUpPaddling
  | Surfing
  | Swim
  | VirtualRide
  | Walk
  | WeightTraining
  | Windsurf
  | Workout
  | Yoga
  deriving (ActivityType -> ActivityType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show)

instance FromJSON ActivityType where
  parseJSON :: Value -> Parser ActivityType
parseJSON (String Text
"AlpineSki") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
AlpineSki
  parseJSON (String Text
"BackcountrySki") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
BackcountrySki
  parseJSON (String Text
"Canoeing") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Canoeing
  parseJSON (String Text
"CrossCountrySkiing") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
CrossCountrySkiing
  parseJSON (String Text
"Crossfit") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Crossfit
  parseJSON (String Text
"Elliptical") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Elliptical
  parseJSON (String Text
"Hike") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Hike
  parseJSON (String Text
"IceSkate") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
IceSkate
  parseJSON (String Text
"InlineSkate") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
InlineSkate
  parseJSON (String Text
"Kayaking") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Kayaking
  parseJSON (String Text
"KiteSurf") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
KiteSurf
  parseJSON (String Text
"NordicSki") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
NordicSki
  parseJSON (String Text
"Ride") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Ride
  parseJSON (String Text
"RockClimbing") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
RockClimbing
  parseJSON (String Text
"RollerSki") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
RollerSki
  parseJSON (String Text
"Rowing") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Rowing
  parseJSON (String Text
"Run") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Run
  parseJSON (String Text
"Snowboard") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Snowboard
  parseJSON (String Text
"Snowshoe") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Snowshoe
  parseJSON (String Text
"StairStepper") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
StairStepper
  parseJSON (String Text
"StandUpPaddling") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
StandUpPaddling
  parseJSON (String Text
"Surfing") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Surfing
  parseJSON (String Text
"Swim") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Swim
  parseJSON (String Text
"VirtualRide") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
VirtualRide
  parseJSON (String Text
"Walk") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Walk
  parseJSON (String Text
"WeightTraining") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
WeightTraining
  parseJSON (String Text
"Windsurf") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Windsurf
  parseJSON (String Text
"Workout") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Workout
  parseJSON (String Text
"Yoga") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityType
Yoga
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | An activity zone's type.
data ActivityZoneType
  = HeartrateZone
  | PowerZone
  deriving (ActivityZoneType -> ActivityZoneType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityZoneType -> ActivityZoneType -> Bool
$c/= :: ActivityZoneType -> ActivityZoneType -> Bool
== :: ActivityZoneType -> ActivityZoneType -> Bool
$c== :: ActivityZoneType -> ActivityZoneType -> Bool
Eq, Int -> ActivityZoneType -> ShowS
[ActivityZoneType] -> ShowS
ActivityZoneType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityZoneType] -> ShowS
$cshowList :: [ActivityZoneType] -> ShowS
show :: ActivityZoneType -> String
$cshow :: ActivityZoneType -> String
showsPrec :: Int -> ActivityZoneType -> ShowS
$cshowsPrec :: Int -> ActivityZoneType -> ShowS
Show)

instance FromJSON ActivityZoneType where
  parseJSON :: Value -> Parser ActivityZoneType
parseJSON (String Text
"heartrate") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityZoneType
HeartrateZone
  parseJSON (String Text
"power") = forall (m :: * -> *) a. Monad m => a -> m a
return ActivityZoneType
PowerZone
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | An athlete's age group.
data AgeGroup
  = Ages0To24
  | Ages25To34
  | Ages35To44
  | Ages45To54
  | Ages55To64
  | Ages65Plus
  deriving AgeGroup -> AgeGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AgeGroup -> AgeGroup -> Bool
$c/= :: AgeGroup -> AgeGroup -> Bool
== :: AgeGroup -> AgeGroup -> Bool
$c== :: AgeGroup -> AgeGroup -> Bool
Eq

instance Show AgeGroup where
  show :: AgeGroup -> String
show AgeGroup
Ages0To24 = String
"0_24"
  show AgeGroup
Ages25To34 = String
"25_34"
  show AgeGroup
Ages35To44 = String
"35_44"
  show AgeGroup
Ages45To54 = String
"45_54"
  show AgeGroup
Ages55To64 = String
"55_64"
  show AgeGroup
Ages65Plus = String
"65_plus"

-- | A club's type.
data ClubType
  = CasualClub
  | Company
  | Other
  | RacingTeam
  | Shop
  deriving (ClubType -> ClubType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClubType -> ClubType -> Bool
$c/= :: ClubType -> ClubType -> Bool
== :: ClubType -> ClubType -> Bool
$c== :: ClubType -> ClubType -> Bool
Eq, Int -> ClubType -> ShowS
[ClubType] -> ShowS
ClubType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClubType] -> ShowS
$cshowList :: [ClubType] -> ShowS
show :: ClubType -> String
$cshow :: ClubType -> String
showsPrec :: Int -> ClubType -> ShowS
$cshowsPrec :: Int -> ClubType -> ShowS
Show)

instance FromJSON ClubType where
  parseJSON :: Value -> Parser ClubType
parseJSON (String Text
"casual_club") = forall (m :: * -> *) a. Monad m => a -> m a
return ClubType
CasualClub
  parseJSON (String Text
"company") = forall (m :: * -> *) a. Monad m => a -> m a
return ClubType
Company
  parseJSON (String Text
"other") = forall (m :: * -> *) a. Monad m => a -> m a
return ClubType
Other
  parseJSON (String Text
"racing_team") = forall (m :: * -> *) a. Monad m => a -> m a
return ClubType
RacingTeam
  parseJSON (String Text
"shop") = forall (m :: * -> *) a. Monad m => a -> m a
return ClubType
Shop
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A bike's frame type.
data FrameType
  = CrossFrame
  | MountainFrame
  | RoadFrame
  | TimeTrialFrame
  deriving (FrameType -> FrameType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameType -> FrameType -> Bool
$c/= :: FrameType -> FrameType -> Bool
== :: FrameType -> FrameType -> Bool
$c== :: FrameType -> FrameType -> Bool
Eq, Int -> FrameType -> ShowS
[FrameType] -> ShowS
FrameType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameType] -> ShowS
$cshowList :: [FrameType] -> ShowS
show :: FrameType -> String
$cshow :: FrameType -> String
showsPrec :: Int -> FrameType -> ShowS
$cshowsPrec :: Int -> FrameType -> ShowS
Show)

instance FromJSON FrameType where
  parseJSON :: Value -> Parser FrameType
parseJSON (Number Scientific
2) = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
CrossFrame
  parseJSON (Number Scientific
1) = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
MountainFrame
  parseJSON (Number Scientific
3) = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
RoadFrame
  parseJSON (Number Scientific
4) = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
TimeTrialFrame
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | An athlete's gender.
data Gender
  = Female
  | Male
  deriving Gender -> Gender -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gender -> Gender -> Bool
$c/= :: Gender -> Gender -> Bool
== :: Gender -> Gender -> Bool
$c== :: Gender -> Gender -> Bool
Eq

instance Show Gender where
  show :: Gender -> String
show Gender
Female = String
"F"
  show Gender
Male = String
"M"

instance FromJSON Gender where
  parseJSON :: Value -> Parser Gender
parseJSON (String Text
"F") = forall (m :: * -> *) a. Monad m => a -> m a
return Gender
Female
  parseJSON (String Text
"M") = forall (m :: * -> *) a. Monad m => a -> m a
return Gender
Male
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | An athlete's measurement preference.
data MeasurementPreference
  = Feet
  | Meters
  deriving (MeasurementPreference -> MeasurementPreference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasurementPreference -> MeasurementPreference -> Bool
$c/= :: MeasurementPreference -> MeasurementPreference -> Bool
== :: MeasurementPreference -> MeasurementPreference -> Bool
$c== :: MeasurementPreference -> MeasurementPreference -> Bool
Eq, Int -> MeasurementPreference -> ShowS
[MeasurementPreference] -> ShowS
MeasurementPreference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasurementPreference] -> ShowS
$cshowList :: [MeasurementPreference] -> ShowS
show :: MeasurementPreference -> String
$cshow :: MeasurementPreference -> String
showsPrec :: Int -> MeasurementPreference -> ShowS
$cshowsPrec :: Int -> MeasurementPreference -> ShowS
Show)

instance FromJSON MeasurementPreference where
  parseJSON :: Value -> Parser MeasurementPreference
parseJSON (String Text
"feet") = forall (m :: * -> *) a. Monad m => a -> m a
return MeasurementPreference
Feet
  parseJSON (String Text
"meters") = forall (m :: * -> *) a. Monad m => a -> m a
return MeasurementPreference
Meters
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A photo's type.
data PhotoType = InstagramPhoto
  deriving (PhotoType -> PhotoType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhotoType -> PhotoType -> Bool
$c/= :: PhotoType -> PhotoType -> Bool
== :: PhotoType -> PhotoType -> Bool
$c== :: PhotoType -> PhotoType -> Bool
Eq, Int -> PhotoType -> ShowS
[PhotoType] -> ShowS
PhotoType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhotoType] -> ShowS
$cshowList :: [PhotoType] -> ShowS
show :: PhotoType -> String
$cshow :: PhotoType -> String
showsPrec :: Int -> PhotoType -> ShowS
$cshowsPrec :: Int -> PhotoType -> ShowS
Show)

instance FromJSON PhotoType where
  parseJSON :: Value -> Parser PhotoType
parseJSON (String Text
"InstagramPhoto") = forall (m :: * -> *) a. Monad m => a -> m a
return PhotoType
InstagramPhoto
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A stream's resolution.
data Resolution
  = Low
  | Medium
  | High
  deriving Resolution -> Resolution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resolution -> Resolution -> Bool
$c/= :: Resolution -> Resolution -> Bool
== :: Resolution -> Resolution -> Bool
$c== :: Resolution -> Resolution -> Bool
Eq

instance Show Resolution where
  show :: Resolution -> String
show Resolution
Low = String
"low"
  show Resolution
Medium = String
"medium"
  show Resolution
High = String
"high"

instance FromJSON Resolution where
  parseJSON :: Value -> Parser Resolution
parseJSON (String Text
"low") = forall (m :: * -> *) a. Monad m => a -> m a
return Resolution
Low
  parseJSON (String Text
"medium") = forall (m :: * -> *) a. Monad m => a -> m a
return Resolution
Medium
  parseJSON (String Text
"high") = forall (m :: * -> *) a. Monad m => a -> m a
return Resolution
High
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A resource's state.
data ResourceState
  = Meta
  | Summary
  | Detailed
  deriving (ResourceState -> ResourceState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceState -> ResourceState -> Bool
$c/= :: ResourceState -> ResourceState -> Bool
== :: ResourceState -> ResourceState -> Bool
$c== :: ResourceState -> ResourceState -> Bool
Eq, Int -> ResourceState -> ShowS
[ResourceState] -> ShowS
ResourceState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceState] -> ShowS
$cshowList :: [ResourceState] -> ShowS
show :: ResourceState -> String
$cshow :: ResourceState -> String
showsPrec :: Int -> ResourceState -> ShowS
$cshowsPrec :: Int -> ResourceState -> ShowS
Show)

instance FromJSON ResourceState where
  parseJSON :: Value -> Parser ResourceState
parseJSON (Number Scientific
1) = forall (m :: * -> *) a. Monad m => a -> m a
return ResourceState
Meta
  parseJSON (Number Scientific
2) = forall (m :: * -> *) a. Monad m => a -> m a
return ResourceState
Summary
  parseJSON (Number Scientific
3) = forall (m :: * -> *) a. Monad m => a -> m a
return ResourceState
Detailed
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A segment's activity type.
data SegmentActivityType
  = Riding
  | Running
  deriving SegmentActivityType -> SegmentActivityType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentActivityType -> SegmentActivityType -> Bool
$c/= :: SegmentActivityType -> SegmentActivityType -> Bool
== :: SegmentActivityType -> SegmentActivityType -> Bool
$c== :: SegmentActivityType -> SegmentActivityType -> Bool
Eq

instance Show SegmentActivityType where
  show :: SegmentActivityType -> String
show SegmentActivityType
Riding = String
"riding"
  show SegmentActivityType
Running = String
"running"

-- | A series' type in a stream.
data SeriesType
  = Distance
  | Time
  deriving SeriesType -> SeriesType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeriesType -> SeriesType -> Bool
$c/= :: SeriesType -> SeriesType -> Bool
== :: SeriesType -> SeriesType -> Bool
$c== :: SeriesType -> SeriesType -> Bool
Eq

instance Show SeriesType where
  show :: SeriesType -> String
show SeriesType
Distance = String
"distance"
  show SeriesType
Time = String
"time"

instance FromJSON SeriesType where
  parseJSON :: Value -> Parser SeriesType
parseJSON (String Text
"distance") = forall (m :: * -> *) a. Monad m => a -> m a
return SeriesType
Distance
  parseJSON (String Text
"time") = forall (m :: * -> *) a. Monad m => a -> m a
return SeriesType
Time
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A club's sport type.
data SportType
  = SportCycling
  | SportOther
  | SportRunning
  | SportTriathalon
  deriving (SportType -> SportType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SportType -> SportType -> Bool
$c/= :: SportType -> SportType -> Bool
== :: SportType -> SportType -> Bool
$c== :: SportType -> SportType -> Bool
Eq, Int -> SportType -> ShowS
[SportType] -> ShowS
SportType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SportType] -> ShowS
$cshowList :: [SportType] -> ShowS
show :: SportType -> String
$cshow :: SportType -> String
showsPrec :: Int -> SportType -> ShowS
$cshowsPrec :: Int -> SportType -> ShowS
Show)

instance FromJSON SportType where
  parseJSON :: Value -> Parser SportType
parseJSON (String Text
"cycling") = forall (m :: * -> *) a. Monad m => a -> m a
return SportType
SportCycling
  parseJSON (String Text
"other") = forall (m :: * -> *) a. Monad m => a -> m a
return SportType
SportOther
  parseJSON (String Text
"running") = forall (m :: * -> *) a. Monad m => a -> m a
return SportType
SportRunning
  parseJSON (String Text
"triathalon") = forall (m :: * -> *) a. Monad m => a -> m a
return SportType
SportTriathalon
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

-- | A stream's type.
data StreamType
  = AltitudeStream
  | CadenceStream
  | DistanceStream
  | GradeSmoothStream
  | HeartrateStream
  | LatlngStream
  | MovingStream
  | TempStream
  | TimeStream
  | VelocitySmoothStream
  | WattsStream
  deriving StreamType -> StreamType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamType -> StreamType -> Bool
$c/= :: StreamType -> StreamType -> Bool
== :: StreamType -> StreamType -> Bool
$c== :: StreamType -> StreamType -> Bool
Eq

instance Show StreamType where
  show :: StreamType -> String
show StreamType
AltitudeStream = String
"altitude"
  show StreamType
CadenceStream = String
"cadence"
  show StreamType
DistanceStream = String
"distance"
  show StreamType
GradeSmoothStream = String
"grade_smooth"
  show StreamType
HeartrateStream = String
"heartrate"
  show StreamType
LatlngStream = String
"latlng"
  show StreamType
MovingStream = String
"moving"
  show StreamType
TempStream = String
"temp"
  show StreamType
TimeStream = String
"time"
  show StreamType
VelocitySmoothStream = String
"velocity_smooth"
  show StreamType
WattsStream = String
"watts"

-- | An athlete's weight class.
data WeightClass
  = Kilograms0To54
  | Kilograms55To64
  | Kilograms65To74
  | Kilograms75To84
  | Kilograms85To94
  | Kilograms95Plus
  | Pounds0To124
  | Pounds125To149
  | Pounds150To164
  | Pounds165To179
  | Pounds180To199
  | Pounds200Plus
  deriving WeightClass -> WeightClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeightClass -> WeightClass -> Bool
$c/= :: WeightClass -> WeightClass -> Bool
== :: WeightClass -> WeightClass -> Bool
$c== :: WeightClass -> WeightClass -> Bool
Eq

instance Show WeightClass where
  show :: WeightClass -> String
show WeightClass
Kilograms0To54 = String
"0_54"
  show WeightClass
Kilograms55To64 = String
"55_64"
  show WeightClass
Kilograms65To74 = String
"65_74"
  show WeightClass
Kilograms75To84 = String
"75_84"
  show WeightClass
Kilograms85To94 = String
"85_94"
  show WeightClass
Kilograms95Plus = String
"95_plus"
  show WeightClass
Pounds0To124 = String
"0_124"
  show WeightClass
Pounds125To149 = String
"125_149"
  show WeightClass
Pounds150To164 = String
"150_164"
  show WeightClass
Pounds165To179 = String
"165_179"
  show WeightClass
Pounds180To199 = String
"180_199"
  show WeightClass
Pounds200Plus = String
"200_plus"