{-# LANGUAGE OverloadedStrings #-}

-- Module     : Hsm.Core.Fsm
-- Maintainer : contact@pauloliver.dev
module Hsm.Core.Fsm
  ( Method (Method)
  , FsmC
  , fsm
  )
where

import Control.Exception.Safe (Exception, catch, displayException)
import Data.Text (Text, pack)
import Effectful ((:>))
import Effectful.Log (Log, localDomain, logAttention_, logTrace_)
import Effectful.Reader.Static (Reader)
import Effectful.State.Static.Local (State)
import GHC.Records (HasField)
import Hsm.Core.Pipes (Pipe)

data Method a b e s x es = Method Text (Pipe a b e s es (Method a b e s x es))

type FsmC e s x es = (HasField "name" e Text, Exception x, Log :> es, Reader e :> es, State s :> es)

-- Builds an FSM with an initial and a default method. Because both @Proxy@
-- and @Eff@ are instances of @MonadCatch@ and @MonadThrow@, exceptions may be
-- thrown from within state methods. The FSM transitions to its default state
-- if an exception is thrown.
fsm :: forall a b e s x es. FsmC e s x es => Method a b e s x es -> Method a b e s x es -> Pipe a b e s es ()
fsm actionInit actionDefault = localDomain "fsm" $ run actionInit
 where
  run :: Method a b e s x es -> Pipe a b e s es ()
  run (Method name action) = do
    logTrace_ $ "Entering state " <> name
    next <- localDomain name action `catch` handle
    logTrace_ $ "Exiting state " <> name
    run next
   where
    handle :: x -> Pipe a b e s es (Method a b e s x es)
    handle exception = do
      logAttention_ $ "Exception caught while on state " <> name
      logAttention_ $ pack $ displayException exception
      return actionDefault