{-# LANGUAGE OverloadedStrings #-}

module Tesla.Car.Command.Windows (
  ventWindows, closeWindows, ventSunroof, closeSunroof
  ) where

import           Control.Monad.IO.Class (MonadIO (..))
import           Data.Text              (Text)

import           Tesla.Car.Command

windowControl :: MonadIO m => Text -> (Double, Double) -> Car m CommandResponse
windowControl :: forall (m :: * -> *).
MonadIO m =>
Text -> (Double, Double) -> Car m CommandResponse
windowControl Text
x (Double
lat,Double
lon) = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"window_control" [ Key
"command" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
x, Key
"lat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
lat, Key
"lon" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
lon]

-- | Roll the windows down slightly.
ventWindows :: MonadIO m => Car m CommandResponse
ventWindows :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
ventWindows = forall (m :: * -> *).
MonadIO m =>
Text -> (Double, Double) -> Car m CommandResponse
windowControl Text
"vent" (Double
0,Double
0)

-- | Close the windows.  This command will fail if the (lat,lon) passed in is too far from the car.
closeWindows :: MonadIO m => (Double, Double) -> Car m CommandResponse
closeWindows :: forall (m :: * -> *).
MonadIO m =>
(Double, Double) -> Car m CommandResponse
closeWindows = forall (m :: * -> *).
MonadIO m =>
Text -> (Double, Double) -> Car m CommandResponse
windowControl Text
"close"

sc :: MonadIO m => Text -> Car m CommandResponse
sc :: forall (m :: * -> *). MonadIO m => Text -> Car m CommandResponse
sc Text
c = forall (m :: * -> *).
MonadIO m =>
String -> [Pair] -> Car m CommandResponse
runCmd String
"sun_roof_control" [ Key
"state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
c ]

ventSunroof :: MonadIO m => Car m CommandResponse
ventSunroof :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
ventSunroof = forall (m :: * -> *). MonadIO m => Text -> Car m CommandResponse
sc Text
"vent"

closeSunroof :: MonadIO m => Car m CommandResponse
closeSunroof :: forall (m :: * -> *). MonadIO m => Car m CommandResponse
closeSunroof = forall (m :: * -> *). MonadIO m => Text -> Car m CommandResponse
sc Text
"close"