{-# LANGUAGE PatternGuards #-}
module Transition
( buildTransition
) where
import When
import Driver.Log
---------------------------------------------------
{-
transition :: Event -> Transition State Event Responses
transition e ost
= buildTransition (==Init) triggers' nextState responses e ost
-}
------------------------------
buildTransition
:: Eq e
=> (e -> Bool) -- event is initial
-> [(st -> Bool, st -> (e, When))] -- trigger table
-> (e -> st -> Maybe st) -- transition
-> (e -> st -> st -> r) -- response
-> e -- event
-> Transition st e r
buildTransition isInit triggers nextState responses e ost
| Just st <- nextState e ost
= Just (Result
{ cancelled = cancelled_ e ost st
, triggered = reactions e ost st
, result = responses e ost st
}
, st)
| otherwise
= Nothing
where
reactions e ost st
= [ (w, t)
| (p, tw) <- triggers
, p st
, let (t, w) = tw st
, e == t || isInit e || not (p ost)
]
cancelled_ e ost st
= [ t
| (p, tw) <- triggers
, not (p st)
, p ost
, let (t, _) = tw st
, e /= t
]
{-
initReactions st
= [ (w, t)
| (p, tw) <- triggers
, p st
, let (t, w) = tw st
]
-}