# Module Split & Warning Cleanup Implementation Plan > **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking. **Goal:** Split the monolithic `src/MyLib.hs` into three vertically-separated modules and fix all compiler warnings, committing between changes. **Architecture:** Three modules: `AFRP` (generic Mealy/Event FRP machinery), `HomeAssistant.Controller` (HA domain: effects, entity parsers, controllers), `HomeAssistant.Runtime` (IO interpreter, websocket client, `defaultMain`). Two commits: mechanical split, then warning fixes. **Tech Stack:** Haskell, GHC 9.10.3, cabal, GHC2024 default language ## Global Constraints - Build tool: `cabal build` - GHC 9.10.3, `default-language: GHC2024` (provides `RankNTypes`, `TypeApplications`, `GADTSyntax` — do not re-declare these) - Warning baseline: cabal `common warnings` uses `-Wall`; verify with `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` - No test framework (test suite is a placeholder; testing is out of scope per spec) - Commit between every change (user instruction) - The only behavioral change: dormant `wsCallService` call is activated inside real `hassEval`, but `app` wires to `dryRunHassEval` to preserve current print-only behavior --- ## File Structure | File | Responsibility | Created/Modified | |---|---|---| | `src/AFRP.hs` | Generic Mealy/Event FRP machinery — zero HA knowledge | Created in Task 1 | | `src/HomeAssistant/Controller.hs` | HA domain: `HASSEff`, `Service`, entity parsers, controllers | Created in Task 1, edited in Task 2 | | `src/HomeAssistant/Runtime.hs` | IO interpreter, websocket client, `defaultMain` | Created in Task 1, edited in Task 2 | | `src/MyLib.hs` | (deleted) | Deleted in Task 1 | | `app/Main.hs` | Entry point; import updated | Modified in Task 1 | | `home-assistant-controller.cabal` | `exposed-modules` updated | Modified in Task 1 | --- ## Task 1: Split MyLib into AFRP, Controller, Runtime **Files:** - Create: `src/AFRP.hs` - Create: `src/HomeAssistant/Controller.hs` - Create: `src/HomeAssistant/Runtime.hs` - Delete: `src/MyLib.hs` - Modify: `app/Main.hs` - Modify: `home-assistant-controller.cabal` **Interfaces:** - `AFRP` produces: `Mealy(..)`, `eff`, `Event(..)`, `hold`, `events`, `switch`, `preMapAccum`, `preMapAccumUTCTime`, `mapAccum`, `mapAccumUTCTime`, `changes`, `whenA`, `filterA`, `thenA`, `(>>|)`, `toEvent` - `HomeAssistant.Controller` consumes from `AFRP`: `Mealy`, `eff`, `Event(..)`, `hold`, `events`, `changes`, `mapAccum`, `filterA`, `(>>|)`, `toEvent` - `HomeAssistant.Controller` produces: `Service(..)`, `HASSEff(..)`, `HASS`, `callService`, entity helpers, domain types/values, `lightController` - `HomeAssistant.Runtime` consumes from `AFRP`: `Mealy(..)`, `Event(..)`; from `HomeAssistant.Controller`: `HASSEff(..)`, `lightController`, `Service(..)` - `HomeAssistant.Runtime` produces: `defaultMain`, `app`, `step`, `CallIdGen`, `mkCallIdGen`, `hassEval`, `receiveJSON`, `wsCallService` After this task: build succeeds, 6 warnings remain (numericDirection, isEntity, state x2, toBool, conn). - [ ] **Step 1: Create `src/AFRP.hs`** ```haskell {-# LANGUAGE LambdaCase #-} module AFRP ( Mealy(..) , eff , Event(..) , hold , events , switch , preMapAccum , preMapAccumUTCTime , mapAccum , mapAccumUTCTime , changes , whenA , filterA , thenA , (>>|) , toEvent ) where import Control.Category (Category(..), (>>>)) import Prelude hiding ((.), id) import Control.Arrow (Arrow(..), ArrowChoice(..), ArrowLoop(..), returnA) import Data.Time (UTCTime) import Control.Monad.Fix (MonadFix (mfix)) import Data.Either (fromLeft) import Data.Bool (bool) newtype Mealy eff a b = Mealy { runMealy :: forall m. MonadFix m => (forall x. eff x -> m x) -> UTCTime -> a -> m (b, Mealy eff a b) } eff :: (a -> eff b) -> Mealy eff a b eff f = Mealy $ \nt _ x -> nt (f x) >>= \b -> pure (b, eff f) instance Category (Mealy eff) where id = Mealy (\_ _ x -> pure (x, id)) (Mealy f) . (Mealy g) = Mealy $ \nt t a -> do (b, g') <- g nt t a (c, f') <- f nt t b pure (c, f' . g') instance Arrow (Mealy eff) where arr f = Mealy $ \_ _ b -> pure (f b, arr f) first (Mealy f) = Mealy $ \nt t (b,d) -> do (c, f') <- f nt t b pure ((c, d), first f') instance ArrowChoice (Mealy eff) where left (Mealy f) = Mealy $ \nt t -> \case Left b -> do (c, f') <- f nt t b pure (Left c, left f') Right d -> pure (Right d, left (Mealy f)) instance ArrowLoop (Mealy eff) where loop (Mealy f) = Mealy $ \nt t b -> do ((c,_), f') <- mfix $ \((_,d), _) -> f nt t (b,d) pure (c, loop f') instance Functor (Mealy eff a) where fmap f (Mealy g) = Mealy $ \nt t a -> do (b, g') <- g nt t a pure (f b, fmap f g') instance Applicative (Mealy eff a) where pure b = Mealy $ \_ _ _ -> pure (b, pure b) Mealy f <*> Mealy x = Mealy $ \nt t a -> do (f', fNext) <- f nt t a (x', xNext) <- x nt t a pure (f' x', fNext <*> xNext) data Event a = Tick | Event a deriving (Show, Functor, Foldable, Traversable) hold :: a -> Mealy eff (Event a) a hold a = Mealy $ \_ _ -> \case Tick -> pure (a, hold a) Event a' -> pure (a', hold a') events :: Mealy eff (Event a) (Either () a) events = arr $ \case Tick -> Left () Event a -> Right a switch :: Mealy eff a (b, Event c) -> (c -> Mealy eff a b) -> Mealy eff a b switch (Mealy f) s = Mealy $ \nt t a -> do ((b, ev), f') <- f nt t a case ev of Tick -> pure (b, switch f' s) Event x -> runMealy (s x) nt t a preMapAccum :: (x -> a -> x) -> x -> (x -> b) -> Mealy eff a b preMapAccum f x extract = go x where go b = Mealy $ \_ _ a -> let next = f b a in pure (extract b, go next) preMapAccumUTCTime :: (UTCTime -> x -> a -> x) -> x -> (x -> b) -> Mealy eff a b preMapAccumUTCTime f x extract = go x where go b = Mealy $ \_ t a -> let next = f t b a in pure (extract b, go next) mapAccum :: (x -> a -> x) -> x -> (x -> b) -> Mealy eff a b mapAccum f x extract = go x where go b = Mealy $ \_ _ a -> let next = f b a in pure (extract next, go next) mapAccumUTCTime :: (UTCTime -> x -> a -> x) -> x -> (x -> b) -> Mealy eff a b mapAccumUTCTime f x extract = go x where go b = Mealy $ \_ t a -> let next = f t b a in pure (extract next, go next) changes :: Eq a => Mealy eff a (Event a) changes = mapAccum go Nothing (maybe Tick snd) where go :: Eq a => Maybe (a, Event a) -> a -> Maybe (a, Event a) -- The first observed value is not a change I think go Nothing x = Just (x, Tick) go (Just (y, _)) x | x == y = Just (x, Tick) | otherwise = Just (x, Event x) whenA :: (a -> Bool) -> Mealy eff a () -> Mealy eff a () whenA predicate auto = arr (\a -> if predicate a then Left a else Right ()) >>> left auto >>> arr (fromLeft ()) filterA :: (a -> Bool) -> Mealy eff a (Either () a) filterA f = arr $ \a -> bool (Left ()) (Right a) (f a) thenA :: (ArrowChoice cat, Arrow cat) => cat a (Either b1 c) -> cat c (Either b1 b2) -> cat a (Either b1 b2) thenA f g = f >>> arr Left ||| g (>>|) :: (ArrowChoice cat, Arrow cat) => cat a (Either b1 c) -> cat c (Either b1 b2) -> cat a (Either b1 b2) (>>|) = thenA infixl 1 >>| toEvent :: Mealy eff (Either () a) (Event a) toEvent = arr (either (const Tick) Event) ``` - [ ] **Step 2: Create the `src/HomeAssistant/` directory** Run: `mkdir -p src/HomeAssistant` - [ ] **Step 3: Create `src/HomeAssistant/Controller.hs`** Note: This is the Task 1 version — it still contains `numericDirection`, dead `where` clauses, and non-exhaustive `toBool`. Those are fixed in Task 2. ```haskell {-# LANGUAGE Arrows #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GADTs #-} module HomeAssistant.Controller ( Service(..) , HASSEff(..) , HASS , callService , entityChangeEvent , entityChangeEvent' , entityRead , entityRead' , entityBool , entityBool' , Ruuvi(..) , ruuvi , ruuviTemperatures , ruuviPressures , DoorState(..) , door , light , lightController ) where import AFRP (Mealy, eff, Event(..), hold, events, changes, mapAccum, filterA, (>>|), toEvent) import Control.Arrow (Arrow(..), ArrowChoice(..), returnA) import Control.Category ((>>>)) import Data.Aeson (Value) import qualified Data.Text as T import Control.Lens (has, only, (^?), to) import Data.Aeson.Lens (key, _String) import qualified Data.Text.Lens as TL import Data.Bool (bool) data Service = Service { serviceDomain :: T.Text , serviceName :: T.Text , serviceData :: Maybe Value , serviceTarget :: T.Text } deriving Show data HASSEff a where CallService :: Service -> HASSEff () Pure :: a -> HASSEff a type HASS a b = Mealy HASSEff a b callService :: Service -> HASS a () callService service = eff (\_ -> CallService service) ruuviTemperatures :: Mealy eff (Event Value) Double ruuviTemperatures = entityRead @Double "sensor.ruuvitag_b168_temperature" >>> hold 0 ruuviPressures :: Mealy eff (Event Value) Double ruuviPressures = entityRead "sensor.ruuvitag_b168_pressure" >>> hold 0 data Ruuvi = Ruuvi { ruuviTemperature :: Double, ruuviPressure :: Double } deriving (Show, Eq) ruuvi :: Mealy eff (Event Value) (Event Ruuvi) ruuvi = (Ruuvi <$> ruuviTemperatures <*> ruuviPressures) >>> changes data Direction = Increase | Decrease | Steady deriving (Show, Eq) numericDirection = mapAccum go (Nothing, Nothing) extract where go (_, old) new = (old, new) extract :: (Maybe Double, Maybe Double) -> Direction extract (old, new) = maybe Steady (\x -> if x > 0 then Increase else Decrease) $ (-) <$> old <*> new data DoorState = Open | Closed deriving (Show, Eq) door :: HASS (Event Value) (Event DoorState) door = entityBool "binary_sensor.makuuhuone_ovi_contact" >>> arr (fmap (bool Closed Open)) >>> hold Open >>> changes -- Turn off lights when door is closed light :: Bool -> Service light b = Service { serviceDomain="light" , serviceName= bool "turn_off" "turn_on" b , serviceData=Nothing , serviceTarget="light.bedroom_masse" } lightController :: HASS (Event Value) (Event DoorState) lightController = proc ev -> do doorState <- door -< ev case doorState of Event Open -> callService (light False) -< () Event Closed -> callService (light True) -< () _ -> returnA -< () returnA -< doorState entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value) entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent where isEntity :: Value -> Bool isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId) entityChangeEvent' :: T.Text -> Mealy eff (Event Value) (Either () Value) entityChangeEvent' entityId = events >>| filterA isEntity where isEntity :: Value -> Bool isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId) entityRead' :: (Read a) => T.Text -> Mealy eff (Event Value) (Either () a) entityRead' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right)) where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read entityBool' :: T.Text -> Mealy eff (Event Value) (Either () Bool) entityBool' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right)) where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to toBool toBool = \case "on" -> True "off" -> False entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a) entityRead entityId = entityRead' entityId >>> toEvent where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool) entityBool entityId = entityBool' entityId >>> toEvent where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read ``` - [ ] **Step 4: Create `src/HomeAssistant/Runtime.hs`** Note: This is the Task 1 version — `hassEval` still has the commented-out `wsCallService` call and `conn` is unused. `dryRunHassEval` does not exist yet. Both are addressed in Task 2. ```haskell {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GADTs #-} module HomeAssistant.Runtime ( defaultMain , app , step , CallIdGen , mkCallIdGen , hassEval , receiveJSON , wsCallService ) where import AFRP (Mealy(..), Event(..)) import HomeAssistant.Controller (HASSEff(..), lightController, Service(..)) import Data.Aeson ((.=), Value (Null), encode, eitherDecode, object) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Network.WebSockets as WS import Network.Socket (withSocketsDo) import System.Environment (getEnv) import Data.Time (UTCTime, getCurrentTime) import Data.IORef (newIORef, atomicModifyIORef') step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b) step nt (Mealy f) a = do now <- getCurrentTime f nt now a defaultMain :: IO () defaultMain = withSocketsDo $ do token <- getEnv "HA_TOKEN" gen <- mkCallIdGen 0 WS.runClient "last-resort-redux" 8123 "/api/websocket" (app gen token) app :: CallIdGen -> String -> WS.ClientApp () app gen token conn = do -- HA speaks first: {"type":"auth_required", ...} authRequired <- receiveJSON conn print authRequired WS.sendTextData conn $ encode $ object [ "type" .= ("auth" :: T.Text) , "access_token" .= token ] -- Expect {"type":"auth_ok", ...} authResult <- receiveJSON conn print authResult getStateId <- generateCallId gen WS.sendTextData conn $ encode $ object [ "id" .= getStateId , "type" .= ("get_states" :: T.Text) ] msg <- WS.receiveData conn :: IO BL.ByteString BL.writeFile "/tmp/states.json" msg subscribeId <- generateCallId gen -- Subscription 1: all entity state changes WS.sendTextData conn $ encode $ object [ "id" .= subscribeId , "type" .= ("subscribe_events" :: T.Text) , "event_type" .= ("state_changed" :: T.Text) ] go lightController where go f = do msg <- WS.receiveData conn :: IO BL.ByteString let decoded = Event $ either (const Null) id $ eitherDecode @Value msg (x, f') <- step (hassEval gen conn) f decoded mapM_ print x go f' receiveJSON :: WS.Connection -> IO Value receiveJSON conn = do msg <- WS.receiveData conn case eitherDecode msg of Left err -> fail $ "Invalid JSON from Home Assistant: " ++ err Right x -> pure x wsCallService :: WS.Connection -> Int -> T.Text -> T.Text -> T.Text -> IO () wsCallService conn requestId domain service entityId = WS.sendTextData conn $ encode $ object [ "id" .= requestId , "type" .= ("call_service" :: T.Text) , "domain" .= domain , "service" .= service , "target" .= object [ "entity_id" .= entityId ] ] newtype CallIdGen = CallIdGen { generateCallId :: IO Int } mkCallIdGen :: Int -> IO CallIdGen mkCallIdGen start = do gen <- newIORef start pure $ CallIdGen $ atomicModifyIORef' gen (\old -> let new = old + 1 in new `seq` (new, new)) hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a hassEval gen conn = \case CallService x -> do callId <- generateCallId gen print (callId, x) -- wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x) Pure a -> pure a ``` - [ ] **Step 5: Delete `src/MyLib.hs`** Run: `git rm src/MyLib.hs` - [ ] **Step 6: Update `app/Main.hs`** Replace the entire file content with: ```haskell module Main (main) where import qualified HomeAssistant.Runtime (defaultMain) main :: IO () main = do putStrLn "Hello, Haskell!" HomeAssistant.Runtime.defaultMain ``` - [ ] **Step 7: Update `home-assistant-controller.cabal`** In the `library` section, replace: ``` exposed-modules: MyLib ``` with: ``` exposed-modules: AFRP , HomeAssistant.Controller , HomeAssistant.Runtime ``` - [ ] **Step 8: Build to verify it compiles** Run: `cabal build` Expected: Build succeeds. Warnings appear for: `numericDirection`, `isEntity`, `state` (x2), `toBool` (non-exhaustive), `conn` (unused match). The `entityChangeEvent`, `entityRead'`, `entityRead`, and `wsCallService` warnings are resolved by the export lists. If the build fails, read the error, fix the issue, and rebuild before proceeding. - [ ] **Step 9: Commit** ```bash git add src/AFRP.hs src/HomeAssistant/Controller.hs src/HomeAssistant/Runtime.hs app/Main.hs home-assistant-controller.cabal git commit -m "Split MyLib into AFRP, Controller, Runtime" ``` --- ## Task 2: Fix warnings **Files:** - Modify: `src/HomeAssistant/Controller.hs` - Modify: `src/HomeAssistant/Runtime.hs` **Interfaces:** - `HomeAssistant.Runtime` new export: `dryRunHassEval :: CallIdGen -> HASSEff a -> IO a` - `HomeAssistant.Runtime` changed export list: add `dryRunHassEval` After this task: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` produces zero warnings. - [ ] **Step 1: Delete `Direction` and `numericDirection` from `Controller.hs`** Remove these lines from `src/HomeAssistant/Controller.hs`: ```haskell data Direction = Increase | Decrease | Steady deriving (Show, Eq) numericDirection = mapAccum go (Nothing, Nothing) extract where go (_, old) new = (old, new) extract :: (Maybe Double, Maybe Double) -> Direction extract (old, new) = maybe Steady (\x -> if x > 0 then Increase else Decrease) $ (-) <$> old <*> new ``` - [ ] **Step 2: Remove `mapAccum` from the AFRP import in `Controller.hs`** In `src/HomeAssistant/Controller.hs`, change: ```haskell import AFRP (Mealy, eff, Event(..), hold, events, changes, mapAccum, filterA, (>>|), toEvent) ``` to: ```haskell import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent) ``` - [ ] **Step 3: Delete dead `isEntity` from `entityChangeEvent` in `Controller.hs`** Change: ```haskell entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value) entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent where isEntity :: Value -> Bool isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId) ``` to: ```haskell entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value) entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent ``` - [ ] **Step 4: Delete dead `state` from `entityRead` in `Controller.hs`** Change: ```haskell entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a) entityRead entityId = entityRead' entityId >>> toEvent where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read ``` to: ```haskell entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a) entityRead entityId = entityRead' entityId >>> toEvent ``` - [ ] **Step 5: Delete dead `state` from `entityBool` in `Controller.hs`** Change: ```haskell entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool) entityBool entityId = entityBool' entityId >>> toEvent where state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read ``` to: ```haskell entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool) entityBool entityId = entityBool' entityId >>> toEvent ``` - [ ] **Step 6: Add catch-all to `toBool` in `entityBool'` in `Controller.hs`** Change: ```haskell toBool = \case "on" -> True "off" -> False ``` to: ```haskell toBool = \case "on" -> True "off" -> False _ -> False ``` - [ ] **Step 7: Add `dryRunHassEval` and fix `hassEval` in `Runtime.hs`** In `src/HomeAssistant/Runtime.hs`, change: ```haskell hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a hassEval gen conn = \case CallService x -> do callId <- generateCallId gen print (callId, x) -- wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x) Pure a -> pure a ``` to: ```haskell hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a hassEval gen conn = \case CallService x -> do callId <- generateCallId gen wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x) Pure a -> pure a dryRunHassEval :: CallIdGen -> HASSEff a -> IO a dryRunHassEval gen = \case CallService x -> do callId <- generateCallId gen print (callId, x) Pure a -> pure a ``` - [ ] **Step 8: Add `dryRunHassEval` to the export list in `Runtime.hs`** In `src/HomeAssistant/Runtime.hs`, change: ```haskell module HomeAssistant.Runtime ( defaultMain , app , step , CallIdGen , mkCallIdGen , hassEval , receiveJSON , wsCallService ) where ``` to: ```haskell module HomeAssistant.Runtime ( defaultMain , app , step , CallIdGen , mkCallIdGen , hassEval , dryRunHassEval , receiveJSON , wsCallService ) where ``` - [ ] **Step 9: Wire `app` to use `dryRunHassEval` in `Runtime.hs`** In `src/HomeAssistant/Runtime.hs`, inside the `go` function in `app`, change: ```haskell (x, f') <- step (hassEval gen conn) f decoded ``` to: ```haskell (x, f') <- step (dryRunHassEval gen) f decoded ``` - [ ] **Step 10: Build with full warning flags to verify zero warnings** Run: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` Expected: Build succeeds with zero warnings. If any warnings remain, read them, fix, and rebuild. - [ ] **Step 11: Commit** ```bash git add src/HomeAssistant/Controller.hs src/HomeAssistant/Runtime.hs git commit -m "Fix warnings" ```