-- TODO remove when `OverloadedRecordUpdate` is fully implemented (and simplify some nested updates) - hopefully 9.4
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- | Rather than interacting with any bulbs, simulate interactions by printing to a terminal.
module Lifx.Lan.Mock.Terminal (Mock, MockError, runMock, runMockFull, MockState (MockState)) where

import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Data.Colour.RGBSpace
import Data.Colour.SRGB
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Traversable
import Data.Tuple.Extra
import Numeric.Natural

import Data.ByteString qualified as BS
import Data.List (unfoldr)
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text.IO qualified as T
import Data.Time.Clock.POSIX (getPOSIXTime)
import System.Console.ANSI hiding (SetColor)

import Lifx.Internal.Colour
import Lifx.Lan

newtype Mock a = Mock (StateT (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a)
    deriving newtype
        ( (forall a b. (a -> b) -> Mock a -> Mock b)
-> (forall a b. a -> Mock b -> Mock a) -> Functor Mock
forall a b. a -> Mock b -> Mock a
forall a b. (a -> b) -> Mock a -> Mock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Mock a -> Mock b
fmap :: forall a b. (a -> b) -> Mock a -> Mock b
$c<$ :: forall a b. a -> Mock b -> Mock a
<$ :: forall a b. a -> Mock b -> Mock a
Functor
        , Functor Mock
Functor Mock =>
(forall a. a -> Mock a)
-> (forall a b. Mock (a -> b) -> Mock a -> Mock b)
-> (forall a b c. (a -> b -> c) -> Mock a -> Mock b -> Mock c)
-> (forall a b. Mock a -> Mock b -> Mock b)
-> (forall a b. Mock a -> Mock b -> Mock a)
-> Applicative Mock
forall a. a -> Mock a
forall a b. Mock a -> Mock b -> Mock a
forall a b. Mock a -> Mock b -> Mock b
forall a b. Mock (a -> b) -> Mock a -> Mock b
forall a b c. (a -> b -> c) -> Mock a -> Mock b -> Mock 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 a. a -> Mock a
pure :: forall a. a -> Mock a
$c<*> :: forall a b. Mock (a -> b) -> Mock a -> Mock b
<*> :: forall a b. Mock (a -> b) -> Mock a -> Mock b
$cliftA2 :: forall a b c. (a -> b -> c) -> Mock a -> Mock b -> Mock c
liftA2 :: forall a b c. (a -> b -> c) -> Mock a -> Mock b -> Mock c
$c*> :: forall a b. Mock a -> Mock b -> Mock b
*> :: forall a b. Mock a -> Mock b -> Mock b
$c<* :: forall a b. Mock a -> Mock b -> Mock a
<* :: forall a b. Mock a -> Mock b -> Mock a
Applicative
        , Applicative Mock
Applicative Mock =>
(forall a b. Mock a -> (a -> Mock b) -> Mock b)
-> (forall a b. Mock a -> Mock b -> Mock b)
-> (forall a. a -> Mock a)
-> Monad Mock
forall a. a -> Mock a
forall a b. Mock a -> Mock b -> Mock b
forall a b. Mock a -> (a -> Mock b) -> Mock 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 a b. Mock a -> (a -> Mock b) -> Mock b
>>= :: forall a b. Mock a -> (a -> Mock b) -> Mock b
$c>> :: forall a b. Mock a -> Mock b -> Mock b
>> :: forall a b. Mock a -> Mock b -> Mock b
$creturn :: forall a. a -> Mock a
return :: forall a. a -> Mock a
Monad
        , Monad Mock
Monad Mock => (forall a. IO a -> Mock a) -> MonadIO Mock
forall a. IO a -> Mock a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Mock a
liftIO :: forall a. IO a -> Mock a
MonadIO
        )

data MockState = MockState
    { MockState -> LightState
light :: LightState
    , MockState -> StateGroup
group :: StateGroup
    , MockState -> Maybe StateService
service :: Maybe StateService
    , MockState -> Maybe StateHostFirmware
hostFirmware :: Maybe StateHostFirmware
    , MockState -> Maybe StateVersion
version :: Maybe StateVersion
    }

dotLabel :: LightState -> Text
-- dotLabel = (.label) -- TODO this is a GHC bug: https://gitlab.haskell.org/ghc/ghc/-/issues/21226
dotLabel :: LightState -> Text
dotLabel LightState{Word16
Text
HSBK
hsbk :: HSBK
power :: Word16
label :: Text
$sel:hsbk:LightState :: LightState -> HSBK
$sel:power:LightState :: LightState -> Word16
$sel:label:LightState :: LightState -> Text
..} = Text
label

{- | Run a LIFX action by mocking effects in a terminal.

Note that sending some messages (e.g. 'GetVersion') will throw exceptions, since the necessary state isn't specified.
See `runMockFull` for more control.
-}
runMock :: [(Device, (Text, Text))] -> Mock a -> IO (Either MockError a)
runMock :: forall a.
[(Device, (Text, Text))] -> Mock a -> IO (Either MockError a)
runMock [(Device, (Text, Text))]
ds Mock a
m = do
    POSIXTime
t0 <- IO POSIXTime
getPOSIXTime
    ([(Device, MockState)] -> Mock a -> IO (Either MockError a))
-> Mock a -> [(Device, MockState)] -> IO (Either MockError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(Device, MockState)] -> Mock a -> IO (Either MockError a)
forall a.
[(Device, MockState)] -> Mock a -> IO (Either MockError a)
runMockFull Mock a
m ([(Device, MockState)] -> IO (Either MockError a))
-> (State Natural [(Device, MockState)] -> [(Device, MockState)])
-> State Natural [(Device, MockState)]
-> IO (Either MockError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State Natural [(Device, MockState)]
 -> Natural -> [(Device, MockState)])
-> Natural
-> State Natural [(Device, MockState)]
-> [(Device, MockState)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Natural [(Device, MockState)]
-> Natural -> [(Device, MockState)]
forall s a. State s a -> s -> a
evalState Natural
0 (State Natural [(Device, MockState)] -> IO (Either MockError a))
-> State Natural [(Device, MockState)] -> IO (Either MockError a)
forall a b. (a -> b) -> a -> b
$ [(Device, (Text, Text))]
-> ((Device, (Text, Text))
    -> StateT Natural Identity (Device, MockState))
-> State Natural [(Device, MockState)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Device, (Text, Text))]
ds \(Device, (Text, Text))
d ->
        (Natural -> (ByteString, Natural))
-> StateT Natural Identity ByteString
forall a. (Natural -> (a, Natural)) -> StateT Natural Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (([Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (Natural -> [Word8]) -> Natural -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [Word8]
forall a. (Integral a, Bounded a) => Natural -> [a]
unfoldNat) (Natural -> ByteString)
-> (Natural -> Natural) -> Natural -> (ByteString, Natural)
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& Natural -> Natural
forall a. Enum a => a -> a
succ) StateT Natural Identity ByteString
-> (ByteString -> (Device, MockState))
-> StateT Natural Identity (Device, MockState)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
uuid ->
            (Device, (Text, Text))
d (Device, (Text, Text))
-> ((Device, (Text, Text)) -> (Device, MockState))
-> (Device, MockState)
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> MockState)
-> (Device, (Text, Text)) -> (Device, MockState)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second \(Text
label, Text
group) ->
                MockState
                    { $sel:light:MockState :: LightState
light = HSBK -> Word16 -> Text -> LightState
LightState (Word16 -> Word16 -> Word16 -> Word16 -> HSBK
HSBK Word16
0 Word16
0 Word16
0 Word16
0) Word16
1 Text
label
                    , $sel:group:MockState :: StateGroup
group = ByteString -> Text -> POSIXTime -> StateGroup
StateGroup ByteString
uuid Text
group POSIXTime
t0
                    , $sel:service:MockState :: Maybe StateService
service = Maybe StateService
forall a. Maybe a
Nothing
                    , $sel:hostFirmware:MockState :: Maybe StateHostFirmware
hostFirmware = Maybe StateHostFirmware
forall a. Maybe a
Nothing
                    , $sel:version:MockState :: Maybe StateVersion
version = Maybe StateVersion
forall a. Maybe a
Nothing
                    }
  where
    -- represent input as base-(maxBound @a)
    unfoldNat :: forall a. (Integral a, Bounded a) => Natural -> [a]
    unfoldNat :: forall a. (Integral a, Bounded a) => Natural -> [a]
unfoldNat = (Natural -> Maybe (a, Natural)) -> Natural -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr \Natural
n -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0) Maybe () -> (a, Natural) -> Maybe (a, Natural)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Natural, a) -> (a, Natural)
forall a b. (a, b) -> (b, a)
swap ((Natural -> a) -> (Natural, Natural) -> (Natural, a)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second Natural -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural
n Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @a)))

-- | More general version of `runMock`, which allows specifying extra information about devices.
runMockFull :: [(Device, MockState)] -> Mock a -> IO (Either MockError a)
runMockFull :: forall a.
[(Device, MockState)] -> Mock a -> IO (Either MockError a)
runMockFull [(Device, MockState)]
ds (Mock StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
x) =
    ExceptT MockError IO a -> IO (Either MockError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
        (ExceptT MockError IO a -> IO (Either MockError a))
-> (StateT
      (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
    -> ExceptT MockError IO a)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> IO (Either MockError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT [Device] (ExceptT MockError IO) a
 -> [Device] -> ExceptT MockError IO a)
-> [Device]
-> ReaderT [Device] (ExceptT MockError IO) a
-> ExceptT MockError IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            ReaderT [Device] (ExceptT MockError IO) a
-> [Device] -> ExceptT MockError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
            ((Device, MockState) -> Device
forall a b. (a, b) -> a
fst ((Device, MockState) -> Device)
-> [(Device, MockState)] -> [Device]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Device, MockState)]
ds)
        (ReaderT [Device] (ExceptT MockError IO) a
 -> ExceptT MockError IO a)
-> (StateT
      (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
    -> ReaderT [Device] (ExceptT MockError IO) a)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> ExceptT MockError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
   (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
 -> Map Device MockState
 -> ReaderT [Device] (ExceptT MockError IO) a)
-> Map Device MockState
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> ReaderT [Device] (ExceptT MockError IO) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Map Device MockState
-> ReaderT [Device] (ExceptT MockError IO) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT
            ([(Device, MockState)] -> Map Device MockState
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Device, MockState)]
ds)
        (StateT
   (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
 -> IO (Either MockError a))
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> IO (Either MockError a)
forall a b. (a -> b) -> a -> b
$ StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
x

data MockError
    = MockNoSuchDevice Device
    | MockProductLookupError ProductLookupError
    | MockDataNotProvided
    deriving (Int -> MockError -> ShowS
[MockError] -> ShowS
MockError -> String
(Int -> MockError -> ShowS)
-> (MockError -> String)
-> ([MockError] -> ShowS)
-> Show MockError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockError -> ShowS
showsPrec :: Int -> MockError -> ShowS
$cshow :: MockError -> String
show :: MockError -> String
$cshowList :: [MockError] -> ShowS
showList :: [MockError] -> ShowS
Show)

instance MonadLifx Mock where
    type MonadLifxError Mock = MockError
    lifxThrow :: forall a. MonadLifxError Mock -> Mock a
lifxThrow = StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock (StateT
   (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
 -> Mock a)
-> (MonadLifxError Mock
    -> StateT
         (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a)
-> MonadLifxError Mock
-> Mock a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonadLifxError Mock
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall a.
MonadLifxError Mock
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    liftProductLookupError :: ProductLookupError -> MonadLifxError Mock
liftProductLookupError = ProductLookupError -> MonadLifxError Mock
ProductLookupError -> MockError
MockProductLookupError

    sendMessage :: forall r. Device -> Message r -> Mock r
sendMessage Device
d (Message r
m :: Message r) = do
        MockState
s <- Device -> Mock MockState
lookupDevice Device
d
        r
r <- StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
-> Mock r
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock case Message r
m of
            Message r
GetService -> Maybe r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
whenProvided MockState
s.service
            Message r
GetHostFirmware -> Maybe r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
whenProvided MockState
s.hostFirmware
            Message r
GetPower -> StatePower
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     StatePower
forall a.
a
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StatePower
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      StatePower)
-> StatePower
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     StatePower
forall a b. (a -> b) -> a -> b
$ Word16 -> StatePower
StatePower MockState
s.light.power
            SetPower (Bool -> Word16
forall {b} {a}. (Num b, Enum a) => a -> b
convertPower -> Word16
power) -> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Device MockState -> Map Device MockState)
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      ())
-> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall a b. (a -> b) -> a -> b
$ Device -> MockState -> Map Device MockState -> Map Device MockState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Device
d MockState
s{light = s.light{power}}
            SetLabel Text
label -> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Device MockState -> Map Device MockState)
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      ())
-> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall a b. (a -> b) -> a -> b
$ Device -> MockState -> Map Device MockState -> Map Device MockState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Device
d MockState
s{light = s.light{label}}
            Message r
GetVersion -> Maybe r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
whenProvided MockState
s.version
            Message r
GetGroup -> r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
forall a.
a
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MockState
s.group
            Message r
GetColor -> r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
forall a.
a
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MockState
s.light
            SetColor HSBK
hsbk POSIXTime
_t -> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Device MockState -> Map Device MockState)
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      ())
-> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall a b. (a -> b) -> a -> b
$ Device -> MockState -> Map Device MockState -> Map Device MockState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Device
d MockState
s{light = s.light{hsbk}}
            SetLightPower (Bool -> Word16
forall {b} {a}. (Num b, Enum a) => a -> b
convertPower -> Word16
power) POSIXTime
_t -> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map Device MockState -> Map Device MockState)
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      ())
-> (Map Device MockState -> Map Device MockState)
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) ()
forall a b. (a -> b) -> a -> b
$ Device -> MockState -> Map Device MockState -> Map Device MockState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Device
d MockState
s{light = s.light{power}}
        [Device]
ds <- StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  [Device]
-> Mock [Device]
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  [Device]
forall r (m :: * -> *). MonadReader r m => m r
ask
        [Device] -> (Device -> Mock ()) -> Mock ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Device]
ds \Device
d' -> do
            MockState
s' <- Device -> Mock MockState
lookupDevice Device
d'
            IO () -> Mock ()
forall a. IO a -> Mock a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
                [SGR] -> IO ()
setSGR ([SGR] -> IO ()) -> [SGR] -> IO ()
forall a b. (a -> b) -> a -> b
$ LightState -> [SGR]
forall {a} {p}.
(Eq a, Num a, HasField "power" p a, HasField "hsbk" p HSBK) =>
p -> [SGR]
mkSGR MockState
s'.light
                Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ LightState -> Text
dotLabel MockState
s'.light
                [SGR] -> IO ()
setSGR []
        IO () -> Mock ()
forall a. IO a -> Mock a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Mock ()) -> IO () -> Mock ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
""
        r -> Mock r
forall a. a -> Mock a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
      where
        lookupDevice :: Device -> Mock MockState
lookupDevice = Mock MockState
-> (MockState -> Mock MockState)
-> Maybe MockState
-> Mock MockState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MonadLifxError Mock -> Mock MockState
forall a. MonadLifxError Mock -> Mock a
forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow (MonadLifxError Mock -> Mock MockState)
-> MonadLifxError Mock -> Mock MockState
forall a b. (a -> b) -> a -> b
$ Device -> MockError
MockNoSuchDevice Device
d) MockState -> Mock MockState
forall a. a -> Mock a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MockState -> Mock MockState)
-> (Device -> Mock (Maybe MockState)) -> Device -> Mock MockState
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  (Maybe MockState)
-> Mock (Maybe MockState)
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock (StateT
   (Map Device MockState)
   (ReaderT [Device] (ExceptT MockError IO))
   (Maybe MockState)
 -> Mock (Maybe MockState))
-> (Device
    -> StateT
         (Map Device MockState)
         (ReaderT [Device] (ExceptT MockError IO))
         (Maybe MockState))
-> Device
-> Mock (Maybe MockState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Device MockState -> Maybe MockState)
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     (Maybe MockState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Map Device MockState -> Maybe MockState)
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      (Maybe MockState))
-> (Device -> Map Device MockState -> Maybe MockState)
-> Device
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     (Maybe MockState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Map Device MockState -> Maybe MockState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
        whenProvided :: Maybe r -> StateT (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
        whenProvided :: Maybe r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
whenProvided = StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
-> (r
    -> StateT
         (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r)
-> Maybe r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MockError
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
forall a.
MockError
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MockError
MockDataNotProvided) r
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) r
forall a.
a
-> StateT
     (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        convertPower :: a -> b
convertPower = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
        mkSGR :: p -> [SGR]
mkSGR p
s = [ConsoleLayer -> Colour Float -> SGR
SetRGBColor ConsoleLayer
Background (Colour Float -> SGR)
-> (RGB Float -> Colour Float) -> RGB Float -> SGR
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float -> Colour Float)
-> RGB Float -> Colour Float
forall a b. (a -> a -> a -> b) -> RGB a -> b
uncurryRGB Float -> Float -> Float -> Colour Float
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (RGB Float -> SGR) -> RGB Float -> SGR
forall a b. (a -> b) -> a -> b
$ HSBK -> RGB Float
hsbkToRgb p
s.hsbk | p
s.power a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0]
    broadcastMessage :: forall r. Message r -> Mock [(Device, r)]
broadcastMessage Message r
m = StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  [Device]
-> Mock [Device]
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  [Device]
forall r (m :: * -> *). MonadReader r m => m r
ask Mock [Device]
-> ([Device] -> Mock [(Device, r)]) -> Mock [(Device, r)]
forall a b. Mock a -> (a -> Mock b) -> Mock b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Device -> Mock (Device, r)) -> [Device] -> Mock [(Device, r)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse \Device
d -> (Device
d,) (r -> (Device, r)) -> Mock r -> Mock (Device, r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Device -> Message r -> Mock r
forall r. Device -> Message r -> Mock r
forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage Device
d Message r
m
    discoverDevices :: Maybe Int -> Mock [Device]
discoverDevices = StateT
  (Map Device MockState)
  (ReaderT [Device] (ExceptT MockError IO))
  [Device]
-> Mock [Device]
forall a.
StateT
  (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a
-> Mock a
Mock (StateT
   (Map Device MockState)
   (ReaderT [Device] (ExceptT MockError IO))
   [Device]
 -> Mock [Device])
-> (Maybe Int
    -> StateT
         (Map Device MockState)
         (ReaderT [Device] (ExceptT MockError IO))
         [Device])
-> Maybe Int
-> Mock [Device]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Device] -> [Device])
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     [Device]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (([Device] -> [Device])
 -> StateT
      (Map Device MockState)
      (ReaderT [Device] (ExceptT MockError IO))
      [Device])
-> (Maybe Int -> [Device] -> [Device])
-> Maybe Int
-> StateT
     (Map Device MockState)
     (ReaderT [Device] (ExceptT MockError IO))
     [Device]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Device] -> [Device])
-> (Int -> [Device] -> [Device])
-> Maybe Int
-> [Device]
-> [Device]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Device] -> [Device]
forall a. a -> a
id Int -> [Device] -> [Device]
forall a. Int -> [a] -> [a]
take