{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.ByteString (ByteString)
import Data.Function ((&))
import Data.Set (Set, singleton)
import Data.Text (Text, pack)
import Effectful (Eff, (:>), runEff)
import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
import Effectful.Log (Log, LogLevel(LogAttention), runLog)
import Effectful.Reader.Static (Reader, asks, runReader)
import Effectful.Resource (runResource)
import Effectful.State.Static.Local (evalState)
import Hsm.Core.App (launch)
import Hsm.Core.Env (deriveFromYaml)
import Hsm.Core.Fsm qualified as F
import Hsm.Core.Message (body)
import Hsm.Core.Zmq.Client (poll, runClient)
import Hsm.GPIO qualified as G
import Hsm.Status.Error (Error(Error))
import Streamly.Data.Fold qualified as S (drain)
import Streamly.Data.Stream qualified as S (Stream, fold, mapM)
import System.IO.Echo (withoutInputEcho)

data Env = Env
  { name :: Text
  , gpioOk :: G.GPIO
  , gpioError :: G.GPIO
  , period :: Word
  , subEps :: [Text]
  , topics :: [Text]
  }

$(deriveFromYaml ''Env)

result ::
     Bool
  -> F.FsmState [ByteString] Bool Env ()
  -> [ByteString]
  -> F.FsmOutput [ByteString] Bool Env ()
result sta next errs =
  F.FsmOutput (Just $ F.FsmResult sta () next) (logError <$> errs)
  where
    logError err =
      let Error code msg = body err
       in ( LogAttention
          , "Error received with code "
              <> pack (show code)
              <> " and message: "
              <> msg)

stateOk :: F.FsmState [ByteString] Bool Env ()
stateOk =
  F.FsmState "ok" $ \errs _ _ ->
    if null errs
      then result True stateOk errs
      else result False stateError errs

stateError :: F.FsmState [ByteString] Bool Env ()
stateError = F.FsmState "error" $ \errs _ _ -> result False stateError errs

handle ::
     (Concurrent :> es, G.GPIOEffect Bool :> es, Log :> es, Reader Env :> es)
  => S.Stream (Eff es) Bool
  -> Eff es ()
handle = S.fold S.drain . S.mapM handler
  where
    sleep = asks period >>= threadDelay . fromIntegral
    handler sta = do
      G.setPins G.active sta >> sleep
      G.setPins G.inactive sta >> sleep

mapper :: Env -> Bool -> Set G.GPIO
mapper env True = singleton env.gpioOk
mapper env False = singleton env.gpioError

-- Status Service: Periodically blinks a GPIO pin and listens for error
-- messages. Upon receiving an error, it switches to a different pin.
main :: IO ()
main =
  launch "status" withoutInputEcho $ \env logger level ->
    (poll & F.fsm @_ @_ @Env @() & handle)
      & runClient @Env
      & G.runGPIO @Env (mapper env)
      & runConcurrent
      & evalState ()
      & evalState stateOk
      & runLog env.name logger level
      & runReader env
      & runResource
      & runEff