From 2a1bca73d7f023753074cbdede5f6ca4c146d47c Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Thu, 20 Aug 2026 22:38:21 +0300
Subject: [PATCH] Code organization

---
 home-assistant-controller.cabal         |  1 +
 src/HomeAssistant/Controller.hs         | 39 ++------------------
 src/HomeAssistant/Controller/Bedroom.hs | 47 +++++++++++++++++++++++++
 src/HomeAssistant/Runtime.hs            |  3 +-
 4 files changed, 53 insertions(+), 37 deletions(-)
 create mode 100644 src/HomeAssistant/Controller/Bedroom.hs

diff --git a/home-assistant-controller.cabal b/home-assistant-controller.cabal
index 39471df..e1aa119 100644
--- a/home-assistant-controller.cabal
+++ b/home-assistant-controller.cabal
@@ -61,6 +61,7 @@ library
     -- Modules exported by the library.
     exposed-modules:  AFRP
                     , HomeAssistant.Controller
+                    , HomeAssistant.Controller.Bedroom
                     , HomeAssistant.Runtime
                     , HomeAssistant.Runtime.Bus
                     , HomeAssistant.Runtime.Connection
diff --git a/src/HomeAssistant/Controller.hs b/src/HomeAssistant/Controller.hs
index 150af6c..f395f6d 100644
--- a/src/HomeAssistant/Controller.hs
+++ b/src/HomeAssistant/Controller.hs
@@ -22,13 +22,14 @@ module HomeAssistant.Controller
   , door
   , light
   , lightController
-  , bedroomPresenceController
+  , Presence(..)
+  , presence
   ) where
 
 import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
 import Control.Arrow (Arrow(..), returnA)
 import Control.Category ((>>>))
-import Data.Aeson (Value, object, (.=))
+import Data.Aeson (Value)
 import qualified Data.Text as T
 import Control.Lens (has, only, (^?), to)
 import Data.Aeson.Lens (key, _String)
@@ -73,40 +74,6 @@ presence :: T.Text -> HASS (Event Value) (Event Presence)
 presence entityId =entityBool entityId
   >>> arr (fmap (bool Unoccupied Occupied))
 
-bedroomLights :: [T.Text]
-bedroomLights = ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"]
-
-createBedroomScene :: Service
-createBedroomScene = Service
-  { serviceDomain="scene"
-  , serviceName= "create"
-  , serviceData= Just $ object
-      [ "scene_id" .= ("makuuhuone_lights_snapshot" :: T.Text)
-      , "snapshot_entities" .= bedroomLights
-      ]
-  , serviceTarget= [] -- bedroomLights
-  }
-
-
-activateScene :: T.Text -> Service
-activateScene sceneId = Service
-  { serviceDomain="scene"
-  , serviceName= "turn_on"
-  , serviceTarget= [sceneId]
-  , serviceData = Nothing
-  }
-
--- Bedroom presence
-bedroomPresence :: HASS (Event Value) (Event Presence)
-bedroomPresence = presence "binary_sensor.presence_sensor_bedroom_occupancy"
-
-bedroomPresenceController :: HASS (Event Value) ()
-bedroomPresenceController = proc x -> do
-  p <- bedroomPresence -< x
-  case p of
-       Event Unoccupied -> callService createBedroomScene >>> callService (light bedroomLights False) -< ()
-       Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
-       _ -> returnA -< ()
 
 
 door :: HASS (Event Value) (Event DoorState)
diff --git a/src/HomeAssistant/Controller/Bedroom.hs b/src/HomeAssistant/Controller/Bedroom.hs
new file mode 100644
index 0000000..10367b5
--- /dev/null
+++ b/src/HomeAssistant/Controller/Bedroom.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE OverloadedStrings #-}
+module HomeAssistant.Controller.Bedroom where
+
+import HomeAssistant.Controller
+import qualified Data.Text as T
+import AFRP (Event (..))
+import Data.Aeson (Value, object, (.=))
+import Control.Arrow ((>>>), returnA)
+
+
+
+bedroomLights :: [T.Text]
+bedroomLights = ["light.bedroom_masse","light.bedroom_jemina","light.bedroom_ceiling","light.bedroom_led_switch"]
+
+createBedroomScene :: Service
+createBedroomScene = Service
+  { serviceDomain="scene"
+  , serviceName= "create"
+  , serviceData= Just $ object
+      [ "scene_id" .= ("makuuhuone_lights_snapshot" :: T.Text)
+      , "snapshot_entities" .= bedroomLights
+      ]
+  , serviceTarget= []
+  }
+
+
+activateScene :: T.Text -> Service
+activateScene sceneId = Service
+  { serviceDomain="scene"
+  , serviceName= "turn_on"
+  , serviceTarget= [sceneId]
+  , serviceData = Nothing
+  }
+
+-- Bedroom presence
+bedroomPresence :: HASS (Event Value) (Event Presence)
+bedroomPresence = presence "binary_sensor.presence_sensor_bedroom_occupancy"
+
+bedroomPresenceController :: HASS (Event Value) ()
+bedroomPresenceController = proc x -> do
+  p <- bedroomPresence -< x
+  case p of
+       Event Unoccupied -> callService createBedroomScene >>> callService (light bedroomLights False) -< ()
+       Event Occupied -> callService (activateScene "makuuhuone_lights_snapshot") -< ()
+       _ -> returnA -< ()
+
diff --git a/src/HomeAssistant/Runtime.hs b/src/HomeAssistant/Runtime.hs
index c9440e0..6957b59 100644
--- a/src/HomeAssistant/Runtime.hs
+++ b/src/HomeAssistant/Runtime.hs
@@ -20,12 +20,13 @@ import Data.Aeson (Value)
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
 import Data.Void (Void, absurd)
-import HomeAssistant.Controller (HASS, HASSEff (..), bedroomPresenceController)
+import HomeAssistant.Controller (HASS, HASSEff (..))
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Connection (readerAction, writerAction)
 import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
+import HomeAssistant.Controller.Bedroom (bedroomPresenceController)
 
 step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
 step nt (Mealy f) a = do