{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Tesla
( authenticate, refreshAuth, AuthResponse(..),
Product(..), vehicleName, vehicleID, vehicleState,
energyID, _ProductVehicle, _ProductEnergy, _ProductPowerwall,
pwBatteryPower, pwCharged, pwEnergyLeft, pwID, pwName, pwTotal,
VehicleID, vehicles, products, productsRaw,
VehicleState(..), vsFromString,
EnergyID, energyIDs,
fromToken, authOpts, baseURL,
decodeProducts
) where
import Control.Lens
import Control.Monad.IO.Class (MonadIO (..))
import Data.Aeson (FromJSON, Value (..), encode)
import Data.Aeson.Lens (_Array, _Double, _Integer, _String, key)
import Data.Foldable (asum)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Network.Wreq (Options, defaults, header)
import Tesla.Auth
import Tesla.Internal.HTTP
baseURL :: String
baseURL :: String
baseURL = String
"https://owner-api.teslamotors.com/"
authRefreshURL :: String
authRefreshURL :: String
authRefreshURL = String
"https://auth.tesla.com/oauth2/v3/token"
productsURL :: String
productsURL :: String
productsURL = String
baseURL String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"api/1/products"
{-# DEPRECATED authenticate "Tesla busted authentication pretty hard. See https://github.com/dustin/tesla for more info." #-}
authenticate :: AuthInfo -> IO AuthResponse
authenticate :: AuthInfo -> IO AuthResponse
authenticate AuthInfo
_ = String -> IO AuthResponse
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Tesla busted authentication pretty hard. See https://github.com/dustin/tesla for more info."
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth :: AuthResponse -> IO AuthResponse
refreshAuth AuthResponse{Int
String
_access_token :: String
_expires_in :: Int
_refresh_token :: String
_access_token :: AuthResponse -> String
_expires_in :: AuthResponse -> Int
_refresh_token :: AuthResponse -> String
..} = do
Options -> String -> ByteString -> IO AuthResponse
forall j a (m :: * -> *).
(FromJSON j, Postable a, MonadIO m) =>
Options -> String -> a -> m j
jpostWith Options
jOpts String
authRefreshURL (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object
forall a. Monoid a => a
mempty
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index Object
"grant_type" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"refresh_token"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index Object
"client_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"ownerapi"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index Object
"refresh_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (String -> Text
T.pack String
_refresh_token)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index Object
"scope" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
"openid email offline_access"
))
jOpts :: Options
jOpts :: Options
jOpts = Options
aOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"content-type" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/json"]
aOpts :: Options
aOpts :: Options
aOpts = Options
defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"*/*"]
type VehicleID = Text
type EnergyID = Integer
data VehicleState = VOnline | VOffline | VAsleep | VWaking | VUnknown
deriving (Int -> VehicleState -> String -> String
[VehicleState] -> String -> String
VehicleState -> String
(Int -> VehicleState -> String -> String)
-> (VehicleState -> String)
-> ([VehicleState] -> String -> String)
-> Show VehicleState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> VehicleState -> String -> String
showsPrec :: Int -> VehicleState -> String -> String
$cshow :: VehicleState -> String
show :: VehicleState -> String
$cshowList :: [VehicleState] -> String -> String
showList :: [VehicleState] -> String -> String
Show, ReadPrec [VehicleState]
ReadPrec VehicleState
Int -> ReadS VehicleState
ReadS [VehicleState]
(Int -> ReadS VehicleState)
-> ReadS [VehicleState]
-> ReadPrec VehicleState
-> ReadPrec [VehicleState]
-> Read VehicleState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VehicleState
readsPrec :: Int -> ReadS VehicleState
$creadList :: ReadS [VehicleState]
readList :: ReadS [VehicleState]
$creadPrec :: ReadPrec VehicleState
readPrec :: ReadPrec VehicleState
$creadListPrec :: ReadPrec [VehicleState]
readListPrec :: ReadPrec [VehicleState]
Read, VehicleState -> VehicleState -> Bool
(VehicleState -> VehicleState -> Bool)
-> (VehicleState -> VehicleState -> Bool) -> Eq VehicleState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VehicleState -> VehicleState -> Bool
== :: VehicleState -> VehicleState -> Bool
$c/= :: VehicleState -> VehicleState -> Bool
/= :: VehicleState -> VehicleState -> Bool
Eq)
vsFromString :: Text -> VehicleState
vsFromString :: Text -> VehicleState
vsFromString Text
"online" = VehicleState
VOnline
vsFromString Text
"offline" = VehicleState
VOffline
vsFromString Text
"asleep" = VehicleState
VAsleep
vsFromString Text
"waking" = VehicleState
VWaking
vsFromString Text
_ = VehicleState
VUnknown
data Product = ProductVehicle { Product -> Text
_vehicleName :: Text, Product -> Text
_vehicleID :: VehicleID, Product -> VehicleState
_vehicleState :: VehicleState }
| ProductEnergy { Product -> EnergyID
_energyID :: EnergyID }
| ProductPowerwall { Product -> EnergyID
_pwID :: EnergyID
, Product -> Double
_pwBatteryPower :: Double
, Product -> Double
_pwEnergyLeft :: Double
, Product -> Double
_pwCharged :: Double
, Product -> Text
_pwName :: Text
, Product -> Double
_pwTotal :: Double }
deriving (Int -> Product -> String -> String
[Product] -> String -> String
Product -> String
(Int -> Product -> String -> String)
-> (Product -> String)
-> ([Product] -> String -> String)
-> Show Product
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Product -> String -> String
showsPrec :: Int -> Product -> String -> String
$cshow :: Product -> String
show :: Product -> String
$cshowList :: [Product] -> String -> String
showList :: [Product] -> String -> String
Show, ReadPrec [Product]
ReadPrec Product
Int -> ReadS Product
ReadS [Product]
(Int -> ReadS Product)
-> ReadS [Product]
-> ReadPrec Product
-> ReadPrec [Product]
-> Read Product
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Product
readsPrec :: Int -> ReadS Product
$creadList :: ReadS [Product]
readList :: ReadS [Product]
$creadPrec :: ReadPrec Product
readPrec :: ReadPrec Product
$creadListPrec :: ReadPrec [Product]
readListPrec :: ReadPrec [Product]
Read, Product -> Product -> Bool
(Product -> Product -> Bool)
-> (Product -> Product -> Bool) -> Eq Product
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
/= :: Product -> Product -> Bool
Eq)
makePrisms ''Product
makeLenses ''Product
decodeProducts :: Value -> [Product]
decodeProducts :: Value -> [Product]
decodeProducts = [Maybe Product] -> [Product]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Product] -> [Product])
-> (Value -> [Maybe Product]) -> Value -> [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Maybe Product]) Value (Maybe Product)
-> Value -> [Maybe Product]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"response" ((Value -> Const (Endo [Maybe Product]) Value)
-> Value -> Const (Endo [Maybe Product]) Value)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Value -> Const (Endo [Maybe Product]) Value
forall t. AsValue t => Prism' t (Vector Value)
Prism' Value (Vector Value)
_Array ((Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Value -> Const (Endo [Maybe Product]) Value)
-> ((Maybe Product -> Const (Endo [Maybe Product]) (Maybe Product))
-> Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Maybe Product]) Value)
-> Vector Value -> Const (Endo [Maybe Product]) (Vector Value)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Vector Value) Value
folded ((Value -> Const (Endo [Maybe Product]) Value)
-> Vector Value -> Const (Endo [Maybe Product]) (Vector Value))
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
-> (Maybe Product -> Const (Endo [Maybe Product]) (Maybe Product))
-> Vector Value
-> Const (Endo [Maybe Product]) (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Product)
-> Getting (Endo [Maybe Product]) Value (Maybe Product)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Value -> Maybe Product
forall {p}. AsValue p => p -> Maybe Product
prod)
where
prod :: p -> Maybe Product
prod p
o = [Maybe Product] -> Maybe Product
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Maybe Product
prodCar, Maybe Product
prodPowerwall, Maybe Product
prodSolar, Maybe Product
forall a. Maybe a
Nothing ]
where
prodCar :: Maybe Product
prodCar = Text -> Text -> VehicleState -> Product
ProductVehicle
(Text -> Text -> VehicleState -> Product)
-> Maybe Text -> Maybe (Text -> VehicleState -> Product)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"display_name" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
Maybe (Text -> VehicleState -> Product)
-> Maybe Text -> Maybe (VehicleState -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"id_s" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
Maybe (VehicleState -> Product)
-> Maybe VehicleState -> Maybe Product
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p
-> Getting (First VehicleState) p VehicleState
-> Maybe VehicleState
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"state" ((Value -> Const (First VehicleState) Value)
-> p -> Const (First VehicleState) p)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
-> Value -> Const (First VehicleState) Value)
-> Getting (First VehicleState) p VehicleState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First VehicleState) Text)
-> Value -> Const (First VehicleState) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String ((Text -> Const (First VehicleState) Text)
-> Value -> Const (First VehicleState) Value)
-> ((VehicleState -> Const (First VehicleState) VehicleState)
-> Text -> Const (First VehicleState) Text)
-> (VehicleState -> Const (First VehicleState) VehicleState)
-> Value
-> Const (First VehicleState) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> VehicleState)
-> (VehicleState -> Const (First VehicleState) VehicleState)
-> Text
-> Const (First VehicleState) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> VehicleState
vsFromString)
prodPowerwall :: Maybe Product
prodPowerwall = EnergyID -> Double -> Double -> Double -> Text -> Double -> Product
ProductPowerwall
(EnergyID
-> Double -> Double -> Double -> Text -> Double -> Product)
-> Maybe EnergyID
-> Maybe (Double -> Double -> Double -> Text -> Double -> Product)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o p -> Getting (First EnergyID) p EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" ((Value -> Const (First EnergyID) Value)
-> p -> Const (First EnergyID) p)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) p EnergyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value
forall t. AsNumber t => Prism' t EnergyID
Prism' Value EnergyID
_Integer)
Maybe (Double -> Double -> Double -> Text -> Double -> Product)
-> Maybe Double
-> Maybe (Double -> Double -> Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"battery_power" ((Value -> Const (First Double) Value)
-> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value)
-> Getting (First Double) p Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
Prism' Value Double
_Double)
Maybe (Double -> Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Double -> Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_left" ((Value -> Const (First Double) Value)
-> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value)
-> Getting (First Double) p Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
Prism' Value Double
_Double)
Maybe (Double -> Text -> Double -> Product)
-> Maybe Double -> Maybe (Text -> Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"percentage_charged" ((Value -> Const (First Double) Value)
-> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value)
-> Getting (First Double) p Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
Prism' Value Double
_Double)
Maybe (Text -> Double -> Product)
-> Maybe Text -> Maybe (Double -> Product)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Text) p Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"site_name" ((Value -> Const (First Text) Value) -> p -> Const (First Text) p)
-> ((Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value)
-> Getting (First Text) p Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
Maybe (Double -> Product) -> Maybe Double -> Maybe Product
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (p
o p -> Getting (First Double) p Double -> Maybe Double
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"total_pack_energy" ((Value -> Const (First Double) Value)
-> p -> Const (First Double) p)
-> ((Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value)
-> Getting (First Double) p Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const (First Double) Double)
-> Value -> Const (First Double) Value
forall t. AsNumber t => Prism' t Double
Prism' Value Double
_Double)
prodSolar :: Maybe Product
prodSolar = EnergyID -> Product
ProductEnergy (EnergyID -> Product) -> Maybe EnergyID -> Maybe Product
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p
o p -> Getting (First EnergyID) p EnergyID -> Maybe EnergyID
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' p Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"energy_site_id" ((Value -> Const (First EnergyID) Value)
-> p -> Const (First EnergyID) p)
-> ((EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value)
-> Getting (First EnergyID) p EnergyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnergyID -> Const (First EnergyID) EnergyID)
-> Value -> Const (First EnergyID) Value
forall t. AsNumber t => Prism' t EnergyID
Prism' Value EnergyID
_Integer)
productsRaw :: (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw :: forall j (m :: * -> *). (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw AuthInfo
ai = Options -> String -> m j
forall j (m :: * -> *).
(FromJSON j, MonadIO m) =>
Options -> String -> m j
jgetWith (AuthInfo -> Options
authOpts AuthInfo
ai) String
productsURL
products :: MonadIO m => AuthInfo -> m [Product]
products :: forall (m :: * -> *). MonadIO m => AuthInfo -> m [Product]
products = (Value -> [Product]) -> m Value -> m [Product]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> [Product]
decodeProducts (m Value -> m [Product])
-> (AuthInfo -> m Value) -> AuthInfo -> m [Product]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthInfo -> m Value
forall j (m :: * -> *). (FromJSON j, MonadIO m) => AuthInfo -> m j
productsRaw
vehicles :: [Product] -> Map Text Text
vehicles :: [Product] -> Map Text Text
vehicles = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> ([Product] -> [(Text, Text)]) -> [Product] -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text, VehicleState) -> (Text, Text))
-> [(Text, Text, VehicleState)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
a,Text
b,VehicleState
_) -> (Text
a,Text
b)) ([(Text, Text, VehicleState)] -> [(Text, Text)])
-> ([Product] -> [(Text, Text, VehicleState)])
-> [Product]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(Endo [(Text, Text, VehicleState)])
[Product]
(Text, Text, VehicleState)
-> [Product] -> [(Text, Text, VehicleState)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
-> [Product] -> Const (Endo [(Text, Text, VehicleState)]) [Product]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Product] Product
folded ((Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
-> [Product]
-> Const (Endo [(Text, Text, VehicleState)]) [Product])
-> (((Text, Text, VehicleState)
-> Const
(Endo [(Text, Text, VehicleState)]) (Text, Text, VehicleState))
-> Product -> Const (Endo [(Text, Text, VehicleState)]) Product)
-> Getting
(Endo [(Text, Text, VehicleState)])
[Product]
(Text, Text, VehicleState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text, VehicleState)
-> Const
(Endo [(Text, Text, VehicleState)]) (Text, Text, VehicleState))
-> Product -> Const (Endo [(Text, Text, VehicleState)]) Product
Prism' Product (Text, Text, VehicleState)
_ProductVehicle)
energyIDs :: [Product] -> [EnergyID]
energyIDs :: [Product] -> [EnergyID]
energyIDs = Getting (Endo [EnergyID]) [Product] EnergyID
-> [Product] -> [EnergyID]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Product -> Const (Endo [EnergyID]) Product)
-> [Product] -> Const (Endo [EnergyID]) [Product]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Product] Product
folded ((Product -> Const (Endo [EnergyID]) Product)
-> [Product] -> Const (Endo [EnergyID]) [Product])
-> ((EnergyID -> Const (Endo [EnergyID]) EnergyID)
-> Product -> Const (Endo [EnergyID]) Product)
-> Getting (Endo [EnergyID]) [Product] EnergyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnergyID -> Const (Endo [EnergyID]) EnergyID)
-> Product -> Const (Endo [EnergyID]) Product
Traversal' Product EnergyID
energyID)