{-|
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
  lat, lon, _SC, _DC,
  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 Data.Foldable (fold)
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,
                                          fieldLabelModifier, fromJSON, genericParseJSON, withObject, (.:))
import           Data.Aeson.Lens         (key, values, _Bool, _Integer, _String)
import qualified Data.ByteString.Lazy    as BL
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 = [String] -> String
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 :: m VehicleID
currentVehicleID = (CarEnv -> VehicleID) -> m VehicleID
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 { Car m a -> ReaderT CarEnv m a
runCarM :: ReaderT CarEnv m a }
  deriving (Functor (Car m)
a -> Car m a
Functor (Car m)
-> (forall a. a -> Car m a)
-> (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 a b. Car m a -> Car m b -> Car m b)
-> (forall a b. Car m a -> Car m b -> Car m a)
-> Applicative (Car m)
Car m a -> Car m b -> Car m b
Car m a -> Car m b -> Car m a
Car m (a -> b) -> Car m a -> Car m b
(a -> b -> c) -> Car m a -> Car m b -> Car m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> Car m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> Car m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (Car m)
Applicative, a -> Car m b -> Car m a
(a -> b) -> Car m a -> Car m b
(forall a b. (a -> b) -> Car m a -> Car m b)
-> (forall a b. a -> Car m b -> Car m a) -> Functor (Car m)
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
<$ :: a -> Car m b -> Car m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> Car m b -> Car m a
fmap :: (a -> b) -> Car m a -> Car m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Car m a -> Car m b
Functor, Applicative (Car m)
a -> Car m a
Applicative (Car m)
-> (forall a b. Car m a -> (a -> Car m b) -> Car m b)
-> (forall a b. Car m a -> Car m b -> Car m b)
-> (forall a. a -> Car m a)
-> Monad (Car m)
Car m a -> (a -> Car m b) -> Car m b
Car m a -> Car m b -> Car m b
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 :: a -> Car m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Car m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (Car m)
Monad, Monad (Car m)
Monad (Car m) -> (forall a. IO a -> Car m a) -> MonadIO (Car m)
IO a -> Car m a
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 :: IO a -> Car m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Car m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (Car m)
MonadIO,
            MonadThrow (Car m)
MonadThrow (Car m)
-> (forall e a.
    Exception e =>
    Car m a -> (e -> Car m a) -> Car m a)
-> MonadCatch (Car m)
Car m a -> (e -> Car m a) -> Car m a
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 :: 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
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (Car m)
MonadCatch, Monad (Car m)
e -> Car m a
Monad (Car m)
-> (forall e a. Exception e => e -> Car m a) -> MonadThrow (Car m)
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 :: e -> Car m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> Car m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (Car m)
MonadThrow, MonadCatch (Car m)
MonadCatch (Car m)
-> (forall b.
    ((forall a. Car m a -> Car m a) -> Car m b) -> Car m b)
-> (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))
-> MonadMask (Car m)
Car m a
-> (a -> ExitCase b -> Car m c) -> (a -> Car m b) -> Car m (b, c)
((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
((forall a. Car m a -> Car m a) -> Car m b) -> Car m b
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 :: * -> *).
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
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)
generalBracket :: 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 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 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
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (Car m)
MonadMask, MonadReader CarEnv,
            Monad (Car m)
Monad (Car m) -> (forall a. String -> Car m a) -> MonadFail (Car m)
String -> Car m a
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 :: String -> Car m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> Car m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (Car m)
MonadFail, Monad (Car m)
Monad (Car m)
-> (forall msg.
    ToLogStr msg =>
    Loc -> VehicleID -> LogLevel -> msg -> Car m ())
-> MonadLogger (Car m)
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
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 :: Loc -> VehicleID -> LogLevel -> msg -> Car m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> VehicleID -> LogLevel -> msg -> Car m ()
$cp1MonadLogger :: forall (m :: * -> *). MonadLogger m => Monad (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 a. Car m a -> IO a) -> IO b) -> Car m b
withRunInIO (forall a. Car m a -> IO a) -> IO b
inner = ReaderT CarEnv m b -> Car m b
forall (m :: * -> *) a. ReaderT CarEnv m a -> Car m a
Car (ReaderT CarEnv m b -> Car m b) -> ReaderT CarEnv m b -> Car m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT CarEnv m a -> IO a) -> IO b)
-> ReaderT CarEnv m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT CarEnv m a -> IO a) -> IO b)
 -> ReaderT CarEnv m b)
-> ((forall a. ReaderT CarEnv m a -> IO a) -> IO b)
-> ReaderT CarEnv m b
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 (ReaderT CarEnv m a -> IO a
forall a. ReaderT CarEnv m a -> IO a
run (ReaderT CarEnv m a -> IO a)
-> (Car m a -> ReaderT CarEnv m a) -> Car m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Car m a -> ReaderT CarEnv m a
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 = IO AuthInfo -> m AuthInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AuthInfo -> m AuthInfo) -> m (IO AuthInfo) -> m AuthInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (CarEnv -> IO AuthInfo) -> m (IO AuthInfo)
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 :: IO AuthInfo -> VehicleID -> Car m a -> m a
runCar IO AuthInfo
ai VehicleID
vi Car m a
f = ReaderT CarEnv m a -> CarEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Car m a -> ReaderT CarEnv m a
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
(BadCarException -> BadCarException -> Bool)
-> (BadCarException -> BadCarException -> Bool)
-> Eq BadCarException
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: " String -> String -> String
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 :: VehicleID -> IO AuthInfo -> Car m a -> m a
runNamedCar VehicleID
name IO AuthInfo
ai Car m a
f = do
  AuthInfo
a <- IO AuthInfo -> m AuthInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AuthInfo
ai
  Map VehicleID VehicleID
vs <- [Product] -> Map VehicleID VehicleID
vehicles ([Product] -> Map VehicleID VehicleID)
-> m [Product] -> m (Map VehicleID VehicleID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AuthInfo -> m [Product]
forall (m :: * -> *). MonadIO m => AuthInfo -> m [Product]
products AuthInfo
a
  VehicleID
c <- case VehicleID -> Map VehicleID VehicleID -> Maybe VehicleID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VehicleID
name Map VehicleID VehicleID
vs of
         Maybe VehicleID
Nothing -> String -> m VehicleID
forall a. String -> m a
throw (String -> m VehicleID) -> String -> m VehicleID
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [VehicleID -> String
forall a. Show a => a -> String
show VehicleID
name, String
" is not a valid vehicle name.  Try one of: ",
                                     [VehicleID] -> String
forall a. Show a => a -> String
show ([VehicleID] -> String) -> [VehicleID] -> String
forall a b. (a -> b) -> a -> b
$ Map VehicleID VehicleID -> [VehicleID]
forall k a. Map k a -> [k]
Map.keys Map VehicleID VehicleID
vs]
         Just VehicleID
c -> VehicleID -> m VehicleID
forall (f :: * -> *) a. Applicative f => a -> f a
pure VehicleID
c
  IO AuthInfo -> VehicleID -> Car m a -> m a
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 = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (String -> IO a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadCarException -> IO a
forall e a. Exception e => e -> IO a
throwIO (BadCarException -> IO a)
-> (String -> BadCarException) -> String -> IO a
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 :: Car m VehicleState
vehicleStatus = do
  VehicleID
v <- Car m VehicleID
forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID
  Value
r <- String -> Car m Value
forall (m :: * -> *) j.
(HasTeslaAuth m, FromJSON j, MonadIO m) =>
String -> m j
jgetAuth ([String] -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [String
baseURL, String
"api/1/vehicles/", VehicleID -> String
unpack VehicleID
v])
  let (Just VehicleState
x) = (Value
r :: Value) Value
-> Getting (First VehicleState) Value VehicleState
-> Maybe VehicleState
forall s a. s -> Getting (First a) s a -> Maybe a
^? (VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"response" ((Value -> Const (First VehicleState) Value)
 -> Value -> Const (First VehicleState) Value)
-> Getting (First VehicleState) Value VehicleState
-> Getting (First VehicleState) Value VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"state" ((Value -> Const (First VehicleState) Value)
 -> Value -> Const (First VehicleState) Value)
-> Getting (First VehicleState) Value VehicleState
-> Getting (First VehicleState) Value VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VehicleID -> Const (First VehicleState) VehicleID)
-> Value -> Const (First VehicleState) Value
forall t. AsPrimitive t => Prism' t VehicleID
_String ((VehicleID -> Const (First VehicleState) VehicleID)
 -> Value -> Const (First VehicleState) Value)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
    -> VehicleID -> Const (First VehicleState) VehicleID)
-> Getting (First VehicleState) Value VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VehicleID -> VehicleState)
-> (VehicleState -> Const (First VehicleState) VehicleState)
-> VehicleID
-> Const (First VehicleState) VehicleID
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VehicleID -> VehicleState
vsFromString)
  VehicleState -> Car m VehicleState
forall (f :: * -> *) a. Applicative f => a -> f a
pure VehicleState
x

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

-- | Fetch the VehicleData.
vehicleData :: MonadIO m => Car m VehicleData
vehicleData :: Car m VehicleData
vehicleData = do
  AuthInfo
a <- Car m AuthInfo
forall (m :: * -> *). HasTeslaAuth m => m AuthInfo
teslaAuth
  VehicleID
v <- Car m VehicleID
forall (m :: * -> *). MonadReader CarEnv m => m VehicleID
currentVehicleID
  Response VehicleData
r <- IO (Response VehicleData) -> Car m (Response VehicleData)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response VehicleData) -> Car m (Response VehicleData))
-> IO (Response VehicleData) -> Car m (Response VehicleData)
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")
  VehicleData -> Car m VehicleData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VehicleData -> Car m VehicleData)
-> (VehicleData -> VehicleData) -> VehicleData -> Car m VehicleData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe VehicleData -> VehicleData
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe VehicleData -> VehicleData)
-> (VehicleData -> Maybe VehicleData) -> VehicleData -> VehicleData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> Maybe VehicleData
inner (VehicleData -> Car m VehicleData)
-> VehicleData -> Car m VehicleData
forall a b. (a -> b) -> a -> b
$ Response VehicleData
r Response VehicleData
-> Getting VehicleData (Response VehicleData) VehicleData
-> VehicleData
forall s a. s -> Getting a s a -> a
^. Getting VehicleData (Response VehicleData) VehicleData
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\":" (VehicleData -> Maybe VehicleData)
-> (VehicleData -> Maybe VehicleData)
-> VehicleData
-> Maybe VehicleData
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< VehicleData -> VehicleData -> Maybe VehicleData
BL.stripSuffix VehicleData
"}"

-- | Get an Aeson Value from this VehicleData.
maybeVal :: VehicleData -> Maybe Value
maybeVal :: VehicleData -> Maybe Value
maybeVal = VehicleData -> Maybe Value
forall a. FromJSON a => VehicleData -> Maybe a
decode

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

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

-- | Get the timestamp from this VehicleData if present.
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS VehicleData
b = VehicleData -> Maybe Value
maybeVal VehicleData
b Maybe Value
-> Getting (First UTCTime) (Maybe Value) UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Value -> Const (First UTCTime) Value)
-> Maybe Value -> Const (First UTCTime) (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const (First UTCTime) Value)
 -> Maybe Value -> Const (First UTCTime) (Maybe Value))
-> ((UTCTime -> Const (First UTCTime) UTCTime)
    -> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) (Maybe Value) UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"vehicle_state" ((Value -> Const (First UTCTime) Value)
 -> Value -> Const (First UTCTime) Value)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
    -> Value -> Const (First UTCTime) Value)
-> (UTCTime -> Const (First UTCTime) UTCTime)
-> Value
-> Const (First UTCTime) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"timestamp" ((Value -> Const (First UTCTime) Value)
 -> Value -> Const (First UTCTime) Value)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
    -> Value -> Const (First UTCTime) Value)
-> (UTCTime -> Const (First UTCTime) UTCTime)
-> Value
-> Const (First UTCTime) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const (First UTCTime) Integer)
-> Value -> Const (First UTCTime) Value
forall t. AsNumber t => Prism' t Integer
_Integer ((Integer -> Const (First UTCTime) Integer)
 -> Value -> Const (First UTCTime) Value)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
    -> Integer -> Const (First UTCTime) Integer)
-> (UTCTime -> Const (First UTCTime) UTCTime)
-> Value
-> Const (First UTCTime) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> UTCTime)
-> (UTCTime -> Const (First UTCTime) UTCTime)
-> Integer
-> Const (First UTCTime) Integer
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 (POSIXTime -> UTCTime)
-> (Rational -> POSIXTime) -> Rational -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> UTCTime) -> Rational -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Rational
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 = UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (String -> UTCTime
forall a. HasCallStack => String -> a
error (String -> UTCTime)
-> (VehicleData -> String) -> VehicleData -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> String
forall a. Show a => a -> String
show (VehicleData -> UTCTime) -> VehicleData -> UTCTime
forall a b. (a -> b) -> a -> b
$ VehicleData
b) (Maybe UTCTime -> UTCTime)
-> (VehicleData -> Maybe UTCTime) -> VehicleData -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleData -> Maybe UTCTime
maybeTeslaTS (VehicleData -> UTCTime) -> VehicleData -> UTCTime
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
(Int -> Door -> String -> String)
-> (Door -> String) -> ([Door] -> String -> String) -> Show Door
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
Door -> Door -> Bounded 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]
(Door -> Door)
-> (Door -> Door)
-> (Int -> Door)
-> (Door -> Int)
-> (Door -> [Door])
-> (Door -> Door -> [Door])
-> (Door -> Door -> [Door])
-> (Door -> Door -> Door -> [Door])
-> Enum 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
(Door -> Door -> Bool) -> (Door -> Door -> Bool) -> Eq Door
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
[OpenState a] -> String -> String
OpenState a -> String
(Int -> OpenState a -> String -> String)
-> (OpenState a -> String)
-> ([OpenState a] -> String -> String)
-> Show (OpenState a)
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
(OpenState a -> OpenState a -> Bool)
-> (OpenState a -> OpenState a -> Bool) -> Eq (OpenState a)
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 = ((VehicleID, Door) -> Maybe (OpenState Door))
-> [(VehicleID, Door)] -> Maybe [OpenState Door]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VehicleID, Door) -> Maybe (OpenState Door)
forall a. (VehicleID, a) -> Maybe (OpenState a)
ds ([(VehicleID, Door)] -> Maybe [OpenState Door])
-> [(VehicleID, Door)] -> Maybe [OpenState Door]
forall a b. (a -> b) -> a -> b
$ [VehicleID] -> [Door] -> [(VehicleID, Door)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VehicleID
"df", VehicleID
"dr", VehicleID
"pf", VehicleID
"pr", VehicleID
"ft", VehicleID
"rt"] [Door
forall a. Bounded a => a
minBound..]
  where
    ds :: (VehicleID, a) -> Maybe (OpenState a)
ds (VehicleID
k,a
d) = a -> Integer -> OpenState a
forall a a. (Eq a, Num a) => a -> a -> OpenState a
c a
d (Integer -> OpenState a) -> Maybe Integer -> Maybe (OpenState a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VehicleData -> Maybe Value
maybeVal VehicleData
b Maybe Value
-> Getting (First Integer) (Maybe Value) Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Value -> Const (First Integer) Value)
-> Maybe Value -> Const (First Integer) (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const (First Integer) Value)
 -> Maybe Value -> Const (First Integer) (Maybe Value))
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> Getting (First Integer) (Maybe Value) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"vehicle_state" ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
k ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
    -> Value -> Const (First Integer) Value)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value
forall t. AsNumber t => Prism' t Integer
_Integer
    c :: a -> a -> OpenState a
c a
d a
0 = a -> OpenState a
forall a. a -> OpenState a
Closed a
d
    c a
d a
_ = a -> OpenState a
forall a. a -> OpenState a
Open   a
d

-- | Return a list of open doors.
openDoors :: VehicleData -> [Door]
openDoors :: VehicleData -> [Door]
openDoors = Getting (Endo [Door]) (Maybe [OpenState Door]) Door
-> Maybe [OpenState Door] -> [Door]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (([OpenState Door] -> Const (Endo [Door]) [OpenState Door])
-> Maybe [OpenState Door]
-> Const (Endo [Door]) (Maybe [OpenState Door])
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (([OpenState Door] -> Const (Endo [Door]) [OpenState Door])
 -> Maybe [OpenState Door]
 -> Const (Endo [Door]) (Maybe [OpenState Door]))
-> ((Door -> Const (Endo [Door]) Door)
    -> [OpenState Door] -> Const (Endo [Door]) [OpenState Door])
-> Getting (Endo [Door]) (Maybe [OpenState Door]) Door
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OpenState Door -> Const (Endo [Door]) (OpenState Door))
-> [OpenState Door] -> Const (Endo [Door]) [OpenState Door]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((OpenState Door -> Const (Endo [Door]) (OpenState Door))
 -> [OpenState Door] -> Const (Endo [Door]) [OpenState Door])
-> ((Door -> Const (Endo [Door]) Door)
    -> OpenState Door -> Const (Endo [Door]) (OpenState Door))
-> (Door -> Const (Endo [Door]) Door)
-> [OpenState Door]
-> Const (Endo [Door]) [OpenState Door]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Door -> Const (Endo [Door]) Door)
-> OpenState Door -> Const (Endo [Door]) (OpenState Door)
forall a. Prism' (OpenState a) a
_Open) (Maybe [OpenState Door] -> [Door])
-> (VehicleData -> Maybe [OpenState Door]) -> VehicleData -> [Door]
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
(Int -> Location -> String -> String)
-> (Location -> String)
-> ([Location] -> String -> String)
-> Show Location
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. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
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 = String -> (Object -> Parser Location) -> Value -> Parser Location
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"location" ((Object -> Parser Location) -> Value -> Parser Location)
-> (Object -> Parser Location) -> Value -> Parser Location
forall a b. (a -> b) -> a -> b
$ \Object
v -> Double -> Double -> Location
Location (Double -> Double -> Location)
-> Parser Double -> Parser (Double -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> VehicleID -> Parser Double
forall a. FromJSON a => Object -> VehicleID -> Parser a
.: VehicleID
"lat" Parser (Double -> Location) -> Parser Double -> Parser Location
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> VehicleID -> Parser Double
forall a. FromJSON a => Object -> VehicleID -> Parser a
.: VehicleID
"long"

chargeOpts :: Data.Aeson.Options
chargeOpts :: Options
chargeOpts = Options
defaultOptions {
  fieldLabelModifier :: String -> String
fieldLabelModifier = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
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
(Int -> DestinationCharger -> String -> String)
-> (DestinationCharger -> String)
-> ([DestinationCharger] -> String -> String)
-> Show DestinationCharger
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. DestinationCharger -> Rep DestinationCharger x)
-> (forall x. Rep DestinationCharger x -> DestinationCharger)
-> Generic DestinationCharger
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 = Options -> Value -> Parser DestinationCharger
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
(Int -> Supercharger -> String -> String)
-> (Supercharger -> String)
-> ([Supercharger] -> String -> String)
-> Show Supercharger
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. Supercharger -> Rep Supercharger x)
-> (forall x. Rep Supercharger x -> Supercharger)
-> Generic Supercharger
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 = Options -> Value -> Parser Supercharger
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
(Int -> Charger -> String -> String)
-> (Charger -> String)
-> ([Charger] -> String -> String)
-> Show Charger
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 = Getting (Endo [Supercharger]) [Charger] Supercharger
-> [Charger] -> [Supercharger]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Charger -> Const (Endo [Supercharger]) Charger)
-> [Charger] -> Const (Endo [Supercharger]) [Charger]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((Charger -> Const (Endo [Supercharger]) Charger)
 -> [Charger] -> Const (Endo [Supercharger]) [Charger])
-> ((Supercharger -> Const (Endo [Supercharger]) Supercharger)
    -> Charger -> Const (Endo [Supercharger]) Charger)
-> Getting (Endo [Supercharger]) [Charger] Supercharger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Supercharger -> Const (Endo [Supercharger]) Supercharger)
-> Charger -> Const (Endo [Supercharger]) Charger
Prism' Charger Supercharger
_SC)

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

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

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