{-# 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, runCar, runNamedCar,
VehicleID,
vehicleData, nearbyChargers, vehicleStatus, isAwake,
VehicleData, isUserPresent, isCharging, teslaTS, maybeTeslaTS,
Door(..), OpenState(..), _Open, _Closed, doors, openDoors,
Location(..), DestinationCharger(..), Supercharger(..), Charger(..),
superchargers, destinationChargers,
lat, lon, _SC, _DC,
vdata, name, location, distance_miles, available_stalls, total_stalls, site_closed,
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.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
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
}
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
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)
instance MonadUnliftIO m => MonadUnliftIO (Car m) where
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
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
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
type VehicleData = BL.ByteString
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])
VehicleState -> Car m VehicleState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VehicleState -> Car m VehicleState)
-> VehicleState -> Car m VehicleState
forall a b. (a -> b) -> a -> b
$ (Value
r :: Value) Value
-> Getting (Endo VehicleState) Value VehicleState -> VehicleState
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! (VehicleID -> Traversal' Value Value
forall t. AsValue t => VehicleID -> Traversal' t Value
key VehicleID
"response" ((Value -> Const (Endo VehicleState) Value)
-> Value -> Const (Endo VehicleState) Value)
-> Getting (Endo VehicleState) Value VehicleState
-> Getting (Endo 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 (Endo VehicleState) Value)
-> Value -> Const (Endo VehicleState) Value)
-> Getting (Endo VehicleState) Value VehicleState
-> Getting (Endo VehicleState) Value VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VehicleID -> Const (Endo VehicleState) VehicleID)
-> Value -> Const (Endo VehicleState) Value
forall t. AsPrimitive t => Prism' t VehicleID
_String ((VehicleID -> Const (Endo VehicleState) VehicleID)
-> Value -> Const (Endo VehicleState) Value)
-> ((VehicleState -> Const (Endo VehicleState) VehicleState)
-> VehicleID -> Const (Endo VehicleState) VehicleID)
-> Getting (Endo VehicleState) Value VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VehicleID -> VehicleState)
-> (VehicleState -> Const (Endo VehicleState) VehicleState)
-> VehicleID
-> Const (Endo VehicleState) VehicleID
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VehicleID -> VehicleState
vsFromString)
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
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
"}"
vdata :: Prism' VehicleData Value
vdata :: p Value (f Value) -> p VehicleData (f VehicleData)
vdata = (Value -> VehicleData)
-> (VehicleData -> Maybe Value)
-> Prism VehicleData VehicleData Value Value
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Value -> VehicleData
forall a. ToJSON a => a -> VehicleData
encode VehicleData -> Maybe Value
forall a. FromJSON a => VehicleData -> Maybe a
decode
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) VehicleData Bool -> VehicleData -> Maybe Bool
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Value -> Const (First Bool) Value)
-> VehicleData -> Const (First Bool) VehicleData
Prism VehicleData VehicleData Value Value
vdata ((Value -> Const (First Bool) Value)
-> VehicleData -> Const (First Bool) VehicleData)
-> ((Bool -> Const (First Bool) Bool)
-> Value -> Const (First Bool) Value)
-> Getting (First Bool) VehicleData 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)
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) VehicleData Integer
-> VehicleData -> Maybe Integer
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Value -> Const (First Integer) Value)
-> VehicleData -> Const (First Integer) VehicleData
Prism VehicleData VehicleData Value Value
vdata ((Value -> Const (First Integer) Value)
-> VehicleData -> Const (First Integer) VehicleData)
-> ((Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) VehicleData 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)
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS :: VehicleData -> Maybe UTCTime
maybeTeslaTS VehicleData
b = VehicleData
b VehicleData
-> Getting (First UTCTime) VehicleData UTCTime -> Maybe UTCTime
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Value -> Const (First UTCTime) Value)
-> VehicleData -> Const (First UTCTime) VehicleData
Prism VehicleData VehicleData Value Value
vdata ((Value -> Const (First UTCTime) Value)
-> VehicleData -> Const (First UTCTime) VehicleData)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
-> Value -> Const (First UTCTime) Value)
-> Getting (First UTCTime) VehicleData 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
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
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)
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
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
vs :: Maybe Value
vs = VehicleData
b VehicleData
-> Getting (First Value) VehicleData Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Value) VehicleData Value
Prism VehicleData VehicleData Value Value
vdata Getting (First Value) VehicleData Value
-> ((Value -> Const (First Value) Value)
-> Value -> Const (First Value) Value)
-> Getting (First Value) VehicleData 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
"vehicle_state"
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
<$> Maybe Value
vs 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
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
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
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
'_')
}
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
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
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
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)
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)
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