{-# LANGUAGE OverloadedStrings #-} module Tesla.Car.Command.SpeedLimit ( speedLimit, activateSpeedLimit, deactivateSpeedLimit, clearSpeedLimitPIN ) where import Control.Monad.IO.Class (MonadIO (..)) import Tesla.Car.Command speedLimit :: MonadIO m => Int -> Car m CommandResponse speedLimit :: forall (m :: * -> *). MonadIO m => Int -> Car m CommandResponse speedLimit Int to = String -> [Pair] -> Car m CommandResponse forall (m :: * -> *). MonadIO m => String -> [Pair] -> Car m CommandResponse runCmd String "speed_limit_set_limit" [Key "limit_mph" Key -> Int -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int to ] speedo :: MonadIO m => String -> Int -> Car m CommandResponse speedo :: forall (m :: * -> *). MonadIO m => String -> Int -> Car m CommandResponse speedo String c Int pin = String -> [Pair] -> Car m CommandResponse forall (m :: * -> *). MonadIO m => String -> [Pair] -> Car m CommandResponse runCmd String c [Key "pin" Key -> Int -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Int pin ] activateSpeedLimit :: MonadIO m => Int -> Car m CommandResponse activateSpeedLimit :: forall (m :: * -> *). MonadIO m => Int -> Car m CommandResponse activateSpeedLimit = String -> Int -> Car m CommandResponse forall (m :: * -> *). MonadIO m => String -> Int -> Car m CommandResponse speedo String "speed_limit_activate" deactivateSpeedLimit :: MonadIO m => Int -> Car m CommandResponse deactivateSpeedLimit :: forall (m :: * -> *). MonadIO m => Int -> Car m CommandResponse deactivateSpeedLimit = String -> Int -> Car m CommandResponse forall (m :: * -> *). MonadIO m => String -> Int -> Car m CommandResponse speedo String "speed_limit_deactivate" clearSpeedLimitPIN :: MonadIO m => Int -> Car m CommandResponse clearSpeedLimitPIN :: forall (m :: * -> *). MonadIO m => Int -> Car m CommandResponse clearSpeedLimitPIN = String -> Int -> Car m CommandResponse forall (m :: * -> *). MonadIO m => String -> Int -> Car m CommandResponse speedo String "speed_limit_clear_pin"