tesla 0.7.2.0 → 0.7.4.0

raw patch · 9 files changed

+80/−43 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Tesla/Car/Command.hs +36/−21
• src/Tesla/Car/Command/Charging.hs +1/−1
• src/Tesla/Car/Command/Climate.hs +28/−8
• src/Tesla/Car/Command/Homelink.hs +3/−3
• src/Tesla/Car/Command/Sharing.hs +2/−0
• src/Tesla/Car/Command/Valet.hs +1/−0
• src/Tesla/Car/Command/Wake.hs +5/−8
• src/Tesla/Car/Command/Windows.hs +2/−0
• tesla.cabal +2/−2

@@ -1,9 +1,13 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+ {-| Module      : Tesla.Car.Command Description : Commands executed on a car.@@ -14,26 +18,28 @@  module Tesla.Car.Command (   Time(..), mkTime, fromTime,+  Percent(..), mkPercent,   runCmd, runCmd', CommandResponse, Car,   (.=),   -- * TH support for generating commands.   mkCommand, mkCommands, mkNamedCommands) where -import           Control.Lens hiding ((.=))-import           Control.Monad.IO.Class (MonadIO (..))+import           Control.Lens                    hiding ((.=))+import           Control.Monad.IO.Class          (MonadIO (..)) import           Data.Aeson-import           Data.Aeson.Lens        (_Bool, _String, key)-import qualified Data.ByteString.Lazy   as BL-import           Data.Finite            (Finite, getFinite, modulo)-import           Data.Text              (Text)+import           Data.Aeson.Lens                 (_Bool, _String, key)+import           Data.Finite                     (Finite, getFinite, modulo, packFinite)+import           Data.Text                       (Text)+import           GHC.Read import           GHC.TypeNats import           Language.Haskell.TH-import           Network.Wreq.Types     (FormValue (..))-import           Text.Casing            (fromSnake, toCamel)+import           Network.Wreq.Types              (FormValue (..))+import           Text.Casing                     (fromSnake, toCamel) +import           Data.Aeson.Types                (Pair) import           Tesla.Car import           Tesla.Internal.HTTP-import Data.Aeson.Types (Pair)+import qualified Text.ParserCombinators.ReadPrec as TextParser  -- | A CommandResponse wraps an Either such that Left represents a -- failure message and Right suggests the command was successful.@@ -69,6 +75,20 @@     f :: forall m n. (KnownNat m, KnownNat n, n <= m) => Finite m -> Finite n     f = modulo . toInteger +-- | A type representing a whole number percnetage between 0 and 100 (inclusive).+newtype Percent = Percent (Finite 101)++instance Read Percent where+    readPrec = TextParser.prec 10 (maybe TextParser.pfail pure . mkPercent @Int =<< readPrec)++instance Show Percent where show (Percent t) = show (toInteger t)++mkPercent :: Integral n => n -> Maybe Percent+mkPercent = fmap Percent . packFinite . toInteger++instance ToJSON Percent where+  toJSON (Percent x) = toJSON (getFinite x)+ -- | Run a command with a JSON payload. runCmd :: MonadIO m => String -> [Pair] -> Car m CommandResponse runCmd cmd p = do@@ -81,12 +101,7 @@  -- | Run command without a payload runCmd' :: MonadIO m => String -> Car m CommandResponse-runCmd' cmd =  do-  v <- currentVehicleID-  j :: Value <- jpostAuth (vehicleURL v $ "command/" <> cmd) BL.empty-  pure $ case j ^? key "response" . key "result" . _Bool of-    Just True -> Right ()-    _         -> Left $ j ^. key "response" . key "reason" . _String+runCmd' = (`runCmd` [])  instance FormValue Bool where   renderFormValue True  = "true"

@@ -12,7 +12,7 @@ import           Tesla.Car.Command  -- | Set the desired charge level (percent).-setLimit :: MonadIO m => Int -> Car m CommandResponse+setLimit :: MonadIO m => Percent -> Car m CommandResponse setLimit to = runCmd "set_charge_limit" ["percent" .= to]  -- | Set the charge current.

@@ -4,7 +4,7 @@  module Tesla.Car.Command.Climate (   hvacOn, hvacOff, ClimateKeeper(..), climateKeeper,-  heatSeat, coolSeat, Seat(..),+  seatClimate, Seat(..), SeatLevel(..), SeatClimate(..), SeatMode(..),   setTemps, wheelHeater, wheelHeaterOff, wheelHeaterOn,   maxDefrost,   bioweaponMode,@@ -32,7 +32,9 @@ bioweaponMode :: MonadIO m => Bool -> Car m CommandResponse bioweaponMode on = runCmd "set_bioweapon_mode" ["on" .= on] +-- | Which seat to control. data Seat = DriverSeat | PassengerSeat | RearLeftSeat | RearCenterSeat | RearRightSeat+  deriving (Eq, Show, Bounded, Enum)  seatNum :: Seat -> Int seatNum DriverSeat     = 0@@ -41,16 +43,32 @@ seatNum RearCenterSeat = 4 seatNum RearRightSeat  = 5 +-- | For seat climate control, how much heating or cooling to apply.+data SeatLevel = SeatLeast | SeatMedium | SeatMost+  deriving (Eq, Show, Bounded, Enum) --- | Set heating levels for various seats.-heatSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse-heatSeat seat level = runCmd "remote_seat_heater_request" ["heater" .= seatNum seat, "level" .= level]+instance ToJSON SeatLevel where+  toJSON = toJSON . fromEnum --- | Set cooling levels for various seats.-coolSeat :: MonadIO m => Seat -> Int -> Car m CommandResponse-coolSeat seat level = runCmd "remote_seat_cooler_request" ["seat_position" .= seatNum seat, "seat_cooler_level" .= level]+-- | For seat climate control, whether to heat or cool.+data SeatMode = SeatHeat | SeatCool+  deriving (Eq, Show, Bounded, Enum) --- | Set the main HVAC temperatures.+-- 'seatClimate' parameter for specifying whether to heat or cool and how much.+data SeatClimate = SeatClimate SeatMode SeatLevel+  deriving (Eq, Show)++-- | Adjust the climate control settings for a seat.+seatClimate :: MonadIO m => Seat -> Maybe SeatClimate -> Car m CommandResponse+seatClimate seat Nothing = do+  _ <- runCmd "remote_seat_heater_request" ["heater" .= seatNum seat, "level" .= (0::Int)]+  runCmd "remote_seat_cooler_request" ["seat_position" .= seatNum seat, "seat_cooler_level" .= (0 :: Int)]+seatClimate seat (Just (SeatClimate SeatHeat level)) =+  runCmd "remote_seat_heater_request" ["heater" .= seatNum seat, "level" .= level]+seatClimate seat (Just (SeatClimate SeatCool level)) =+  runCmd "remote_seat_cooler_request" ["seat_position" .= seatNum seat, "seat_cooler_level" .= level]++-- | Set the main HVAC temperatures (driver and passenger). setTemps :: MonadIO m => (Double, Double) -> Car m CommandResponse setTemps (driver, passenger) = runCmd "set_temps" ["driver_temp" .= driver, "passenger_temp" .= passenger] @@ -63,6 +81,7 @@ -- | When configuring scheduled departure, preconditioning and -- off-peak charging both have weekday only options. data Sometimes = Never | Always | WeekdaysOnly+  deriving (Eq, Show, Bounded, Enum)  -- | Type alias to make 'scheduleDeparture' more readable. type Preconditioning = Sometimes@@ -96,6 +115,7 @@ instance ToJSON ClimateKeeper where   toJSON = toJSON . fromEnum +-- | Configure the climate keeper. climateKeeper :: MonadIO m => ClimateKeeper -> Car m CommandResponse climateKeeper ck = runCmd "set_climate_keeper_mode" [ "climate_keeper_mode" .= ck] 

@@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -module Tesla.Car.Command.Homelink (trigger) where+module Tesla.Car.Command.Homelink (homelink) where  import           Control.Monad.IO.Class (MonadIO (..)) import           Tesla.Car.Command  -- | Trigger nearby homelink with the given (lat,lon)-trigger :: MonadIO m => (Double, Double) -> Car m CommandResponse-trigger (lat,lon) = runCmd "flash_lights" ["lat" .= lat, "lon" .= lon]+homelink :: MonadIO m => (Double, Double) -> Car m CommandResponse+homelink (lat,lon) = runCmd "flash_lights" ["lat" .= lat, "lon" .= lon]

@@ -9,6 +9,8 @@  import           Tesla.Car.Command +-- | Share something to the car.+-- The "something" in this case can be an address or video URL share :: MonadIO m => Text -> Car m CommandResponse share to = do   now <- fst . properFraction . utcTimeToPOSIXSeconds <$> liftIO getCurrentTime

@@ -9,6 +9,7 @@  import           Tesla.Car.Command +-- | Enable valet mode with a four digit pin. setValetMode :: MonadIO m => Bool -> Int -> Car m CommandResponse setValetMode on pin = runCmd "set_valet_mode" [ "on" .= on, "password" .= pin] 

@@ -1,14 +1,11 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-}  module Tesla.Car.Command.Wake (   wakeUp   ) where -import           Control.Lens import           Control.Monad.IO.Class (MonadIO (..)) import           Data.Aeson-import           Data.Aeson.Lens import qualified Data.ByteString.Lazy   as BL  @@ -16,7 +13,7 @@ import           Tesla.Car.Command import           Tesla.Internal.HTTP    (jpostAuth) -wakeUp :: MonadIO m => Car m (Maybe Value)-wakeUp = do-  v <- currentVehicleID-  preview (_Just . key "response") <$> jpostAuth @_ @(Maybe Value) (vehicleURL v "wake_up") BL.empty+-- | Request the car to wake up.+-- This function should return pretty quickly, but the car may take a few seconds to wake up.+wakeUp :: (FromJSON j, MonadIO m) => Car m j+wakeUp = currentVehicleID >>= \v -> jpostAuth (vehicleURL v "wake_up") BL.empty

@@ -12,9 +12,11 @@ windowControl :: MonadIO m => Text -> (Double, Double) -> Car m CommandResponse windowControl x (lat,lon) = runCmd "window_control" [ "command" .= x, "lat" .= lat, "lon" .= lon] +-- | Roll the windows down slightly. ventWindows :: MonadIO m => Car m CommandResponse ventWindows = windowControl "vent" (0,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 = windowControl "close" 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 10fd401a397b5deea0c592f1f9fd9ee0443e0aa037897aa94ea4dd12f8379dfc+-- hash: e0d2e2f773d615d0ece057d0010a09010354337fbe9736a6489f13ab7c0d11f9  name:           tesla-version:        0.7.2.0+version:        0.7.4.0 synopsis:       Tesla API client. description:    Please see the README on GitHub at <https://github.com/dustin/tesla#readme> category:       Web