Fix warnings

src/AFRP.hs

@@ -21,7 +21,7 @@ module AFRP
 
 import Control.Category (Category(..), (>>>))
 import Prelude hiding ((.), id)
-import Control.Arrow (Arrow(..), ArrowChoice(..), ArrowLoop(..), returnA)
+import Control.Arrow (Arrow(..), ArrowChoice(..), ArrowLoop(..))
 import Data.Time (UTCTime)
 import Control.Monad.Fix (MonadFix (mfix))
 import Data.Either (fromLeft)

src/HomeAssistant/Controller.hs

@@ -24,8 +24,8 @@ module HomeAssistant.Controller
   , lightController
   ) where
 
-import AFRP (Mealy, eff, Event(..), hold, events, changes, mapAccum, filterA, (>>|), toEvent)
-import Control.Arrow (Arrow(..), ArrowChoice(..), returnA)
+import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
+import Control.Arrow (Arrow(..), returnA)
 import Control.Category ((>>>))
 import Data.Aeson (Value)
 import qualified Data.Text as T
@@ -63,15 +63,6 @@ data Ruuvi = Ruuvi { ruuviTemperature :: Double, ruuviPressure :: Double }
 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)
 
@@ -101,9 +92,6 @@ lightController = proc ev -> do
 
 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
@@ -123,13 +111,10 @@ entityBool' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe
     toBool = \case
       "on" -> True
       "off" -> False
+      _ -> 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

src/HomeAssistant/Runtime.hs

@@ -9,6 +9,7 @@ module HomeAssistant.Runtime
   , CallIdGen
   , mkCallIdGen
   , hassEval
+  , dryRunHassEval
   , receiveJSON
   , wsCallService
   ) where
@@ -21,7 +22,7 @@ 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.Time (getCurrentTime)
 import Data.IORef (newIORef, atomicModifyIORef')
 
 step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
@@ -72,7 +73,7 @@ app gen token conn = do
     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
+      (x, f') <- step (dryRunHassEval gen) f decoded
       mapM_ print x
       go f'
 
@@ -112,6 +113,12 @@ 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)
-    -- wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
   Pure a -> pure a