{-|
Module:      Tesla.Car
Description: Tesla car-specific APIs.

Access of car-specific APIs.
-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE UndecidableInstances       #-}

module Tesla.Car (
  -- * Car Monad and related types.
  Car, runCar, runNamedCar,
  VehicleID,
  -- * Requests
  vehicleData, nearbyChargers, vehicleStatus, isAwake,
  -- * Convenience functions for examining VehicleData
  VehicleData, isUserPresent, isCharging, teslaTS, maybeTeslaTS,
  Door(..), OpenState(..), _Open, _Closed, doors, openDoors,
  -- * Charger Info
  Location(..), DestinationCharger(..), Supercharger(..), Charger(..),
  superchargers, destinationChargers,
  -- * Lenses/Prisms
  lat, lon, _SC, _DC,
  vdata, name, location, distance_miles, available_stalls, total_stalls, site_closed,
  -- * Probably uninteresting internals
  vehicleURL, currentVehicleID
      ) where

import           Control.Exception       (Exception, throwIO)
import           Control.Lens
import           Control.Monad           ((<=<))
import           Control.Monad.Catch     (MonadCatch (..), MonadMask (..), MonadThrow (..))
import           Control.Monad.IO.Class  (MonadIO (..))
import           Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)
import           Control.Monad.Logger    (MonadLogger)
import           Control.Monad.Reader    (MonadReader, ReaderT (..), asks, runReaderT)
import           Data.Aeson              (FromJSON (..), Options (..), Result (..), Value (..), decode, defaultOptions,
                                          encode, fieldLabelModifier, fromJSON, genericParseJSON, withObject, (.:))
import           Data.Aeson.Key          (Key)
import           Data.Aeson.Lens         (_Bool, _Integer, _String, key, values)
import qualified Data.ByteString.Lazy    as BL
import           Data.Foldable           (fold)
import qualified Data.Map.Strict         as Map
import           Data.Maybe              (fromJust, fromMaybe)
import           Data.Ratio
import           Data.Text               (Text, unpack)
import           Data.Time.Clock         (UTCTime)
import           Data.Time.Clock.POSIX   (posixSecondsToUTCTime)
import           Generics.Deriving.Base  (Generic)
import           Network.Wreq            (getWith, responseBody)

import           Tesla
import           Tesla.Auth
import           Tesla.Internal.HTTP

-- | Get the URL for a named endpoint for a given vehicle.
vehicleURL :: VehicleID -> String -> String
vehicleURL :: VehicleID -> String -> String
vehicleURL VehicleID
v String
c = forall a. Monoid a => [a] -> a
mconcat [String
baseURL, String
"api/1/vehicles/", VehicleID -> String
unpack VehicleID
v, String
"/", String
c]

data CarEnv = CarEnv {
  CarEnv -> IO AuthInfo
_authInfo :: IO AuthInfo,
  CarEnv -> VehicleID
_vid      :: VehicleID
  }

-- | Get the current vehicle ID from the Car Monad.
currentVehicleID :: MonadReader CarEnv m => m VehicleID
currentVehicleID :: forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CarEnv -> VehicleID
_vid

-- | Car Monad for accessing car-specific things.
newtype Car m a = Car { forall (m :: * -> *) a. Car m a -> ReaderT CarEnv m a
runCarM :: ReaderT CarEnv m a }
  deriving (forall a. a -> Car m a
forall a b. Car m a -> Car m b -> Car m a
forall a b. Car m a -> Car m b -> Car m b
forall a b. Car m (a -> b) -> Car m a -> Car m b
forall a b c. (a -> b -> c) -> Car m a -> Car m b -> Car m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (Car m)
forall (m :: * -> *) a. Applicative m => a -> Car m a
forall (m :: * -> *) a b.
Applicative m =>
Car m a -> Car m b -> Car m a
forall (m :: * -> *) a b.
Applicative m =>
Car m a -> Car m b -> Car m b
forall (m :: * -> *) a b.
Applicative m =>
Car m (a -> b) -> Car m a -> Car m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Car m a -> Car m b -> Car m c
<* :: forall a b. Car m a -> Car m b -> Car m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
Car m a -> Car m b -> Car m a
*> :: forall a b. Car m a -> Car m b -> Car m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
Car m a -> Car m b -> Car m b
liftA2 :: forall a b c. (a -> b -> c) -> Car m a -> Car m b -> Car m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Car m a -> Car m b -> Car m c
<*> :: forall a b. Car m (a -> b) -> Car m a -> Car m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
Car m (a -> b) -> Car m a -> Car m b
pure :: forall a. a -> Car m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> Car m a
Applicative, forall a b. a -> Car m b -> Car m a
forall a b. (a -> b) -> Car m a -> Car m b
forall (m :: * -> *) a b. Functor m => a -> Car m b -> Car m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Car m a -> Car m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Car m b -> Car m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> Car m b -> Car m a
fmap :: forall a b. (a -> b) -> Car m a -> Car m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Car m a -> Car m b
Functor, forall a. a -> Car m a
forall a b. Car m a -> Car m b -> Car m b
forall a b. Car m a -> (a -> Car m b) -> Car m b
forall {m :: * -> *}. Monad m => Applicative (Car m)
forall (m :: * -> *) a. Monad m => a -> Car m a
forall (m :: * -> *) a b. Monad m => Car m a -> Car m b -> Car m b
forall (m :: * -> *) a b.
Monad m =>
Car m a -> (a -> Car m b) -> Car m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Car m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Car m a
>> :: forall a b. Car m a -> Car m b -> Car m b
$c>> :: forall (m :: * -> *) a b. Monad m => Car m a -> Car m b -> Car m b
>>= :: forall a b. Car m a -> (a -> Car m b) -> Car m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Car m a -> (a -> Car m b) -> Car m b
Monad, forall a. IO a -> Car m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (Car m)
forall (m :: * -> *) a. MonadIO m => IO a -> Car m a
liftIO :: forall a. IO a -> Car m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Car m a
MonadIO,
            forall e a. Exception e => Car m a -> (e -> Car m a) -> Car m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (Car m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
Car m a -> (e -> Car m a) -> Car m a
catch :: forall e a. Exception e => Car m a -> (e -> Car m a) -> Car m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
Car m a -> (e -> Car m a) -> Car m a
MonadCatch, forall e a. Exception e => e -> Car m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (Car m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> Car m a
throwM :: forall e a. Exception e => e -> Car m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> Car m a
MonadThrow, forall b. ((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
forall a b c.
Car m a
-> (a -> ExitCase b -> Car m c) -> (a -> Car m b) -> Car m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (Car m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
forall (m :: * -> *) a b c.
MonadMask m =>
Car m a
-> (a -> ExitCase b -> Car m c) -> (a -> Car m b) -> Car m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
Car m a
-> (a -> ExitCase b -> Car m c) -> (a -> Car m b) -> Car m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
Car m a
-> (a -> ExitCase b -> Car m c) -> (a -> Car m b) -> Car m (b, c)
uninterruptibleMask :: forall b. ((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
mask :: forall b. ((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
MonadMask, MonadReader CarEnv,
            forall a. String -> Car m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (Car m)
forall (m :: * -> *) a. MonadFail m => String -> Car m a
fail :: forall a. String -> Car m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> Car m a
MonadFail, forall msg.
ToLogStr msg =>
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> VehicleID -> LogLevel -> msg -> m ())
-> MonadLogger m
forall {m :: * -> *}. MonadLogger m => Monad (Car m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
MonadLogger)

{- solonarv's thing almost works:
deriving newtype instance (MonadUnliftIO m, forall a a'. Coercible a a' => Coercible (m a) (m a')) => MonadUnliftIO (Car m)
-}

instance MonadUnliftIO m => MonadUnliftIO (Car m) where
  -- ((forall a. m a -> IO a) -> IO b) -> m b
  withRunInIO :: forall b. ((forall a. Car m a -> IO a) -> IO b) -> Car m b
withRunInIO (forall a. Car m a -> IO a) -> IO b
inner = forall (m :: * -> *) a. ReaderT CarEnv m a -> Car m a
Car forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT CarEnv m a -> IO a
run -> (forall a. Car m a -> IO a) -> IO b
inner (forall a. ReaderT CarEnv m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Car m a -> ReaderT CarEnv m a
runCarM)

instance (Monad m, MonadIO m, MonadReader CarEnv m) => HasTeslaAuth m where
  teslaAuth :: m AuthInfo
teslaAuth = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CarEnv -> IO AuthInfo
_authInfo

-- | Run a Car Monad with the given Vehicle ID
runCar :: MonadIO m => IO AuthInfo -> VehicleID -> Car m a -> m a
runCar :: forall (m :: * -> *) a.
MonadIO m =>
IO AuthInfo -> VehicleID -> Car m a -> m a
runCar IO AuthInfo
ai VehicleID
vi Car m a
f = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. Car m a -> ReaderT CarEnv m a
runCarM Car m a
f) (IO AuthInfo -> VehicleID -> CarEnv
CarEnv IO AuthInfo
ai VehicleID
vi)

newtype BadCarException = BadCar String deriving BadCarException -> BadCarException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BadCarException -> BadCarException -> Bool
$c/= :: BadCarException -> BadCarException -> Bool
== :: BadCarException -> BadCarException -> Bool
$c== :: BadCarException -> BadCarException -> Bool
Eq

instance Show BadCarException where
  show :: BadCarException -> String
show (BadCar String
s) = String
"BadCar: " forall a. Semigroup a => a -> a -> a
<> String
s

instance Exception BadCarException

-- | Run a Car Monad by looking up a car by name.
runNamedCar :: MonadIO m => Text -> IO AuthInfo -> Car m a -> m a
runNamedCar :: forall (m :: * -> *) a.
MonadIO m =>
VehicleID -> IO AuthInfo -> Car m a -> m a
runNamedCar VehicleID
name IO AuthInfo
ai Car m a
f = do
  AuthInfo
a <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AuthInfo
ai
  Map VehicleID VehicleID
vs <- [Product] -> Map VehicleID VehicleID
vehicles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => AuthInfo -> m [Product]
products AuthInfo
a
  VehicleID
c <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VehicleID
name Map VehicleID VehicleID
vs of
         Maybe VehicleID
Nothing -> forall {a}. String -> m a
throw forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [forall a. Show a => a -> String
show VehicleID
name, String
" is not a valid vehicle name.  Try one of: ",
                                     forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map VehicleID VehicleID
vs]
         Just VehicleID
c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VehicleID
c
  forall (m :: * -> *) a.
MonadIO m =>
IO AuthInfo -> VehicleID -> Car m a -> m a
runCar IO AuthInfo
ai VehicleID
c Car m a
f

  where
    throw :: String -> m a
throw = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BadCarException
BadCar

-- | Giant blob of VehicleData describing all known state of the vehicle.
--
-- This is not separated into discrete fields because that's easy
-- enough to do with Aeson and Lens when you need it but some
-- convenience methods for common accesses are available in this
-- module.
type VehicleData = BL.ByteString

-- | vehicleStatus returns the current status of the current vehicle.
vehicleStatus :: MonadIO m => Car m VehicleState
vehicleStatus :: forall (m :: * -> *). MonadIO m => Car m VehicleState
vehicleStatus = do
  VehicleID
v <- forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID
  Value
r <- forall (m :: * -> *) j.
(HasTeslaAuth m, FromJSON j, MonadIO m) =>
String -> m j
jgetAuth (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [String
baseURL, String
"api/1/vehicles/", VehicleID -> String
unpack VehicleID
v])
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Value
r :: Value) forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (forall t. AsValue t => Key -> Traversal' t Value
key Key
"response" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"state" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t VehicleID
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VehicleID -> VehicleState
vsFromString)

-- | isAwake returns true if the current vehicle is awake and online.
isAwake :: MonadIO m => Car m Bool
isAwake :: forall (m :: * -> *). MonadIO m => Car m Bool
isAwake = (forall a. Eq a => a -> a -> Bool
== VehicleState
VOnline) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => Car m VehicleState
vehicleStatus

-- | Fetch the VehicleData.
vehicleData :: MonadIO m => Car m VehicleData
vehicleData :: forall (m :: * -> *). MonadIO m => Car m VehicleData
vehicleData = do
  AuthInfo
a <- forall (m :: * -> *). HasTeslaAuth m => m AuthInfo
teslaAuth
  VehicleID
v <- forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID
  Response VehicleData
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response VehicleData)
getWith (AuthInfo -> Options
authOpts AuthInfo
a) (VehicleID -> String -> String
vehicleURL VehicleID
v String
"vehicle_data")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> Maybe VehicleData
inner forall a b. (a -> b) -> a -> b
$ Response VehicleData
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody
    where inner :: VehicleData -> Maybe VehicleData
inner = VehicleData -> VehicleData -> Maybe VehicleData
BL.stripPrefix VehicleData
"{\"response\":" forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< VehicleData -> VehicleData -> Maybe VehicleData
BL.stripSuffix VehicleData
"}"

-- | Prism for viewing 'VehicleData' as an Aeson 'Value'.
vdata :: Prism' VehicleData Value
vdata :: Prism' VehicleData Value
vdata = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' forall a. ToJSON a => a -> VehicleData
encode forall a. FromJSON a => VehicleData -> Maybe a
decode

-- | True if a user is present in the vehicle.
isUserPresent :: VehicleData -> Bool
isUserPresent :: VehicleData -> Bool
isUserPresent = (forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Prism' VehicleData Value
vdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"vehicle_state" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"is_user_present" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Bool
_Bool)

-- | True of the vehicle is currently charging.
isCharging :: VehicleData -> Bool
isCharging :: VehicleData -> Bool
isCharging = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
> Integer
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Prism' VehicleData Value
vdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"charge_state" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"charger_power" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Integer
_Integer)

-- | Get the timestamp from this VehicleData if present.
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS VehicleData
b = VehicleData
b forall s a. s -> Getting (First a) s a -> Maybe a
^? Prism' VehicleData Value
vdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"vehicle_state" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"timestamp" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Integer
_Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Integer -> UTCTime
pt
  where pt :: Integer -> UTCTime
pt Integer
x = POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ Integer
x forall a. Integral a => a -> a -> Ratio a
% Integer
1000

-- | Get the timestamp from this VehicleData or error if there isn't one.
teslaTS :: VehicleData -> UTCTime
teslaTS :: VehicleData -> UTCTime
teslaTS VehicleData
b = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ VehicleData
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> Maybe UTCTime
maybeTeslaTS forall a b. (a -> b) -> a -> b
$ VehicleData
b

-- | The various doors.
data Door = DriverFront
          | DriverRear
          | PassengerFront
          | PassengerRear
          | FrontTrunk
          | RearTrunk
          deriving (Int -> Door -> String -> String
[Door] -> String -> String
Door -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Door] -> String -> String
$cshowList :: [Door] -> String -> String
show :: Door -> String
$cshow :: Door -> String
showsPrec :: Int -> Door -> String -> String
$cshowsPrec :: Int -> Door -> String -> String
Show, Door
forall a. a -> a -> Bounded a
maxBound :: Door
$cmaxBound :: Door
minBound :: Door
$cminBound :: Door
Bounded, Int -> Door
Door -> Int
Door -> [Door]
Door -> Door
Door -> Door -> [Door]
Door -> Door -> Door -> [Door]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Door -> Door -> Door -> [Door]
$cenumFromThenTo :: Door -> Door -> Door -> [Door]
enumFromTo :: Door -> Door -> [Door]
$cenumFromTo :: Door -> Door -> [Door]
enumFromThen :: Door -> Door -> [Door]
$cenumFromThen :: Door -> Door -> [Door]
enumFrom :: Door -> [Door]
$cenumFrom :: Door -> [Door]
fromEnum :: Door -> Int
$cfromEnum :: Door -> Int
toEnum :: Int -> Door
$ctoEnum :: Int -> Door
pred :: Door -> Door
$cpred :: Door -> Door
succ :: Door -> Door
$csucc :: Door -> Door
Enum, Door -> Door -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Door -> Door -> Bool
$c/= :: Door -> Door -> Bool
== :: Door -> Door -> Bool
$c== :: Door -> Door -> Bool
Eq)

-- I only care about 0, but these are the observed values:
-- 0 or 1 for df
-- 0 or 2 for pf
-- 0 or 4 for dr
-- 0 or 8 for pr
-- 0 or 16 for ft
-- 0 or 32 for rt
data OpenState a = Closed a | Open a deriving (Int -> OpenState a -> String -> String
forall a. Show a => Int -> OpenState a -> String -> String
forall a. Show a => [OpenState a] -> String -> String
forall a. Show a => OpenState a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OpenState a] -> String -> String
$cshowList :: forall a. Show a => [OpenState a] -> String -> String
show :: OpenState a -> String
$cshow :: forall a. Show a => OpenState a -> String
showsPrec :: Int -> OpenState a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> OpenState a -> String -> String
Show, OpenState a -> OpenState a -> Bool
forall a. Eq a => OpenState a -> OpenState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenState a -> OpenState a -> Bool
$c/= :: forall a. Eq a => OpenState a -> OpenState a -> Bool
== :: OpenState a -> OpenState a -> Bool
$c== :: forall a. Eq a => OpenState a -> OpenState a -> Bool
Eq)

makePrisms ''OpenState

-- | Return a list of doors and their OpenState.
doors :: VehicleData -> Maybe [OpenState Door]
doors :: VehicleData -> Maybe [OpenState Door]
doors VehicleData
b = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a}. (Key, a) -> Maybe (OpenState a)
ds forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Key
"df", Key
"dr", Key
"pf", Key
"pr", Key
"ft", Key
"rt"] [forall a. Bounded a => a
minBound..]
  where
    vs :: Maybe Value
vs = VehicleData
b forall s a. s -> Getting (First a) s a -> Maybe a
^? Prism' VehicleData Value
vdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"vehicle_state"
    ds :: (Key, a) -> Maybe (OpenState a)
ds (Key
k,a
d) = forall {a} {a}. (Eq a, Num a) => a -> a -> OpenState a
c a
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
vs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Integer
_Integer
    c :: a -> a -> OpenState a
c a
d a
0 = forall a. a -> OpenState a
Closed a
d
    c a
d a
_ = forall a. a -> OpenState a
Open   a
d

-- | Return a list of open doors.
openDoors :: VehicleData -> [Door]
openDoors :: VehicleData -> [Door]
openDoors = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prism' (OpenState a) a
_Open) forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> Maybe [OpenState Door]
doors

-- | Location, Location, Location.
data Location = Location { Location -> Double
_lat :: Double, Location -> Double
_lon :: Double } deriving (Int -> Location -> String -> String
[Location] -> String -> String
Location -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Location] -> String -> String
$cshowList :: [Location] -> String -> String
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> String -> String
$cshowsPrec :: Int -> Location -> String -> String
Show, forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic)

makeLenses ''Location

instance FromJSON Location where
  parseJSON :: Value -> Parser Location
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"location" forall a b. (a -> b) -> a -> b
$ \Object
v -> Double -> Double -> Location
Location forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lat" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"long"

chargeOpts :: Data.Aeson.Options
chargeOpts :: Options
chargeOpts = Options
defaultOptions {
  fieldLabelModifier :: String -> String
fieldLabelModifier = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'_')
  }

-- | A destination charger (provided by nearbyChargers).
data DestinationCharger = DestinationCharger {
  DestinationCharger -> Location
_location       :: Location,
  DestinationCharger -> VehicleID
_name           :: Text,
  DestinationCharger -> Double
_distance_miles :: Double
  } deriving (Int -> DestinationCharger -> String -> String
[DestinationCharger] -> String -> String
DestinationCharger -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DestinationCharger] -> String -> String
$cshowList :: [DestinationCharger] -> String -> String
show :: DestinationCharger -> String
$cshow :: DestinationCharger -> String
showsPrec :: Int -> DestinationCharger -> String -> String
$cshowsPrec :: Int -> DestinationCharger -> String -> String
Show, forall x. Rep DestinationCharger x -> DestinationCharger
forall x. DestinationCharger -> Rep DestinationCharger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DestinationCharger x -> DestinationCharger
$cfrom :: forall x. DestinationCharger -> Rep DestinationCharger x
Generic)

makeFieldsNoPrefix ''DestinationCharger

instance FromJSON DestinationCharger where
  parseJSON :: Value -> Parser DestinationCharger
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
chargeOpts

-- | A supercharger (provided by nearbyChargers).
data Supercharger = Supercharger {
  Supercharger -> Location
_location         :: Location,
  Supercharger -> VehicleID
_name             :: Text,
  Supercharger -> Double
_distance_miles   :: Double,
  Supercharger -> Int
_available_stalls :: Int,
  Supercharger -> Int
_total_stalls     :: Int,
  Supercharger -> Bool
_site_closed      :: Bool
  } deriving(Int -> Supercharger -> String -> String
[Supercharger] -> String -> String
Supercharger -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Supercharger] -> String -> String
$cshowList :: [Supercharger] -> String -> String
show :: Supercharger -> String
$cshow :: Supercharger -> String
showsPrec :: Int -> Supercharger -> String -> String
$cshowsPrec :: Int -> Supercharger -> String -> String
Show, forall x. Rep Supercharger x -> Supercharger
forall x. Supercharger -> Rep Supercharger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Supercharger x -> Supercharger
$cfrom :: forall x. Supercharger -> Rep Supercharger x
Generic)

makeFieldsNoPrefix ''Supercharger

instance FromJSON Supercharger where
  parseJSON :: Value -> Parser Supercharger
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
chargeOpts

-- | Eitehr a Supercharger or Destination charger.
data Charger = SC Supercharger | DC DestinationCharger deriving(Int -> Charger -> String -> String
[Charger] -> String -> String
Charger -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Charger] -> String -> String
$cshowList :: [Charger] -> String -> String
show :: Charger -> String
$cshow :: Charger -> String
showsPrec :: Int -> Charger -> String -> String
$cshowsPrec :: Int -> Charger -> String -> String
Show)

makePrisms ''Charger

-- | Return only the superchargers from a Charger list.
superchargers :: [Charger] -> [Supercharger]
superchargers :: [Charger] -> [Supercharger]
superchargers = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Charger Supercharger
_SC)

-- | Return only the destination chargers from a Charger list.
destinationChargers :: [Charger] -> [DestinationCharger]
destinationChargers :: [Charger] -> [DestinationCharger]
destinationChargers = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Charger DestinationCharger
_DC)

-- | Get the nearby chargers.
nearbyChargers :: MonadIO m => Car m [Charger]
nearbyChargers :: forall (m :: * -> *). MonadIO m => Car m [Charger]
nearbyChargers = do
  VehicleID
v <- forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID
  Value
rb <- forall (m :: * -> *) j.
(HasTeslaAuth m, FromJSON j, MonadIO m) =>
String -> m j
jgetAuth (VehicleID -> String -> String
vehicleURL VehicleID
v String
"nearby_charging_sites")
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> (a -> Charger) -> Key -> [Charger]
parseOne Value
rb Supercharger -> Charger
SC Key
"superchargers" forall a. Semigroup a => a -> a -> a
<> forall a. FromJSON a => Value -> (a -> Charger) -> Key -> [Charger]
parseOne Value
rb DestinationCharger -> Charger
DC Key
"destination_charging"

    where
      parseOne :: FromJSON a => Value -> (a -> Charger) -> Key -> [Charger]
      parseOne :: forall a. FromJSON a => Value -> (a -> Charger) -> Key -> [Charger]
parseOne Value
rb a -> Charger
f Key
k =  let rs :: Result [a]
rs = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Result a
fromJSON (Value
rb forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall t. AsValue t => Key -> Traversal' t Value
key Key
"response" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => IndexedTraversal' Int t Value
values) in
                           a -> Charger
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Result [a]
rs of
                                   Error String
e   -> forall a. HasCallStack => String -> a
error String
e
                                   Success [a]
s -> [a]
s