{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Tesla.Car.Command.Climate (
  hvacOn, hvacOff, ClimateKeeper(..), climateKeeper,
  heatSeat, coolSeat, Seat(..),
  setTemps, wheelHeater, wheelHeaterOff, wheelHeaterOn,
  maxDefrost,
  bioweaponMode,
  Sometimes(..), OffPeakConfig(..), Preconditioning,
  scheduledDepartureOff, scheduleDeparture
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Aeson
import           Tesla.Car.Command

-- | Turn on the steering wheel heater
wheelHeater :: MonadIO m => Bool -> Car m CommandResponse
wheelHeater :: forall (m :: * -> *). MonadIO m => Bool -> Car m CommandResponse
wheelHeater Bool
on = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"remote_steering_wheel_heater_request" [Key
"on" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
on]

wheelHeaterOn :: MonadIO m => Car m CommandResponse
wheelHeaterOn :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
wheelHeaterOn = forall (m :: * -> *). MonadIO m => Bool -> Car m CommandResponse
wheelHeater Bool
True

wheelHeaterOff :: MonadIO m => Car m CommandResponse
wheelHeaterOff :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
wheelHeaterOff = forall (m :: * -> *). MonadIO m => Bool -> Car m CommandResponse
wheelHeater Bool
False

-- | Turn on or off bioweapon defense mode.
--
-- If HVAC is off, turning on bioweapon defense mode will also turn on HVAC.
bioweaponMode :: MonadIO m => Bool -> Car m CommandResponse
bioweaponMode :: forall (m :: * -> *). MonadIO m => Bool -> Car m CommandResponse
bioweaponMode Bool
on = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_bioweapon_mode" [Key
"on" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
on]

data Seat = DriverSeat | PassengerSeat | RearLeftSeat | RearCenterSeat | RearRightSeat

seatNum :: Seat -> Int
seatNum :: Seat -> Int
seatNum Seat
DriverSeat     = Int
0
seatNum Seat
PassengerSeat  = Int
1
seatNum Seat
RearLeftSeat   = Int
2
seatNum Seat
RearCenterSeat = Int
4
seatNum Seat
RearRightSeat  = Int
5


-- | Set heating levels for various seats.
heatSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse
heatSeat :: forall (m :: * -> *).
MonadIO m =>
Seat -> Int -> Car m CommandResponse
heatSeat Seat
seat Int
level = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"remote_seat_heater_request" [Key
"heater" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Seat -> Int
seatNum Seat
seat, Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
level]

-- | Set cooling levels for various seats.
coolSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse
coolSeat :: forall (m :: * -> *).
MonadIO m =>
Seat -> Int -> Car m CommandResponse
coolSeat Seat
seat Int
level = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"remote_seat_cooler_request" [Key
"seat_position" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Seat -> Int
seatNum Seat
seat, Key
"seat_cooler_level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
level]

-- | Set the main HVAC temperatures.
setTemps :: MonadIO m => (Double, Double) -> Car m CommandResponse
setTemps :: forall (m :: * -> *).
MonadIO m =>
(Double, Double) -> Car m CommandResponse
setTemps (Double
driver, Double
passenger) = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_temps" [Key
"driver_temp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
driver, Key
"passenger_temp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
passenger]

maxDefrost :: MonadIO m => Bool -> Car m CommandResponse
maxDefrost :: forall (m :: * -> *). MonadIO m => Bool -> Car m CommandResponse
maxDefrost Bool
on = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_preconditioning_max" [Key
"on" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
on]

scheduledDepartureOff :: MonadIO m => Car m CommandResponse
scheduledDepartureOff :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
scheduledDepartureOff = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_scheduled_departure" [ Key
"enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False ]

-- | When configuring scheduled departure, preconditioning and
-- off-peak charging both have weekday only options.
data Sometimes = Never | Always | WeekdaysOnly

-- | Type alias to make 'scheduleDeparture' more readable.
type Preconditioning = Sometimes

-- | Configuration for off-peak charging for a schedule departure.
data OffPeakConfig = OffPeakConfig {
  OffPeakConfig -> Sometimes
_offPeakEnabled :: Sometimes,
  OffPeakConfig -> Time
_offPeakEndTime :: Time
  }

-- | Schedule a departure.
--
-- For this to do anything useful, you need to specify at least one of
-- 'Preconditioning' and/or 'OffPeakConfig'.
scheduleDeparture :: MonadIO m => Time -> Preconditioning -> Maybe OffPeakConfig -> Car m CommandResponse
scheduleDeparture :: forall (m :: * -> *).
MonadIO m =>
Time -> Sometimes -> Maybe OffPeakConfig -> Car m CommandResponse
scheduleDeparture Time
t Sometimes
p Maybe OffPeakConfig
o = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_scheduled_departure" ([Key
"enable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True, Key
"departure_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Time
t] forall a. Semigroup a => a -> a -> a
<> [Pair]
pp forall a. Semigroup a => a -> a -> a
<> forall {a}. KeyValue a => Maybe OffPeakConfig -> [a]
op Maybe OffPeakConfig
o)
  where
    pp :: [Pair]
pp = forall {a}. KeyValue a => Key -> Key -> Sometimes -> [a]
s Key
"preconditioning_enabled" Key
"preconditioning_weekdays_only" Sometimes
p
    op :: Maybe OffPeakConfig -> [a]
op Maybe OffPeakConfig
Nothing  = forall {a}. KeyValue a => OffPeakConfig -> [a]
opp (Sometimes -> Time -> OffPeakConfig
OffPeakConfig Sometimes
Never (Finite 1440 -> Time
Time Finite 1440
0))
    op (Just OffPeakConfig
x) = forall {a}. KeyValue a => OffPeakConfig -> [a]
opp OffPeakConfig
x
    opp :: OffPeakConfig -> [a]
opp OffPeakConfig{Time
Sometimes
_offPeakEndTime :: Time
_offPeakEnabled :: Sometimes
_offPeakEndTime :: OffPeakConfig -> Time
_offPeakEnabled :: OffPeakConfig -> Sometimes
..} = (Key
"end_off_peak_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Time
_offPeakEndTime) forall a. a -> [a] -> [a]
: forall {a}. KeyValue a => Key -> Key -> Sometimes -> [a]
s Key
"off_peak_charging_enabled" Key
"off_peak_charging_weekdays_only" Sometimes
_offPeakEnabled

    s :: Key -> Key -> Sometimes -> [a]
s Key
e Key
w = \case
           Sometimes
Never        -> [Key
e forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False, Key
w forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False]
           Sometimes
Always       -> [Key
e forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True, Key
w forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
False]
           Sometimes
WeekdaysOnly -> [Key
e forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True, Key
w forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True]

data ClimateKeeper = ClimateKeeperOff | ClimateKeeperDefault | DogMode | CampMode
  deriving (ClimateKeeper -> ClimateKeeper -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClimateKeeper -> ClimateKeeper -> Bool
$c/= :: ClimateKeeper -> ClimateKeeper -> Bool
== :: ClimateKeeper -> ClimateKeeper -> Bool
$c== :: ClimateKeeper -> ClimateKeeper -> Bool
Eq, Int -> ClimateKeeper -> ShowS
[ClimateKeeper] -> ShowS
ClimateKeeper -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClimateKeeper] -> ShowS
$cshowList :: [ClimateKeeper] -> ShowS
show :: ClimateKeeper -> String
$cshow :: ClimateKeeper -> String
showsPrec :: Int -> ClimateKeeper -> ShowS
$cshowsPrec :: Int -> ClimateKeeper -> ShowS
Show, ClimateKeeper
forall a. a -> a -> Bounded a
maxBound :: ClimateKeeper
$cmaxBound :: ClimateKeeper
minBound :: ClimateKeeper
$cminBound :: ClimateKeeper
Bounded, Int -> ClimateKeeper
ClimateKeeper -> Int
ClimateKeeper -> [ClimateKeeper]
ClimateKeeper -> ClimateKeeper
ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
ClimateKeeper -> ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClimateKeeper -> ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
$cenumFromThenTo :: ClimateKeeper -> ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
enumFromTo :: ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
$cenumFromTo :: ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
enumFromThen :: ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
$cenumFromThen :: ClimateKeeper -> ClimateKeeper -> [ClimateKeeper]
enumFrom :: ClimateKeeper -> [ClimateKeeper]
$cenumFrom :: ClimateKeeper -> [ClimateKeeper]
fromEnum :: ClimateKeeper -> Int
$cfromEnum :: ClimateKeeper -> Int
toEnum :: Int -> ClimateKeeper
$ctoEnum :: Int -> ClimateKeeper
pred :: ClimateKeeper -> ClimateKeeper
$cpred :: ClimateKeeper -> ClimateKeeper
succ :: ClimateKeeper -> ClimateKeeper
$csucc :: ClimateKeeper -> ClimateKeeper
Enum)

instance ToJSON ClimateKeeper where
  toJSON :: ClimateKeeper -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

climateKeeper :: MonadIO m => ClimateKeeper -> Car m CommandResponse
climateKeeper :: forall (m :: * -> *).
MonadIO m =>
ClimateKeeper -> Car m CommandResponse
climateKeeper ClimateKeeper
ck = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"set_climate_keeper_mode" [ Key
"climate_keeper_mode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ClimateKeeper
ck]

mkNamedCommands [("hvacOn", "auto_conditioning_start"),
                 ("hvacOff", "auto_conditioning_stop")]