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

module Tesla.Car.Command.Charging (
  startCharging, stopCharging, setLimit, openChargePort, closeChargePort,
  setAmps,
  scheduledChargingOff, scheduleCharging
  ) where

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

import           Tesla.Car.Command

-- | Set the desired charge level (percent).
setLimit :: MonadIO m => Int -> Car m CommandResponse
setLimit :: Int -> Car m CommandResponse
setLimit Int
to = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_charge_limit" [ByteString
"percent" ByteString -> Int -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Int
to ]

-- | Set the charge current.
setAmps :: MonadIO m => Int -> Car m CommandResponse
setAmps :: Int -> Car m CommandResponse
setAmps Int
to = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_charging_amps" [ByteString
"charging_amps" ByteString -> Int -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Int
to]

-- | Disable scheduled charging.
scheduledChargingOff :: MonadIO m => Car m CommandResponse
scheduledChargingOff :: Car m CommandResponse
scheduledChargingOff = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_scheduled_charging" [ ByteString
"enable" ByteString -> Bool -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Bool
False ]

-- | Schedule charging for the given number of minutes after midnight (local time).
scheduleCharging :: MonadIO m => Time -> Car m CommandResponse
scheduleCharging :: Time -> Car m CommandResponse
scheduleCharging Time
mins = String -> [FormParam] -> Car m CommandResponse
forall (m :: * -> *) p.
(MonadIO m, Postable p) =>
String -> p -> Car m CommandResponse
runCmd String
"set_scheduled_charging" [ ByteString
"enable" ByteString -> Bool -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Bool
True, ByteString
"time" ByteString -> Time -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Time
mins ]

mkNamedCommands [("startCharging", "charge_start"),
                 ("stopCharging", "charge_stop"),
                 ("openChargePort", "charge_port_door_open"),
                 ("closeChargePort", "charge_port_door_close")]