{-# LANGUAGE OverloadedStrings #-}

module Support
  ( Acc(..)
  , interp
  , runHASS
  , services
  , fakeRequest
  , sec
  , stateEvent
  , buttonEvent
  ) where

import Control.Monad.Fix (MonadFix (..))
import Data.Aeson (Value, object, (.=))
import qualified Data.Text as T
import Data.Time (UTCTime (..))
import Data.UUID (nil)
import AFRP (Mealy (..), Request (..))
import HomeAssistant.Controller (HASSEff (..), Service)

fakeRequest :: Request
fakeRequest = Request (sec 0) nil

sec :: Integer -> UTCTime
sec n = UTCTime (toEnum 0) (fromIntegral n)

-- | A pure Writer-like monad accumulating `Service` calls per step.
newtype Acc a = Acc { runAcc :: [Service] -> (a, [Service]) }

instance Functor Acc where
  fmap f (Acc g) = Acc $ \s -> let (a, s') = g s in (f a, s')

instance Applicative Acc where
  pure a = Acc (\s -> (a, s))
  Acc f <*> Acc x = Acc $ \s -> let (f', s') = f s; (a, s'') = x s' in (f' a, s'')

instance Monad Acc where
  Acc m >>= k = Acc $ \s -> let (a, s') = m s; (b, s'') = runAcc (k a) s' in (b, s'')

instance MonadFix Acc where
  mfix f = Acc $ \s -> let (a, s') = runAcc (f a) s in (a, s')

-- | Interpret `HASSEff` in `Acc`: record `CallService`, drop tracing/debug.
interp :: HASSEff a -> Acc a
interp (CallService _ svc) = Acc $ \s -> ((), s ++ [svc])
interp (Debug _) = pure ()
interp (Trace _ _) = pure ()

-- | Run a HASS arrow over a list of inputs, collecting per-step emitted services.
runHASS :: Mealy HASSEff a b -> [a] -> [(b, [Service])]
runHASS _ [] = []
runHASS m (a : as) =
  case runAcc (runMealy m interp fakeRequest a) [] of
    ((b, m'), svcs) -> (b, svcs) : runHASS m' as

services :: [(b, [Service])] -> [[Service]]
services = map snd

-- | Build a state-change event payload matching `entityChangeEvent'` / `entityBool'` lenses.
stateEvent :: T.Text -> T.Text -> Value
stateEvent entityId state = object
  [ "event" .= object
    [ "data" .= object
      [ "entity_id" .= entityId
      , "new_state" .= object [ "state" .= state ]
      ]
    ]
  ]

-- | Build an Ikea button event payload matching `ikeaQuickButton` lenses.
buttonEvent :: T.Text -> T.Text -> Value
buttonEvent entityId eventType = object
  [ "event" .= object
    [ "data" .= object
      [ "entity_id" .= entityId
      , "new_state" .= object
        [ "attributes" .= object [ "event_type" .= eventType ] ]
      ]
    ]
  ]