{-# LANGUAGE OverloadedStrings #-}

module RuntimeSpec (spec) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async, cancel, race, waitCatch)
import Control.Exception (bracket)
import Control.Monad (forever)
import Control.Monad.IO.Class (liftIO)
import HomeAssistant.Runtime.Supervisor (supervised)
import Katip (LogEnv, closeScribes, initLogEnv, runKatipContextT)
import Test.Hspec

spec :: Spec
spec = describe "supervised" $ do
  it "propagates ThreadKilled instead of retrying" $
    withTestLogEnv $ \le -> do
      worker <- async $ runKatipContextT le () mempty $
        supervised "test" (liftIO (forever (threadDelay 100000)))
      threadDelay 200000
      cancel worker
      result <- race (threadDelay 5000000) (waitCatch worker)
      case result of
        Left () -> expectationFailure
          "supervised retried on ThreadKilled (process would hang)"
        Right _ -> pure ()

withTestLogEnv :: (LogEnv -> IO a) -> IO a
withTestLogEnv = bracket (initLogEnv "test" "test") closeScribes

-- I'm commenting out the test as that specific controller
-- was just a dummy for seeing how the data flows (dead code)
-- But leaving it commented as it retains some code sample on how and what to test
--
-- spec :: Spec
-- spec = describe "runController" $ do
--   it "feeds inbound events through the machine and forwards service calls" $ withBus severity appMetrics $ \bus -> do
--     _ <- async (runController bus (Controller "test" lightController True))
--     putStrLn "Before the delay"
--     threadDelay 100000 -- let the controller dup its inbound channel
--     putStrLn "After the delay"
--     atomically $ writeTChan (busInbound bus) (Event (doorEvent "on"))  -- initial value: no change event
--     atomically $ writeTChan (busInbound bus) (Event (doorEvent "off")) -- door closes: lights on
--     atomically $ writeTChan (busInbound bus) (Event (doorEvent "on"))  -- door opens: lights off
--     putStrLn "After the writes"
--     Right (_, svc1) <- boundedRead (busOutbound bus)
--     Right (_, svc2) <- boundedRead (busOutbound bus)
--     putStrLn "After the reads"
--     svc1 `shouldBe` light [EntityId "light.bedroom_masse"] True
--     svc2 `shouldBe` light [EntityId "light.bedroom_masse"] False
--     atomically (isEmptyTChan (busOutbound bus)) `shouldReturn` True
--   where
--     boundedRead channel = race (threadDelay 10000) (atomically (readTChan channel))
--
-- doorEvent :: Text -> Value
-- doorEvent state = object
--   [ "event" .= object
--     [ "variables" .= object
--       [ "trigger" .= object
--         [ "entity_id" .= ("binary_sensor.makuuhuone_ovi_contact" :: Text)
--         , "to_state" .= object ["state" .= state]
--         ]
--       ]
--     ]
--   ]