Rename light command layer (Light, LightSettings, BrightnessSettings)
This commit is contained in:
@@ -3,6 +3,7 @@
|
|||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE MonadComprehensions #-}
|
{-# LANGUAGE MonadComprehensions #-}
|
||||||
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
|
||||||
module HomeAssistant.Controller
|
module HomeAssistant.Controller
|
||||||
( Service(..)
|
( Service(..)
|
||||||
@@ -30,7 +31,7 @@ module HomeAssistant.Controller
|
|||||||
, switch
|
, switch
|
||||||
, Target(..)
|
, Target(..)
|
||||||
, brightness
|
, brightness
|
||||||
, Light(..)
|
, LightCommand(..)
|
||||||
, lightSignal
|
, lightSignal
|
||||||
, LightStatus(..)
|
, LightStatus(..)
|
||||||
, ikeaQuickButton
|
, ikeaQuickButton
|
||||||
@@ -40,9 +41,9 @@ module HomeAssistant.Controller
|
|||||||
, activateSceneWith
|
, activateSceneWith
|
||||||
, ikeaBoxRemote
|
, ikeaBoxRemote
|
||||||
, IkeaController(..)
|
, IkeaController(..)
|
||||||
, LightSettings(..)
|
, LightAttributes(..)
|
||||||
, BrightnessSettings(..)
|
, Brightness(..)
|
||||||
, formatLightSettings
|
, formatLightAttributes
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge)
|
import AFRP (Mealy (..), eff, Event(..), events, filterA, (>>|), toEvent, Request, hold, lMerge, waitFor, tag, edge)
|
||||||
@@ -152,44 +153,43 @@ motionToPresence delay = (eventOccupied &&& eventUnoccupied)
|
|||||||
|
|
||||||
instance Serialize Motion
|
instance Serialize Motion
|
||||||
|
|
||||||
data BrightnessSettings = BrightnessPercentage Double | Brightness Int
|
data Brightness = BrightnessPercent Double | BrightnessAbsolute Int
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
instance Default BrightnessSettings where
|
instance Default Brightness where
|
||||||
|
|
||||||
data LightSettings = LightSettings
|
data LightAttributes = LightAttributes
|
||||||
{ lightSettingsBrightness :: Maybe BrightnessSettings
|
{ lightBrightness :: Maybe Brightness
|
||||||
, lightSettingsTemperature :: Maybe Int
|
, lightColorTemperature :: Maybe Int
|
||||||
, lightSettingsTransition :: Maybe Double
|
, lightTransition :: Maybe Double
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
|
|
||||||
|
|
||||||
instance Default LightSettings where
|
instance Default LightAttributes where
|
||||||
|
|
||||||
|
|
||||||
formatLightSettings :: LightSettings -> Maybe Value
|
formatLightAttributes :: LightAttributes -> Maybe Value
|
||||||
formatLightSettings s = toObject $ catMaybes
|
formatLightAttributes LightAttributes{lightBrightness, lightColorTemperature, lightTransition} = toObject $ catMaybes
|
||||||
[ ["transition" .= x | x <- lightSettingsTransition s]
|
[ ["transition" .= x | x <- lightTransition]
|
||||||
, ["color_temp_kelvin" .= k | k <- lightSettingsTemperature s]
|
, ["color_temp_kelvin" .= k | k <- lightColorTemperature]
|
||||||
, ["brightness" .= b | Brightness b <- lightSettingsBrightness s]
|
, ["brightness" .= b | BrightnessAbsolute b <- lightBrightness]
|
||||||
, ["brightness_pct" .= b | BrightnessPercentage b <- lightSettingsBrightness s]
|
, ["brightness_pct" .= b | BrightnessPercent b <- lightBrightness]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
toObject :: [Pair] -> Maybe Value
|
toObject :: [Pair] -> Maybe Value
|
||||||
toObject [] = Nothing
|
toObject [] = Nothing
|
||||||
toObject xs = Just $ object xs
|
toObject xs = Just $ object xs
|
||||||
|
|
||||||
data Light
|
data LightCommand
|
||||||
= Off
|
= Off
|
||||||
| On LightSettings
|
| On LightAttributes
|
||||||
|
|
||||||
-- Turn off lights when door is closed
|
-- Turn off lights when door is closed
|
||||||
light :: [Target] -> Light -> Service
|
light :: [Target] -> LightCommand -> Service
|
||||||
light targets (On settings) = Service
|
light targets (On settings) = Service
|
||||||
{ serviceDomain="light"
|
{ serviceDomain="light"
|
||||||
, serviceName= "turn_on"
|
, serviceName= "turn_on"
|
||||||
-- , serviceData= fmap (\pct -> object ["brightness_pct" .= pct]) brightnessPercentage
|
, serviceData= formatLightAttributes settings
|
||||||
, serviceData= formatLightSettings settings
|
|
||||||
, serviceTarget=targets
|
, serviceTarget=targets
|
||||||
}
|
}
|
||||||
light targets Off = Service
|
light targets Off = Service
|
||||||
|
|||||||
@@ -79,8 +79,8 @@ bedroomPresenceController = proc x -> do
|
|||||||
toLight :: T.Text -> LightStatus -> [Service]
|
toLight :: T.Text -> LightStatus -> [Service]
|
||||||
toLight entityId LightStatus{lightEnabled=False} = [light [EntityId entityId] Off]
|
toLight entityId LightStatus{lightEnabled=False} = [light [EntityId entityId] Off]
|
||||||
toLight entityId LightStatus{lightEnabled=True, lightTemperature=t, lightBrightness=b} =
|
toLight entityId LightStatus{lightEnabled=True, lightTemperature=t, lightBrightness=b} =
|
||||||
[ light [EntityId entityId] (On def{lightSettingsTemperature=Just t})
|
[ light [EntityId entityId] (On def{lightColorTemperature=Just t})
|
||||||
, light [EntityId entityId] (On def{lightSettingsTransition=Just 5, lightSettingsBrightness=Just (Brightness b)})
|
, light [EntityId entityId] (On def{lightTransition=Just 5, lightBrightness=Just (BrightnessAbsolute b)})
|
||||||
]
|
]
|
||||||
doSnapshot = presenceLightEvents
|
doSnapshot = presenceLightEvents
|
||||||
>>> arr (\ev -> if ev == Event LightsSleep then Event () else Tick)
|
>>> arr (\ev -> if ev == Event LightsSleep then Event () else Tick)
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-# LANGUAGE Arrows #-}
|
{-# LANGUAGE Arrows #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module HomeAssistant.Controller.Children where
|
module HomeAssistant.Controller.Children where
|
||||||
import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, Light(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightSettings (..), BrightnessSettings (..))
|
import HomeAssistant.Controller (HASS, callService, Target (AreaId), light, LightCommand(..), ikeaQuickButton, IkeaGesture (..), IkeaButton (..), traceEvent, activateScene, LightAttributes (..), Brightness (..))
|
||||||
import AFRP (Event (..))
|
import AFRP (Event (..))
|
||||||
import qualified AFRP
|
import qualified AFRP
|
||||||
import Control.Arrow (Arrow(..), (>>>), returnA)
|
import Control.Arrow (Arrow(..), (>>>), returnA)
|
||||||
@@ -75,7 +75,7 @@ schoolLightController = lightsOn <> lightsOff
|
|||||||
|
|
||||||
lightsOn :: HASS a ()
|
lightsOn :: HASS a ()
|
||||||
lightsOn = foldMap atTime timersOn
|
lightsOn = foldMap atTime timersOn
|
||||||
>>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] (On def{lightSettingsBrightness=Just $ BrightnessPercentage 100} )))
|
>>> AFRP.onEvent (callService (light [AreaId "lasten_makuuhuone"] (On def{lightBrightness=Just $ BrightnessPercent 100} )))
|
||||||
|
|
||||||
lightsOff :: HASS a ()
|
lightsOff :: HASS a ()
|
||||||
lightsOff = foldMap atTime timersOff
|
lightsOff = foldMap atTime timersOff
|
||||||
|
|||||||
@@ -2,7 +2,7 @@
|
|||||||
{-# LANGUAGE Arrows #-}
|
{-# LANGUAGE Arrows #-}
|
||||||
module HomeAssistant.Controller.Hallway where
|
module HomeAssistant.Controller.Hallway where
|
||||||
|
|
||||||
import HomeAssistant.Controller (Presence (..), HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), Light (..))
|
import HomeAssistant.Controller (Presence (..), HASS, motion, motionToPresence, traceEvent, callServiceDyn, light, Target (..), LightCommand (..))
|
||||||
import AFRP (Event (..))
|
import AFRP (Event (..))
|
||||||
import qualified AFRP
|
import qualified AFRP
|
||||||
import Data.Aeson (Value)
|
import Data.Aeson (Value)
|
||||||
|
|||||||
@@ -2,7 +2,7 @@
|
|||||||
{-# LANGUAGE Arrows #-}
|
{-# LANGUAGE Arrows #-}
|
||||||
module HomeAssistant.Controller.Livingroom where
|
module HomeAssistant.Controller.Livingroom where
|
||||||
|
|
||||||
import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, Light (..), traceEvent, callService, activateScene)
|
import HomeAssistant.Controller (HASS, Presence (..), Target (..), presence, callServiceDyn, light, LightCommand (..), traceEvent, callService, activateScene)
|
||||||
import qualified AFRP
|
import qualified AFRP
|
||||||
import Control.Arrow ((>>>), Arrow (..), returnA)
|
import Control.Arrow ((>>>), Arrow (..), returnA)
|
||||||
import Data.Aeson (Value)
|
import Data.Aeson (Value)
|
||||||
|
|||||||
@@ -2,7 +2,7 @@
|
|||||||
module ControllerSpec where
|
module ControllerSpec where
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Data.Default (def)
|
import Data.Default (def)
|
||||||
import HomeAssistant.Controller (BrightnessSettings(..), formatLightSettings, LightSettings(..))
|
import HomeAssistant.Controller (Brightness(..), formatLightAttributes, LightAttributes(..))
|
||||||
import Data.Aeson (object, (.=))
|
import Data.Aeson (object, (.=))
|
||||||
import HomeAssistant.Controller ()
|
import HomeAssistant.Controller ()
|
||||||
|
|
||||||
@@ -11,19 +11,19 @@ spec :: Spec
|
|||||||
spec = describe "Generic controller" $
|
spec = describe "Generic controller" $
|
||||||
describe "Light settings" $ do
|
describe "Light settings" $ do
|
||||||
it "formats the default as empty" $
|
it "formats the default as empty" $
|
||||||
formatLightSettings def `shouldBe` Nothing
|
formatLightAttributes def `shouldBe` Nothing
|
||||||
it "formats the transition" $
|
it "formats the transition" $
|
||||||
formatLightSettings def{lightSettingsTransition=Just 5} `shouldBe`
|
formatLightAttributes def{lightTransition=Just 5} `shouldBe`
|
||||||
Just (object ["transition" .= (5 :: Int)])
|
Just (object ["transition" .= (5 :: Int)])
|
||||||
it "formats the temperature" $
|
it "formats the temperature" $
|
||||||
formatLightSettings def{lightSettingsTemperature=Just 5} `shouldBe`
|
formatLightAttributes def{lightColorTemperature=Just 5} `shouldBe`
|
||||||
Just (object ["color_temp_kelvin" .= (5 :: Int)])
|
Just (object ["color_temp_kelvin" .= (5 :: Int)])
|
||||||
it "formats the brightness as percentage" $
|
it "formats the brightness as percentage" $
|
||||||
formatLightSettings def{lightSettingsBrightness=Just (BrightnessPercentage 100)} `shouldBe`
|
formatLightAttributes def{lightBrightness=Just (BrightnessPercent 100)} `shouldBe`
|
||||||
Just (object ["brightness_pct" .= (100 :: Int)])
|
Just (object ["brightness_pct" .= (100 :: Int)])
|
||||||
it "formats the brightness as absolute" $
|
it "formats the brightness as absolute" $
|
||||||
formatLightSettings def{lightSettingsBrightness=Just (Brightness 200)} `shouldBe`
|
formatLightAttributes def{lightBrightness=Just (BrightnessAbsolute 200)} `shouldBe`
|
||||||
Just (object ["brightness" .= (200 :: Int)])
|
Just (object ["brightness" .= (200 :: Int)])
|
||||||
it "formats multiple values" $
|
it "formats multiple values" $
|
||||||
formatLightSettings def{lightSettingsTransition = Just 5, lightSettingsBrightness=Just (Brightness 200)} `shouldBe`
|
formatLightAttributes def{lightTransition = Just 5, lightBrightness=Just (BrightnessAbsolute 200)} `shouldBe`
|
||||||
Just (object ["brightness" .= (200 :: Int), "transition" .= (5 :: Int)])
|
Just (object ["brightness" .= (200 :: Int), "transition" .= (5 :: Int)])
|
||||||
|
|||||||
Reference in New Issue
Block a user