| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Lifx.Lan
Description
-- these should be enabled by default in a future version of GHC
-- (they aren't entirely necessary here anyway - they just make the example even simpler)
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (for_)
-- | Find all devices on the network, print their addresses, and set their brightness to 50%.
main :: IO ()
main = runLifx do
devs <- discoverDevices Nothing
liftIO $ print devs
for_ devs \d -> do
LightState{hsbk} <- sendMessage d GetColor
sendMessage d $ SetColor hsbk{brightness = maxBound `div` 2} 3
Synopsis
- data Device
- deviceAddress :: Device -> HostAddress
- sendMessage :: MonadLifx m => Device -> Message r -> m r
- broadcastMessage :: MonadLifx m => Message r -> m [(Device, r)]
- discoverDevices :: MonadLifx m => Maybe Int -> m [Device]
- data Message r where
- GetService :: Message StateService
- GetPower :: Message StatePower
- SetPower :: Bool -> Message ()
- GetColor :: Message LightState
- SetColor :: HSBK -> NominalDiffTime -> Message ()
- SetLightPower :: Bool -> NominalDiffTime -> Message ()
- data HSBK = HSBK {
- hue :: Word16
- saturation :: Word16
- brightness :: Word16
- kelvin :: Word16
- type Lifx = LifxT IO
- runLifx :: Lifx a -> IO a
- newtype LifxT m a = LifxT (StateT Word8 (ReaderT (Socket, Word32, Int) (ExceptT LifxError m)) a)
- runLifxT :: MonadIO m => Int -> LifxT m a -> m (Either LifxError a)
- data LifxError
- class MonadIO m => MonadLifx m where
- getSocket :: m Socket
- getSource :: m Word32
- getTimeout :: m Int
- incrementCounter :: m ()
- getCounter :: m Word8
- lifxThrow :: LifxError -> m a
- handleOldMessage :: Word8 -> Word8 -> Word16 -> ByteString -> m ()
- data StateService = StateService {
- service :: Service
- port :: PortNumber
- data Service
- newtype StatePower = StatePower {}
- data LightState = LightState {}
- deviceFromAddress :: (Word8, Word8, Word8, Word8) -> Device
- encodeMessage :: Bool -> Bool -> Word8 -> Word32 -> Message r -> ByteString
- data Header = Header {
- size :: Word16
- protocol :: Word16
- addressable :: Bool
- tagged :: Bool
- origin :: Word8
- source :: Word32
- target :: Word64
- resRequired :: Bool
- ackRequired :: Bool
- sequenceCounter :: Word8
- packetType :: Word16
- $sel:unLifxT:LifxT :: LifxT m a -> StateT Word8 (ReaderT (Socket, Word32, Int) (ExceptT LifxError m)) a
Documentation
deviceAddress :: Device -> HostAddress Source #
sendMessage :: MonadLifx m => Device -> Message r -> m r Source #
Send a message and wait for a response.
broadcastMessage :: MonadLifx m => Message r -> m [(Device, r)] Source #
Broadcast a message and wait for responses.
discoverDevices :: MonadLifx m => Maybe Int -> m [Device] Source #
Search for devices on the local network. If an integer argument is given, wait until we have found that number of devices - otherwise just keep waiting until timeout.
A message we can send to a Device. r is the type of the expected response.
Constructors
Instances
| Eq (Message r) Source # | |
| Ord (Message r) Source # | |
| Show (Message r) Source # | |
Constructors
| HSBK | |
Fields
| |
Instances
| Eq HSBK Source # | |
| Ord HSBK Source # | |
| Show HSBK Source # | |
| Generic HSBK Source # | |
| type Rep HSBK Source # | |
Defined in Lifx.Lan type Rep HSBK = D1 ('MetaData "HSBK" "Lifx.Lan" "lifx-lan-0.5.0.1-LcRkAADpR33H1DDbws1u5u" 'False) (C1 ('MetaCons "HSBK" 'PrefixI 'True) ((S1 ('MetaSel ('Just "hue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16) :*: S1 ('MetaSel ('Just "saturation") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16)) :*: (S1 ('MetaSel ('Just "brightness") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16) :*: S1 ('MetaSel ('Just "kelvin") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16)))) | |
Instances
| Monad m => Monad (LifxT m) Source # | |
| Functor m => Functor (LifxT m) Source # | |
| Monad m => Applicative (LifxT m) Source # | |
| MonadIO m => MonadIO (LifxT m) Source # | |
| MonadIO m => MonadLifx (LifxT m) Source # | |
Defined in Lifx.Lan Methods getSocket :: LifxT m Socket Source # getSource :: LifxT m Word32 Source # getTimeout :: LifxT m Int Source # incrementCounter :: LifxT m () Source # getCounter :: LifxT m Word8 Source # lifxThrow :: LifxError -> LifxT m a Source # handleOldMessage :: Word8 -> Word8 -> Word16 -> ByteString -> LifxT m () Source # | |
Constructors
Instances
class MonadIO m => MonadLifx m where Source #
A monad for sending and receiving LIFX messages.
Minimal complete definition
getSocket, getSource, getTimeout, incrementCounter, getCounter, lifxThrow
Methods
getSocket :: m Socket Source #
getSource :: m Word32 Source #
getTimeout :: m Int Source #
incrementCounter :: m () Source #
getCounter :: m Word8 Source #
lifxThrow :: LifxError -> m a Source #
Arguments
| :: Word8 | expected counter value |
| -> Word8 | actual counter value |
| -> Word16 | packet type |
| -> ByteString | payload |
| -> m () |
Instances
Responses
data StateService Source #
Constructors
| StateService | |
Fields
| |
Instances
Instances
| Eq Service Source # | |
| Ord Service Source # | |
| Show Service Source # | |
| Generic Service Source # | |
| type Rep Service Source # | |
Defined in Lifx.Lan type Rep Service = D1 ('MetaData "Service" "Lifx.Lan" "lifx-lan-0.5.0.1-LcRkAADpR33H1DDbws1u5u" 'False) ((C1 ('MetaCons "ServiceUDP" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ServiceReserved1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ServiceReserved2" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ServiceReserved3" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ServiceReserved4" 'PrefixI 'False) (U1 :: Type -> Type)))) | |
newtype StatePower Source #
Constructors
| StatePower | |
Instances
| Eq StatePower Source # | |
Defined in Lifx.Lan | |
| Ord StatePower Source # | |
Defined in Lifx.Lan Methods compare :: StatePower -> StatePower -> Ordering # (<) :: StatePower -> StatePower -> Bool # (<=) :: StatePower -> StatePower -> Bool # (>) :: StatePower -> StatePower -> Bool # (>=) :: StatePower -> StatePower -> Bool # max :: StatePower -> StatePower -> StatePower # min :: StatePower -> StatePower -> StatePower # | |
| Show StatePower Source # | |
Defined in Lifx.Lan Methods showsPrec :: Int -> StatePower -> ShowS # show :: StatePower -> String # showList :: [StatePower] -> ShowS # | |
| Generic StatePower Source # | |
| type Rep StatePower Source # | |
Defined in Lifx.Lan type Rep StatePower = D1 ('MetaData "StatePower" "Lifx.Lan" "lifx-lan-0.5.0.1-LcRkAADpR33H1DDbws1u5u" 'True) (C1 ('MetaCons "StatePower" 'PrefixI 'True) (S1 ('MetaSel ('Just "power") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word16))) | |
data LightState Source #
Constructors
| LightState | |
Instances
Low-level
deviceFromAddress :: (Word8, Word8, Word8, Word8) -> Device Source #
>>>deviceFromAddress (192, 168, 0, 1)192.168.0.1
Devices are really just HostAddresss, but you don't need to know that to use this library.
Prefer to get devices from discoverDevices where possible, rather than hardcoding addresses.
encodeMessage :: Bool -> Bool -> Word8 -> Word32 -> Message r -> ByteString Source #
Constructors
| Header | |
Fields
| |