-- |
-- Module     : Simulation.Aivika.Agent
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This module introduces basic entities for the agent-based modeling.
--
module Simulation.Aivika.Agent
       (Agent,
        AgentState,
        newAgent,
        newState,
        newSubstate,
        selectedState,
        selectedStateChanged,
        selectedStateChanged_,
        selectState,
        stateAgent,
        stateParent,
        addTimeout,
        addTimer,
        setStateActivation,
        setStateDeactivation,
        setStateTransition) where

import Data.IORef
import Control.Monad

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal

--
-- Agent-based Modeling
--

-- | Represents an agent.
data Agent = Agent { Agent -> IORef AgentMode
agentModeRef            :: IORef AgentMode,
                     Agent -> IORef (Maybe AgentState)
agentStateRef           :: IORef (Maybe AgentState), 
                     Agent -> SignalSource (Maybe AgentState)
agentStateChangedSource :: SignalSource (Maybe AgentState) }

-- | Represents the agent state.
data AgentState = AgentState { AgentState -> Agent
stateAgent         :: Agent,
                               -- ^ Return the corresponded agent.
                               AgentState -> Maybe AgentState
stateParent        :: Maybe AgentState,
                               -- ^ Return the parent state or 'Nothing'.
                               AgentState -> IORef (Event ())
stateActivateRef   :: IORef (Event ()),
                               AgentState -> IORef (Event ())
stateDeactivateRef :: IORef (Event ()),
                               AgentState -> IORef (Event (Maybe AgentState))
stateTransitRef    :: IORef (Event (Maybe AgentState)),
                               AgentState -> IORef Int
stateVersionRef    :: IORef Int }
                  
data AgentMode = CreationMode
               | TransientMode
               | ProcessingMode
                      
instance Eq Agent where
  Agent
x == :: Agent -> Agent -> Bool
== Agent
y = Agent -> IORef (Maybe AgentState)
agentStateRef Agent
x IORef (Maybe AgentState) -> IORef (Maybe AgentState) -> Bool
forall a. Eq a => a -> a -> Bool
== Agent -> IORef (Maybe AgentState)
agentStateRef Agent
y      -- unique references
  
instance Eq AgentState where
  AgentState
x == :: AgentState -> AgentState -> Bool
== AgentState
y = AgentState -> IORef Int
stateVersionRef AgentState
x IORef Int -> IORef Int -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState -> IORef Int
stateVersionRef AgentState
y  -- unique references

fullPath :: AgentState -> [AgentState] -> [AgentState]
fullPath :: AgentState -> [AgentState] -> [AgentState]
fullPath AgentState
st [AgentState]
acc =
  case AgentState -> Maybe AgentState
stateParent AgentState
st of
    Maybe AgentState
Nothing  -> AgentState
st AgentState -> [AgentState] -> [AgentState]
forall a. a -> [a] -> [a]
: [AgentState]
acc
    Just AgentState
st' -> AgentState -> [AgentState] -> [AgentState]
fullPath AgentState
st' (AgentState
st AgentState -> [AgentState] -> [AgentState]
forall a. a -> [a] -> [a]
: [AgentState]
acc)

partitionPath :: [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath :: [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath [AgentState]
path1 [AgentState]
path2 =
  case ([AgentState]
path1, [AgentState]
path2) of
    (AgentState
h1 : [AgentState]
t1, [AgentState
h2]) | AgentState
h1 AgentState -> AgentState -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState
h2 -> 
      ([AgentState] -> [AgentState]
forall a. [a] -> [a]
reverse [AgentState]
path1, [AgentState]
path2)
    (AgentState
h1 : [AgentState]
t1, AgentState
h2 : [AgentState]
t2) | AgentState
h1 AgentState -> AgentState -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState
h2 -> 
      [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath [AgentState]
t1 [AgentState]
t2
    ([AgentState], [AgentState])
_ ->
      ([AgentState] -> [AgentState]
forall a. [a] -> [a]
reverse [AgentState]
path1, [AgentState]
path2)

findPath :: Maybe AgentState -> AgentState -> ([AgentState], [AgentState])
findPath :: Maybe AgentState -> AgentState -> ([AgentState], [AgentState])
findPath Maybe AgentState
Nothing AgentState
target = ([], AgentState -> [AgentState] -> [AgentState]
fullPath AgentState
target [])
findPath (Just AgentState
source) AgentState
target
  | AgentState -> Agent
stateAgent AgentState
source Agent -> Agent -> Bool
forall a. Eq a => a -> a -> Bool
/= AgentState -> Agent
stateAgent AgentState
target =
    [Char] -> ([AgentState], [AgentState])
forall a. HasCallStack => [Char] -> a
error [Char]
"Different agents: findPath."
  | Bool
otherwise =
    [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath [AgentState]
path1 [AgentState]
path2
  where
    path1 :: [AgentState]
path1 = AgentState -> [AgentState] -> [AgentState]
fullPath AgentState
source []
    path2 :: [AgentState]
path2 = AgentState -> [AgentState] -> [AgentState]
fullPath AgentState
target []

traversePath :: Maybe AgentState -> AgentState -> Event ()
traversePath :: Maybe AgentState -> AgentState -> Event ()
traversePath Maybe AgentState
source AgentState
target =
  let ([AgentState]
path1, [AgentState]
path2) = Maybe AgentState -> AgentState -> ([AgentState], [AgentState])
findPath Maybe AgentState
source AgentState
target
      agent :: Agent
agent = AgentState -> Agent
stateAgent AgentState
target
      activate :: AgentState -> Point -> IO ()
activate AgentState
st Point
p   = Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> IO (Event ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Event ()) -> IO (Event ())
forall a. IORef a -> IO a
readIORef (AgentState -> IORef (Event ())
stateActivateRef AgentState
st)
      deactivate :: AgentState -> Point -> IO ()
deactivate AgentState
st Point
p = Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> IO (Event ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Event ()) -> IO (Event ())
forall a. IORef a -> IO a
readIORef (AgentState -> IORef (Event ())
stateDeactivateRef AgentState
st)
      transit :: AgentState -> Point -> IO (Maybe AgentState)
transit AgentState
st Point
p    = Point -> Event (Maybe AgentState) -> IO (Maybe AgentState)
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event (Maybe AgentState) -> IO (Maybe AgentState))
-> IO (Event (Maybe AgentState)) -> IO (Maybe AgentState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Event (Maybe AgentState)) -> IO (Event (Maybe AgentState))
forall a. IORef a -> IO a
readIORef (AgentState -> IORef (Event (Maybe AgentState))
stateTransitRef AgentState
st)
      continue :: AgentState -> Point -> IO ()
continue AgentState
st Point
p   = Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe AgentState -> AgentState -> Event ()
traversePath (AgentState -> Maybe AgentState
forall a. a -> Maybe a
Just AgentState
target) AgentState
st
  in (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AgentState] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AgentState]
path1 Bool -> Bool -> Bool
&& [AgentState] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AgentState]
path2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       do IORef AgentMode -> AgentMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Agent -> IORef AgentMode
agentModeRef Agent
agent) AgentMode
TransientMode
          [AgentState] -> (AgentState -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AgentState]
path1 ((AgentState -> IO ()) -> IO ()) -> (AgentState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AgentState
st ->
            do IORef (Maybe AgentState) -> Maybe AgentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent) (AgentState -> Maybe AgentState
forall a. a -> Maybe a
Just AgentState
st)
               AgentState -> Point -> IO ()
deactivate AgentState
st Point
p
               -- it makes all timeout and timer handlers outdated
               IORef Int -> (Int -> Int) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef (AgentState -> IORef Int
stateVersionRef AgentState
st) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
          [AgentState] -> (AgentState -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AgentState]
path2 ((AgentState -> IO ()) -> IO ()) -> (AgentState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AgentState
st ->
            do IORef (Maybe AgentState) -> Maybe AgentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent) (AgentState -> Maybe AgentState
forall a. a -> Maybe a
Just AgentState
st)
               AgentState -> Point -> IO ()
activate AgentState
st Point
p
          Maybe AgentState
st' <- AgentState -> Point -> IO (Maybe AgentState)
transit AgentState
target Point
p
          case Maybe AgentState
st' of
            Maybe AgentState
Nothing ->
              do IORef AgentMode -> AgentMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Agent -> IORef AgentMode
agentModeRef Agent
agent) AgentMode
ProcessingMode
                 Point -> Agent -> IO ()
triggerAgentStateChanged Point
p Agent
agent
            Just AgentState
st' ->
              AgentState -> Point -> IO ()
continue AgentState
st' Point
p

-- | Add to the state a timeout handler that will be actuated 
-- in the specified time period if the state will remain active.
addTimeout :: AgentState -> Double -> Event () -> Event ()
addTimeout :: AgentState -> Double -> Event () -> Event ()
addTimeout AgentState
st Double
dt Event ()
action =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
v <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
     let m1 :: Event ()
m1 = (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Int
v' <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
action
         m2 :: Event ()
m2 = Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt) Event ()
m1
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m2

-- | Add to the state a timer handler that will be actuated
-- in the specified time period and then repeated again many times,
-- while the state remains active.
addTimer :: AgentState -> Event Double -> Event () -> Event ()
addTimer :: AgentState -> Event Double -> Event () -> Event ()
addTimer AgentState
st Event Double
dt Event ()
action =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
v <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
     let m1 :: Event ()
m1 = (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Int
v' <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                do Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m2
                   Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
action
         m2 :: Event ()
m2 = (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Double
dt' <- Point -> Event Double -> IO Double
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event Double
dt
              Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt') Event ()
m1
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m2

-- | Create a new state.
newState :: Agent -> Simulation AgentState
newState :: Agent -> Simulation AgentState
newState Agent
agent =
  (Run -> IO AgentState) -> Simulation AgentState
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO AgentState) -> Simulation AgentState)
-> (Run -> IO AgentState) -> Simulation AgentState
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do IORef (Event ())
aref <- Event () -> IO (IORef (Event ()))
forall a. a -> IO (IORef a)
newIORef (Event () -> IO (IORef (Event ())))
-> Event () -> IO (IORef (Event ()))
forall a b. (a -> b) -> a -> b
$ () -> Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event ())
dref <- Event () -> IO (IORef (Event ()))
forall a. a -> IO (IORef a)
newIORef (Event () -> IO (IORef (Event ())))
-> Event () -> IO (IORef (Event ()))
forall a b. (a -> b) -> a -> b
$ () -> Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event (Maybe AgentState))
tref <- Event (Maybe AgentState) -> IO (IORef (Event (Maybe AgentState)))
forall a. a -> IO (IORef a)
newIORef (Event (Maybe AgentState) -> IO (IORef (Event (Maybe AgentState))))
-> Event (Maybe AgentState)
-> IO (IORef (Event (Maybe AgentState)))
forall a b. (a -> b) -> a -> b
$ Maybe AgentState -> Event (Maybe AgentState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AgentState
forall a. Maybe a
Nothing
     IORef Int
vref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     AgentState -> IO AgentState
forall (m :: * -> *) a. Monad m => a -> m a
return AgentState :: Agent
-> Maybe AgentState
-> IORef (Event ())
-> IORef (Event ())
-> IORef (Event (Maybe AgentState))
-> IORef Int
-> AgentState
AgentState { stateAgent :: Agent
stateAgent = Agent
agent,
                         stateParent :: Maybe AgentState
stateParent = Maybe AgentState
forall a. Maybe a
Nothing,
                         stateActivateRef :: IORef (Event ())
stateActivateRef = IORef (Event ())
aref,
                         stateDeactivateRef :: IORef (Event ())
stateDeactivateRef = IORef (Event ())
dref,
                         stateTransitRef :: IORef (Event (Maybe AgentState))
stateTransitRef = IORef (Event (Maybe AgentState))
tref,
                         stateVersionRef :: IORef Int
stateVersionRef = IORef Int
vref }

-- | Create a child state.
newSubstate :: AgentState -> Simulation AgentState
newSubstate :: AgentState -> Simulation AgentState
newSubstate AgentState
parent =
  (Run -> IO AgentState) -> Simulation AgentState
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO AgentState) -> Simulation AgentState)
-> (Run -> IO AgentState) -> Simulation AgentState
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do let agent :: Agent
agent = AgentState -> Agent
stateAgent AgentState
parent 
     IORef (Event ())
aref <- Event () -> IO (IORef (Event ()))
forall a. a -> IO (IORef a)
newIORef (Event () -> IO (IORef (Event ())))
-> Event () -> IO (IORef (Event ()))
forall a b. (a -> b) -> a -> b
$ () -> Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event ())
dref <- Event () -> IO (IORef (Event ()))
forall a. a -> IO (IORef a)
newIORef (Event () -> IO (IORef (Event ())))
-> Event () -> IO (IORef (Event ()))
forall a b. (a -> b) -> a -> b
$ () -> Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event (Maybe AgentState))
tref <- Event (Maybe AgentState) -> IO (IORef (Event (Maybe AgentState)))
forall a. a -> IO (IORef a)
newIORef (Event (Maybe AgentState) -> IO (IORef (Event (Maybe AgentState))))
-> Event (Maybe AgentState)
-> IO (IORef (Event (Maybe AgentState)))
forall a b. (a -> b) -> a -> b
$ Maybe AgentState -> Event (Maybe AgentState)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AgentState
forall a. Maybe a
Nothing
     IORef Int
vref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
     AgentState -> IO AgentState
forall (m :: * -> *) a. Monad m => a -> m a
return AgentState :: Agent
-> Maybe AgentState
-> IORef (Event ())
-> IORef (Event ())
-> IORef (Event (Maybe AgentState))
-> IORef Int
-> AgentState
AgentState { stateAgent :: Agent
stateAgent = Agent
agent,
                         stateParent :: Maybe AgentState
stateParent = AgentState -> Maybe AgentState
forall a. a -> Maybe a
Just AgentState
parent,
                         stateActivateRef :: IORef (Event ())
stateActivateRef= IORef (Event ())
aref,
                         stateDeactivateRef :: IORef (Event ())
stateDeactivateRef = IORef (Event ())
dref,
                         stateTransitRef :: IORef (Event (Maybe AgentState))
stateTransitRef = IORef (Event (Maybe AgentState))
tref,
                         stateVersionRef :: IORef Int
stateVersionRef = IORef Int
vref }

-- | Create an agent.
newAgent :: Simulation Agent
newAgent :: Simulation Agent
newAgent =
  (Run -> IO Agent) -> Simulation Agent
forall a. (Run -> IO a) -> Simulation a
Simulation ((Run -> IO Agent) -> Simulation Agent)
-> (Run -> IO Agent) -> Simulation Agent
forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do IORef AgentMode
modeRef  <- AgentMode -> IO (IORef AgentMode)
forall a. a -> IO (IORef a)
newIORef AgentMode
CreationMode
     IORef (Maybe AgentState)
stateRef <- Maybe AgentState -> IO (IORef (Maybe AgentState))
forall a. a -> IO (IORef a)
newIORef Maybe AgentState
forall a. Maybe a
Nothing
     SignalSource (Maybe AgentState)
stateChangedSource <- Run
-> Simulation (SignalSource (Maybe AgentState))
-> IO (SignalSource (Maybe AgentState))
forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r Simulation (SignalSource (Maybe AgentState))
forall a. Simulation (SignalSource a)
newSignalSource
     Agent -> IO Agent
forall (m :: * -> *) a. Monad m => a -> m a
return Agent :: IORef AgentMode
-> IORef (Maybe AgentState)
-> SignalSource (Maybe AgentState)
-> Agent
Agent { agentModeRef :: IORef AgentMode
agentModeRef = IORef AgentMode
modeRef,
                    agentStateRef :: IORef (Maybe AgentState)
agentStateRef = IORef (Maybe AgentState)
stateRef, 
                    agentStateChangedSource :: SignalSource (Maybe AgentState)
agentStateChangedSource = SignalSource (Maybe AgentState)
stateChangedSource }

-- | Return the selected active state.
selectedState :: Agent -> Event (Maybe AgentState)
selectedState :: Agent -> Event (Maybe AgentState)
selectedState Agent
agent =
  (Point -> IO (Maybe AgentState)) -> Event (Maybe AgentState)
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO (Maybe AgentState)) -> Event (Maybe AgentState))
-> (Point -> IO (Maybe AgentState)) -> Event (Maybe AgentState)
forall a b. (a -> b) -> a -> b
$ \Point
p -> IORef (Maybe AgentState) -> IO (Maybe AgentState)
forall a. IORef a -> IO a
readIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent)
                   
-- | Select the state. The activation and selection are repeated while
-- there is the transition state defined by 'setStateTransition'.
selectState :: AgentState -> Event ()
selectState :: AgentState -> Event ()
selectState AgentState
st =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do let agent :: Agent
agent = AgentState -> Agent
stateAgent AgentState
st
     AgentMode
mode <- IORef AgentMode -> IO AgentMode
forall a. IORef a -> IO a
readIORef (Agent -> IORef AgentMode
agentModeRef Agent
agent)
     case AgentMode
mode of
       AgentMode
CreationMode ->
         do Maybe AgentState
x0 <- IORef (Maybe AgentState) -> IO (Maybe AgentState)
forall a. IORef a -> IO a
readIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent)
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe AgentState -> AgentState -> Event ()
traversePath Maybe AgentState
x0 AgentState
st
       AgentMode
TransientMode ->
         [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
         [Char]
"Use the setStateTransition function to define " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
         [Char]
"the transition state: activateState."
       AgentMode
ProcessingMode ->
         do x0 :: Maybe AgentState
x0@(Just AgentState
st0) <- IORef (Maybe AgentState) -> IO (Maybe AgentState)
forall a. IORef a -> IO a
readIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent)
            Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe AgentState -> AgentState -> Event ()
traversePath Maybe AgentState
x0 AgentState
st

-- | Set the activation computation for the specified state.
setStateActivation :: AgentState -> Event () -> Event ()
setStateActivation :: AgentState -> Event () -> Event ()
setStateActivation AgentState
st Event ()
action =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  IORef (Event ()) -> Event () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event ())
stateActivateRef AgentState
st) Event ()
action
  
-- | Set the deactivation computation for the specified state.
setStateDeactivation :: AgentState -> Event () -> Event ()
setStateDeactivation :: AgentState -> Event () -> Event ()
setStateDeactivation AgentState
st Event ()
action =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  IORef (Event ()) -> Event () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event ())
stateDeactivateRef AgentState
st) Event ()
action
  
-- | Set the transition state which will be next and which is used only
-- when selecting the state directly with help of 'selectState'.
-- If the state was activated intermediately, when selecting
-- another state, then this computation is not used.
setStateTransition :: AgentState -> Event (Maybe AgentState) -> Event ()
setStateTransition :: AgentState -> Event (Maybe AgentState) -> Event ()
setStateTransition AgentState
st Event (Maybe AgentState)
action =
  (Point -> IO ()) -> Event ()
forall a. (Point -> IO a) -> Event a
Event ((Point -> IO ()) -> Event ()) -> (Point -> IO ()) -> Event ()
forall a b. (a -> b) -> a -> b
$ \Point
p ->
  IORef (Event (Maybe AgentState))
-> Event (Maybe AgentState) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event (Maybe AgentState))
stateTransitRef AgentState
st) Event (Maybe AgentState)
action
  
-- | Trigger the signal when the agent state changes.
triggerAgentStateChanged :: Point -> Agent -> IO ()
triggerAgentStateChanged :: Point -> Agent -> IO ()
triggerAgentStateChanged Point
p Agent
agent =
  do Maybe AgentState
st <- IORef (Maybe AgentState) -> IO (Maybe AgentState)
forall a. IORef a -> IO a
readIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent)
     Point -> Event () -> IO ()
forall a. Point -> Event a -> IO a
invokeEvent Point
p (Event () -> IO ()) -> Event () -> IO ()
forall a b. (a -> b) -> a -> b
$ SignalSource (Maybe AgentState) -> Maybe AgentState -> Event ()
forall a. SignalSource a -> a -> Event ()
triggerSignal (Agent -> SignalSource (Maybe AgentState)
agentStateChangedSource Agent
agent) Maybe AgentState
st

-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged :: Agent -> Signal (Maybe AgentState)
selectedStateChanged :: Agent -> Signal (Maybe AgentState)
selectedStateChanged Agent
agent =
  SignalSource (Maybe AgentState) -> Signal (Maybe AgentState)
forall a. SignalSource a -> Signal a
publishSignal (Agent -> SignalSource (Maybe AgentState)
agentStateChangedSource Agent
agent)

-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged_ :: Agent -> Signal ()
selectedStateChanged_ :: Agent -> Signal ()
selectedStateChanged_ Agent
agent =
  (Maybe AgentState -> ()) -> Signal (Maybe AgentState) -> Signal ()
forall a b. (a -> b) -> Signal a -> Signal b
mapSignal (() -> Maybe AgentState -> ()
forall a b. a -> b -> a
const ()) (Signal (Maybe AgentState) -> Signal ())
-> Signal (Maybe AgentState) -> Signal ()
forall a b. (a -> b) -> a -> b
$ Agent -> Signal (Maybe AgentState)
selectedStateChanged Agent
agent