{-# 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)

-- | A LIFX device, such as a bulb.
newtype Device = Device {Device -> HostAddress
unwrap :: HostAddress}
    deriving newtype (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
/= :: Device -> Device -> Bool
Eq, Eq Device
Eq Device =>
(Device -> Device -> Ordering)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Device)
-> (Device -> Device -> Device)
-> Ord 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
$ccompare :: Device -> Device -> Ordering
compare :: Device -> Device -> Ordering
$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
>= :: Device -> Device -> Bool
$cmax :: Device -> Device -> Device
max :: Device -> Device -> Device
$cmin :: Device -> Device -> Device
min :: Device -> Device -> Device
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 String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
forall a. Show a => a -> String
show [Word8
a, Word8
b, Word8
c, Word8
d]

-- | A colour. See https://lan.developer.lifx.com/docs/representing-color-with-hsbk.
data HSBK = HSBK
    { HSBK -> Word16
hue :: Word16
    , HSBK -> Word16
saturation :: Word16
    , HSBK -> Word16
brightness :: Word16
    , HSBK -> Word16
kelvin :: Word16
    -- ^ takes values in the range 1500 to 9000
    }
    deriving (HSBK -> HSBK -> Bool
(HSBK -> HSBK -> Bool) -> (HSBK -> HSBK -> Bool) -> Eq HSBK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HSBK -> HSBK -> Bool
== :: HSBK -> HSBK -> Bool
$c/= :: HSBK -> HSBK -> Bool
/= :: HSBK -> HSBK -> Bool
Eq, Eq HSBK
Eq HSBK =>
(HSBK -> HSBK -> Ordering)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> HSBK)
-> (HSBK -> HSBK -> HSBK)
-> Ord 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
$ccompare :: HSBK -> HSBK -> Ordering
compare :: HSBK -> HSBK -> Ordering
$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
>= :: HSBK -> HSBK -> Bool
$cmax :: HSBK -> HSBK -> HSBK
max :: HSBK -> HSBK -> HSBK
$cmin :: HSBK -> HSBK -> HSBK
min :: HSBK -> HSBK -> HSBK
Ord, Int -> HSBK -> ShowS
[HSBK] -> ShowS
HSBK -> String
(Int -> HSBK -> ShowS)
-> (HSBK -> String) -> ([HSBK] -> ShowS) -> Show HSBK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HSBK -> ShowS
showsPrec :: Int -> HSBK -> ShowS
$cshow :: HSBK -> String
show :: HSBK -> String
$cshowList :: [HSBK] -> ShowS
showList :: [HSBK] -> ShowS
Show, (forall x. HSBK -> Rep HSBK x)
-> (forall x. Rep HSBK x -> HSBK) -> Generic HSBK
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
$cfrom :: forall x. HSBK -> Rep HSBK x
from :: forall x. HSBK -> Rep HSBK x
$cto :: forall x. Rep HSBK x -> HSBK
to :: forall x. Rep HSBK x -> HSBK
Generic)

data LifxError
    = DecodeFailure BS.ByteString ByteOffset String
    | RecvTimeout
    | BroadcastTimeout [HostAddress] -- contains the addresses which we have received valid responses from
    | WrongPacketType Word16 Word16 -- expected, then actual
    | WrongSender Device HostAddress -- expected, then actual
    | UnexpectedSockAddrType SockAddr
    | UnexpectedPort PortNumber
    | ProductLookupError ProductLookupError
    deriving (LifxError -> LifxError -> Bool
(LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool) -> Eq LifxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LifxError -> LifxError -> Bool
== :: LifxError -> LifxError -> Bool
$c/= :: LifxError -> LifxError -> Bool
/= :: LifxError -> LifxError -> Bool
Eq, Eq LifxError
Eq LifxError =>
(LifxError -> LifxError -> Ordering)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> LifxError)
-> (LifxError -> LifxError -> LifxError)
-> Ord 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
$ccompare :: LifxError -> LifxError -> Ordering
compare :: LifxError -> LifxError -> Ordering
$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
>= :: LifxError -> LifxError -> Bool
$cmax :: LifxError -> LifxError -> LifxError
max :: LifxError -> LifxError -> LifxError
$cmin :: LifxError -> LifxError -> LifxError
min :: LifxError -> LifxError -> LifxError
Ord, Int -> LifxError -> ShowS
[LifxError] -> ShowS
LifxError -> String
(Int -> LifxError -> ShowS)
-> (LifxError -> String)
-> ([LifxError] -> ShowS)
-> Show LifxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LifxError -> ShowS
showsPrec :: Int -> LifxError -> ShowS
$cshow :: LifxError -> String
show :: LifxError -> String
$cshowList :: [LifxError] -> ShowS
showList :: [LifxError] -> ShowS
Show, (forall x. LifxError -> Rep LifxError x)
-> (forall x. Rep LifxError x -> LifxError) -> Generic LifxError
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
$cfrom :: forall x. LifxError -> Rep LifxError x
from :: forall x. LifxError -> Rep LifxError x
$cto :: forall x. Rep LifxError x -> LifxError
to :: forall x. Rep LifxError x -> LifxError
Generic)

-- | A monad for sending and receiving LIFX messages.
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 ::
        -- | expected counter value
        Word8 ->
        -- | actual counter value
        Word8 ->
        -- | packet type
        Word16 ->
        -- | payload
        BL.ByteString ->
        m ()
    handleOldMessage Word8
_ Word8
_ Word16
_ ByteString
_ = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (MonadIO m) => MonadLifxIO (LifxT m) where
    getSocket :: LifxT m Socket
getSocket = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Socket
-> LifxT m Socket
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Socket
 -> LifxT m Socket)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Socket
-> LifxT m Socket
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> Socket)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Socket
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> Socket
forall a b c. (a, b, c) -> a
fst3
    getSource :: LifxT m HostAddress
getSource = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  HostAddress
-> LifxT m HostAddress
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   HostAddress
 -> LifxT m HostAddress)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     HostAddress
-> LifxT m HostAddress
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> HostAddress)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     HostAddress
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> HostAddress
forall a b c. (a, b, c) -> b
snd3
    getTimeout :: LifxT m Int
getTimeout = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Int
-> LifxT m Int
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Int
 -> LifxT m Int)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Int
-> LifxT m Int
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> Int)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> Int
forall a b c. (a, b, c) -> c
thd3
    incrementCounter :: LifxT m ()
incrementCounter = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
-> LifxT m ()
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
 -> LifxT m ())
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
-> LifxT m ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8)
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Word8 -> Word8
forall a. (Eq a, Bounded a, Enum a) => a -> a
succ'
    getCounter :: LifxT m Word8
getCounter = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Word8
-> LifxT m Word8
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Word8
 -> LifxT m Word8)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Word8
-> LifxT m Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Word8
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Word8 -> Word8
forall a. a -> a
id
    lifxThrowIO :: forall a. LifxError -> LifxT m a
lifxThrowIO = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> (LifxError
    -> StateT
         Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> LifxError
-> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall a.
LifxError
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
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 -> b) -> LifxT m a -> LifxT m b)
-> (forall a b. a -> LifxT m b -> LifxT m a) -> Functor (LifxT m)
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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LifxT m a -> LifxT m b
fmap :: forall a b. (a -> b) -> LifxT m a -> LifxT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> LifxT m b -> LifxT m a
<$ :: forall a b. a -> LifxT m b -> LifxT m a
Functor
        , Functor (LifxT m)
Functor (LifxT m) =>
(forall a. a -> LifxT m a)
-> (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 a b. LifxT m a -> LifxT m b -> LifxT m b)
-> (forall a b. LifxT m a -> LifxT m b -> LifxT m a)
-> Applicative (LifxT m)
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
$cpure :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
pure :: forall a. a -> LifxT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m (a -> b) -> LifxT m a -> LifxT m b
<*> :: forall a b. LifxT m (a -> b) -> LifxT m a -> LifxT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
liftA2 :: forall a b c. (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
*> :: 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 a
<* :: forall a b. LifxT m a -> LifxT m b -> LifxT m a
Applicative
        , Applicative (LifxT m)
Applicative (LifxT m) =>
(forall a b. LifxT m a -> (a -> LifxT m b) -> LifxT m b)
-> (forall a b. LifxT m a -> LifxT m b -> LifxT m b)
-> (forall a. a -> LifxT m a)
-> Monad (LifxT m)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> (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 -> LifxT m b -> LifxT m b
>> :: forall a b. LifxT m a -> LifxT m b -> LifxT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
return :: forall a. a -> LifxT m a
Monad
        , Monad (LifxT m)
Monad (LifxT m) =>
(forall a. IO a -> LifxT m a) -> MonadIO (LifxT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LifxT m a
liftIO :: forall a. IO a -> LifxT m a
MonadIO
        )

instance MonadTrans LifxT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> LifxT m a
lift = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> (m a
    -> StateT
         Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> m a
-> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall (m :: * -> *) a. Monad m => m a -> StateT Word8 m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
 -> StateT
      Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> (m a
    -> ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a)
-> m a
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT LifxError m a
-> ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Socket, HostAddress, Int) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT LifxError m a
 -> ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a)
-> (m a -> ExceptT LifxError m a)
-> m a
-> ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ExceptT LifxError m a
forall (m :: * -> *) a. Monad m => m a -> ExceptT LifxError m a
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 = m s -> LifxT m s
forall (m :: * -> *) a. Monad m => m a -> LifxT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
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 = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall a b. (a -> b) -> a -> b
$ (Word8
 -> ReaderT
      (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8))
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT \Word8
s -> ((Socket, HostAddress, Int) -> ExceptT LifxError m (a, Word8))
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \(Socket, HostAddress, Int)
e ->
        m (Either LifxError (a, Word8)) -> ExceptT LifxError m (a, Word8)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either LifxError (a, Word8)) -> ExceptT LifxError m (a, Word8))
-> m (Either LifxError (a, Word8))
-> ExceptT LifxError m (a, Word8)
forall a b. (a -> b) -> a -> b
$ (s -> s)
-> m (Either LifxError (a, Word8))
-> m (Either LifxError (a, Word8))
forall a. (s -> s) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local s -> s
f (m (Either LifxError (a, Word8))
 -> m (Either LifxError (a, Word8)))
-> m (Either LifxError (a, Word8))
-> m (Either LifxError (a, Word8))
forall a b. (a -> b) -> a -> b
$ (Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
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 = m a -> LifxT m a
forall (m :: * -> *) a. Monad m => m a -> LifxT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifxT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
instance (MonadError e m) => MonadError (Either e LifxError) (LifxT m) where
    throwError :: forall a. Either e LifxError -> LifxT m a
throwError = (e -> LifxT m a)
-> (LifxError -> LifxT m a) -> Either e LifxError -> LifxT m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m a -> LifxT m a
forall (m :: * -> *) a. Monad m => m a -> LifxT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LifxT m a) -> (e -> m a) -> e -> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError @e @m) (StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> (LifxError
    -> StateT
         Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> LifxError
-> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall a.
LifxError
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError)
    catchError :: forall a.
LifxT m a -> (Either e LifxError -> LifxT m a) -> LifxT m a
catchError LifxT m a
m Either e LifxError -> LifxT m a
h = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall a b. (a -> b) -> a -> b
$ (Word8
 -> ReaderT
      (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8))
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT \Word8
s -> ((Socket, HostAddress, Int) -> ExceptT LifxError m (a, Word8))
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT \(Socket, HostAddress, Int)
e -> m (Either LifxError (a, Word8)) -> ExceptT LifxError m (a, Word8)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT do
        (LifxT m a
m', Word8
s'') <- (LifxError -> (LifxT m a, Word8))
-> ((a, Word8) -> (LifxT m a, Word8))
-> Either LifxError (a, Word8)
-> (LifxT m a, Word8)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((,Word8
s) (LifxT m a -> (LifxT m a, Word8))
-> (LifxError -> LifxT m a) -> LifxError -> (LifxT m a, Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e LifxError -> LifxT m a
h (Either e LifxError -> LifxT m a)
-> (LifxError -> Either e LifxError) -> LifxError -> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> Either e LifxError
forall a b. b -> Either a b
Right) ((a -> LifxT m a) -> (a, Word8) -> (LifxT m a, Word8)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first a -> LifxT m a
forall a. a -> LifxT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Either LifxError (a, Word8) -> (LifxT m a, Word8))
-> m (Either LifxError (a, Word8)) -> m (LifxT m a, Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
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 e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError @e @m ((Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
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') ((Socket, HostAddress, Int)
-> Word8 -> LifxT m a -> m (Either LifxError (a, Word8))
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 (Either LifxError (a, Word8)))
-> (e -> LifxT m a) -> e -> m (Either LifxError (a, Word8))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e LifxError -> LifxT m a
h (Either e LifxError -> LifxT m a)
-> (e -> Either e LifxError) -> e -> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e LifxError
forall a b. a -> Either a b
Left)

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 = ExceptT LifxError m (a, Word8) -> m (Either LifxError (a, Word8))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT LifxError m (a, Word8) -> m (Either LifxError (a, Word8)))
-> (LifxT m a -> ExceptT LifxError m (a, Word8))
-> LifxT m a
-> m (Either LifxError (a, Word8))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT
   (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
 -> (Socket, HostAddress, Int) -> ExceptT LifxError m (a, Word8))
-> (Socket, HostAddress, Int)
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
-> ExceptT LifxError m (a, Word8)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
-> (Socket, HostAddress, Int) -> ExceptT LifxError m (a, Word8)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Socket, HostAddress, Int)
e (ReaderT
   (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
 -> ExceptT LifxError m (a, Word8))
-> (LifxT m a
    -> ReaderT
         (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8))
-> LifxT m a
-> ExceptT LifxError m (a, Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> Word8
 -> ReaderT
      (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8))
-> Word8
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> Word8
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Word8
s (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> ReaderT
      (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8))
-> (LifxT m a
    -> StateT
         Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> LifxT m a
-> ReaderT
     (Socket, HostAddress, Int) (ExceptT LifxError m) (a, Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unwrap)

{- Util -}

-- | Safe, wraparound variant of 'succ'.
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound = a
forall a. Bounded a => a
minBound
    | Bool
otherwise = a -> a
forall a. Enum a => a -> a
succ a
e