{-# LANGUAGE UndecidableInstances #-}
module Lifx.Lan.Internal where
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Data.Binary.Get
import Data.List
import Data.Tuple.Extra
import Data.Word
import Network.Socket
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import GHC.Generics (Generic)
import Lifx.Internal.ProductInfoMap (ProductLookupError)
newtype Device = Device {Device -> HostAddress
unwrap :: HostAddress}
deriving newtype (Device -> Device -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq, Eq Device
Device -> Device -> Bool
Device -> Device -> Ordering
Device -> Device -> Device
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Device -> Device -> Device
$cmin :: Device -> Device -> Device
max :: Device -> Device -> Device
$cmax :: Device -> Device -> Device
>= :: Device -> Device -> Bool
$c>= :: Device -> Device -> Bool
> :: Device -> Device -> Bool
$c> :: Device -> Device -> Bool
<= :: Device -> Device -> Bool
$c<= :: Device -> Device -> Bool
< :: Device -> Device -> Bool
$c< :: Device -> Device -> Bool
compare :: Device -> Device -> Ordering
$ccompare :: Device -> Device -> Ordering
Ord)
instance Show Device where
show :: Device -> String
show (Device HostAddress
ha) = let (Word8
a, Word8
b, Word8
c, Word8
d) = HostAddress -> (Word8, Word8, Word8, Word8)
hostAddressToTuple HostAddress
ha in forall a. [a] -> [[a]] -> [a]
intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Word8
a, Word8
b, Word8
c, Word8
d]
data HSBK = HSBK
{ HSBK -> Word16
hue :: Word16
, HSBK -> Word16
saturation :: Word16
, HSBK -> Word16
brightness :: Word16
, HSBK -> Word16
kelvin :: Word16
}
deriving (HSBK -> HSBK -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HSBK -> HSBK -> Bool
$c/= :: HSBK -> HSBK -> Bool
== :: HSBK -> HSBK -> Bool
$c== :: HSBK -> HSBK -> Bool
Eq, Eq HSBK
HSBK -> HSBK -> Bool
HSBK -> HSBK -> Ordering
HSBK -> HSBK -> HSBK
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HSBK -> HSBK -> HSBK
$cmin :: HSBK -> HSBK -> HSBK
max :: HSBK -> HSBK -> HSBK
$cmax :: HSBK -> HSBK -> HSBK
>= :: HSBK -> HSBK -> Bool
$c>= :: HSBK -> HSBK -> Bool
> :: HSBK -> HSBK -> Bool
$c> :: HSBK -> HSBK -> Bool
<= :: HSBK -> HSBK -> Bool
$c<= :: HSBK -> HSBK -> Bool
< :: HSBK -> HSBK -> Bool
$c< :: HSBK -> HSBK -> Bool
compare :: HSBK -> HSBK -> Ordering
$ccompare :: HSBK -> HSBK -> Ordering
Ord, Int -> HSBK -> ShowS
[HSBK] -> ShowS
HSBK -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HSBK] -> ShowS
$cshowList :: [HSBK] -> ShowS
show :: HSBK -> String
$cshow :: HSBK -> String
showsPrec :: Int -> HSBK -> ShowS
$cshowsPrec :: Int -> HSBK -> ShowS
Show, forall x. Rep HSBK x -> HSBK
forall x. HSBK -> Rep HSBK x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HSBK x -> HSBK
$cfrom :: forall x. HSBK -> Rep HSBK x
Generic)
data LifxError
= DecodeFailure BS.ByteString ByteOffset String
| RecvTimeout
| BroadcastTimeout [HostAddress]
| WrongPacketType Word16 Word16
| WrongSender Device HostAddress
| UnexpectedSockAddrType SockAddr
| UnexpectedPort PortNumber
| ProductLookupError ProductLookupError
deriving (LifxError -> LifxError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LifxError -> LifxError -> Bool
$c/= :: LifxError -> LifxError -> Bool
== :: LifxError -> LifxError -> Bool
$c== :: LifxError -> LifxError -> Bool
Eq, Eq LifxError
LifxError -> LifxError -> Bool
LifxError -> LifxError -> Ordering
LifxError -> LifxError -> LifxError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LifxError -> LifxError -> LifxError
$cmin :: LifxError -> LifxError -> LifxError
max :: LifxError -> LifxError -> LifxError
$cmax :: LifxError -> LifxError -> LifxError
>= :: LifxError -> LifxError -> Bool
$c>= :: LifxError -> LifxError -> Bool
> :: LifxError -> LifxError -> Bool
$c> :: LifxError -> LifxError -> Bool
<= :: LifxError -> LifxError -> Bool
$c<= :: LifxError -> LifxError -> Bool
< :: LifxError -> LifxError -> Bool
$c< :: LifxError -> LifxError -> Bool
compare :: LifxError -> LifxError -> Ordering
$ccompare :: LifxError -> LifxError -> Ordering
Ord, Int -> LifxError -> ShowS
[LifxError] -> ShowS
LifxError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifxError] -> ShowS
$cshowList :: [LifxError] -> ShowS
show :: LifxError -> String
$cshow :: LifxError -> String
showsPrec :: Int -> LifxError -> ShowS
$cshowsPrec :: Int -> LifxError -> ShowS
Show, forall x. Rep LifxError x -> LifxError
forall x. LifxError -> Rep LifxError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LifxError x -> LifxError
$cfrom :: forall x. LifxError -> Rep LifxError x
Generic)
class MonadIO m => MonadLifxIO m where
getSocket :: m Socket
getSource :: m Word32
getTimeout :: m Int
incrementCounter :: m ()
getCounter :: m Word8
lifxThrowIO :: LifxError -> m a
handleOldMessage ::
Word8 ->
Word8 ->
Word16 ->
BL.ByteString ->
m ()
handleOldMessage Word8
_ Word8
_ Word16
_ ByteString
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance MonadIO m => MonadLifxIO (LifxT m) where
getSocket :: LifxT m Socket
getSocket = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b c. (a, b, c) -> a
fst3
getSource :: LifxT m HostAddress
getSource = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b c. (a, b, c) -> b
snd3
getTimeout :: LifxT m Int
getTimeout = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b c. (a, b, c) -> c
thd3
incrementCounter :: LifxT m ()
incrementCounter = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a. (Eq a, Bounded a, Enum a) => a -> a
succ'
getCounter :: LifxT m Word8
getCounter = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a. a -> a
id
lifxThrowIO :: forall a. LifxError -> LifxT m a
lifxThrowIO = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
newtype LifxT m a = LifxT
{ forall (m :: * -> *) a.
LifxT m a
-> StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
unwrap ::
StateT
Word8
( ReaderT
(Socket, Word32, Int)
( ExceptT
LifxError
m
)
)
a
}
deriving newtype
( forall a b. a -> LifxT m b -> LifxT m a
forall a b. (a -> b) -> LifxT m a -> LifxT m b
forall (m :: * -> *) a b. Functor m => a -> LifxT m b -> LifxT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LifxT m a -> LifxT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LifxT m b -> LifxT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> LifxT m b -> LifxT m a
fmap :: forall a b. (a -> b) -> LifxT m a -> LifxT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LifxT m a -> LifxT m b
Functor
, forall a. a -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m b
forall a b. LifxT m (a -> b) -> LifxT m a -> LifxT m b
forall a b c. (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
forall {m :: * -> *}. Monad m => Functor (LifxT m)
forall (m :: * -> *) a. Monad m => a -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
forall (m :: * -> *) a b.
Monad m =>
LifxT m (a -> b) -> LifxT m a -> LifxT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT 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 a b. LifxT m a -> LifxT m b -> LifxT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m a
*> :: forall a b. LifxT m a -> LifxT m b -> LifxT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
liftA2 :: forall a b c. (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
<*> :: forall a b. LifxT m (a -> b) -> LifxT m a -> LifxT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m (a -> b) -> LifxT m a -> LifxT m b
pure :: forall a. a -> LifxT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
Applicative
, forall a. a -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m b
forall a b. LifxT m a -> (a -> LifxT m b) -> LifxT m b
forall (m :: * -> *). Monad m => Applicative (LifxT m)
forall (m :: * -> *) a. Monad m => a -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> (a -> LifxT m b) -> LifxT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LifxT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
>> :: forall a b. LifxT m a -> LifxT m b -> LifxT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
>>= :: forall a b. LifxT m a -> (a -> LifxT m b) -> LifxT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> (a -> LifxT m b) -> LifxT m b
Monad
, forall a. IO a -> LifxT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (LifxT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LifxT m a
liftIO :: forall a. IO a -> LifxT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LifxT m a
MonadIO
)
instance MonadTrans LifxT where
lift :: forall (m :: * -> *) a. Monad m => m a -> LifxT m a
lift = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadReader s m => MonadReader s (LifxT m) where
ask :: LifxT m s
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (s -> s) -> LifxT m a -> LifxT m a
local s -> s
f LifxT m a
m = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT \Word8
s -> forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \(Socket, HostAddress, Int)
e ->
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local s -> s
f forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
unLifx (Socket, HostAddress, Int)
e Word8
s LifxT m a
m
instance MonadState s m => MonadState s (LifxT m) where
state :: forall a. (s -> (a, s)) -> LifxT m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance MonadError e m => MonadError e (LifxT m) where
throwError :: forall a. e -> LifxT m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError @e @m
catchError :: forall a. LifxT m a -> (e -> LifxT m a) -> LifxT m a
catchError LifxT m a
m e -> LifxT m a
h = forall (m :: * -> *) a.
StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT \Word8
s -> forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \(Socket, HostAddress, Int)
e ->
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError @e @m (forall (m :: * -> *) a.
(Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
unLifx (Socket, HostAddress, Int)
e Word8
s LifxT m a
m) (forall (m :: * -> *) a.
(Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
unLifx (Socket, HostAddress, Int)
e Word8
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> LifxT m a
h)
unLifx :: (Socket, Word32, Int) -> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
unLifx :: forall (m :: * -> *) a.
(Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
unLifx (Socket, HostAddress, Int)
e Word8
s = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Socket, HostAddress, Int)
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Word8
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unwrap)
succ' :: (Eq a, Bounded a, Enum a) => a -> a
succ' :: forall a. (Eq a, Bounded a, Enum a) => a -> a
succ' a
e
| a
e forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound = forall a. Bounded a => a
minBound
| Bool
otherwise = forall a. Enum a => a -> a
succ a
e