Run.hs

-- | Running a chart against a t'Def'. The functions generated by the @scxml@
-- quasiquoter are thin wrappers over these with t'Hooks' dispatching to the
-- callbacks named in the SCXML.
module Scxml.Statechart.Run
  ( Hooks (..)
  , Phase (..)
  , entryAction
  , exitAction
  , start
  , stepOrStay
  ) where

import Data.Maybe (fromMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T

import Scxml.Statechart.Def
import qualified Scxml.Statechart.Interpret as I
import Scxml.Statechart.Interpret (Phase (..))
import Scxml.Statechart.Model (StateId)

-- | How to run the callbacks named in @<script>@ elements.
newtype Hooks m s ev = Hooks
  { runAction :: Phase -> Text -> s -> Maybe ev -> m (Maybe ev)
    -- ^ run the named callback with the state it observes (the state being
    -- left for 'OnExit', the state being entered otherwise) and the event
    -- being processed ('Nothing' during 'start'); returns an event to raise
  }

-- | Marks an entry callback, which returns the event it raises, if any.
-- Raised events are queued and processed before the current step returns,
-- like SCXML's @<raise>@. Only here so that a callback with the wrong type
-- gets an error pointing at it.
entryAction :: m (Maybe ev) -> m (Maybe ev)
entryAction = id

-- | Marks an exit callback, which may not raise events. Only here so that a
-- callback with the wrong type gets an error pointing at it.
exitAction :: m () -> m ()
exitAction = id

toInterp :: Monad m => Def s ev -> Hooks m s ev -> I.Callbacks m
toInterp def h =
  I.Callbacks $ \phase name cfg ev ->
    fmap (defEventName def) <$> runAction h phase name (unsafeFromConfig def cfg) (typedEvent def <$> ev)

-- | The generator emits a constructor for every event name the interpreter can
-- produce, including a @done.state@ event for every state that can complete,
-- so this cannot fail for a chart the quasiquoter built.
typedEvent :: Def s ev -> Text -> ev
typedEvent def t =
  fromMaybe
    (error ("Statechart: no constructor for the event " ++ show (T.unpack t) ++ "; this is a bug in scxml-statecharts"))
    (defEventFromName def t)

unsafeFromConfig :: Def s ev -> Set.Set StateId -> s
unsafeFromConfig def cfg =
  fromMaybe
    (error ("Statechart: interpreter produced an invalid configuration: " ++ show (map T.unpack (Set.toList cfg))))
    (defFromConfig def cfg)

-- | Enter the initial state, running entry callbacks and any events they raise.
start :: Monad m => Def s ev -> Hooks m s ev -> m s
start def h = unsafeFromConfig def <$> I.start (defChart def) (toInterp def h)

-- | Deliver one event, staying in the current state when no transition is
-- enabled for it, which is SCXML's behaviour for an unmatched event.
stepOrStay :: Monad m => Def s ev -> Hooks m s ev -> s -> ev -> m s
stepOrStay def h s e =
  maybe s (unsafeFromConfig def)
    <$> I.macrostep (defChart def) (toInterp def h) (defToConfig def s) (defEventName def e)