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

module Tesla.Car.Command.Climate (
  hvacOn, hvacOff, heatSeat, Seat(..),
  setTemps, wheelHeater, wheelHeaterOff, wheelHeaterOn,
  wakeUp
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Network.Wreq           (FormParam (..))

import           Tesla.Car.Command

-- | Turn on the steering wheel heater
wheelHeater :: MonadIO m => Bool -> Car m CommandResponse
wheelHeater :: Bool -> Car m CommandResponse
wheelHeater Bool
on = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"remote_steering_wheel_heater_request" [ByteString
"on" ByteString -> Bool -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Bool
on]

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

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

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

-- | Set heating levels for various seats.
heatSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse
heatSeat :: Seat -> Int -> Car m CommandResponse
heatSeat Seat
seat Int
level = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"remote_seat_heater_request" [ByteString
"heater" ByteString -> Int -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Seat -> Int
seatNum Seat
seat, ByteString
"level" ByteString -> Int -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Int
level]
  where
    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 the main HVAC temperatures.
setTemps :: MonadIO m => (Double, Double) -> Car m CommandResponse
setTemps :: (Double, Double) -> Car m CommandResponse
setTemps (Double
driver, Double
passenger) = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_temps" [ByteString
"driver_temp" ByteString -> Double -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Double
driver, ByteString
"passenger_temp" ByteString -> Double -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Double
passenger]


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