module FRP.Titan.Debug.SimMonad where
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import FRP.Yampa (DTime, SF)
import FRP.Titan.Debug.Comm
import FRP.Titan.Debug.Command
import FRP.Titan.Debug.Preferences
import FRP.Titan.Debug.Predicates
import FRP.Titan.Debug.History
type SimMonad p a b = StateT (SimState p a b) IO
data SimState p a b = SimState
{ simBridge :: ExternalBridge
, simPrefs :: Preferences
, simHistory :: History a b
, simCommands :: [Command p]
, simOps :: SimOps a b
, simFinished :: Bool
}
getSimHistory :: SimMonad p a b (History a b)
getSimHistory = simHistory <$> get
getSimCommands :: SimMonad p a b [Command p]
getSimCommands = simCommands <$> get
simPrint :: String -> SimMonad p a b ()
simPrint msg = get >>= \simState -> lift $ ebPrint (simBridge simState) msg
simSendMsg :: String -> SimMonad p a b ()
simSendMsg msg = get >>= \simState -> lift $ ebSendMsg (simBridge simState) msg
simSendEvent :: String -> SimMonad p a b ()
simSendEvent msg = get >>= \simState -> lift $ ebSendEvent (simBridge simState) msg
type SimOps a b = (IO a, Bool -> IO (DTime, Maybe a), Bool -> b -> IO Bool)
simSense :: SimMonad p a b a
simSense = get >>= \s -> let (op, _, _) = simOps s in lift op
simSense1 :: Bool -> SimMonad p a b (DTime, Maybe a)
simSense1 b = get >>= \s -> let (_, op, _) = simOps s in lift (op b)
simActuate :: Bool -> b -> SimMonad p a b Bool
simActuate c b = get >>= \s -> let (_, _, op) = simOps s in lift (op c b)
simFinish :: SimState p a b -> SimState p a b
simFinish simState = simState { simFinished = True }
simGetCommand :: (Read p, Show p, Show a, Read a, Show b, Read b, Pred p a b)
=> SimMonad p a b (Maybe (Command p))
simGetCommand = do
simState <- get
(c, cms) <- lift $ getCommand (simBridge simState) (simCommands simState)
put (simState { simCommands = cms })
return c
simEmptyHistory :: SimMonad p a b ()
simEmptyHistory = do
sf0 <- historyGetSF0
modify $ \simState -> simState { simHistory = mkEmptyHistory sf0 }
simReplaceHistory :: (a, [(DTime, a)]) -> SimMonad p a b ()
simReplaceHistory (a0, as) = do
sf0 <- historyGetSF0
let history = History (Just (a0, as))
(sf0, [])
(-1) (Left sf0) Nothing
modify $ \simState -> simState { simHistory = history }
simGetTrace :: SimMonad p a b (Maybe (a, [(DTime, a)]))
simGetTrace = getInputHistory <$> getSimHistory
historyGetSF0 :: SimMonad p a b (SF a b)
historyGetSF0 = (fst . getSFHistory) <$> getSimHistory
simModifyHistory :: (History a b -> History a b) -> SimMonad p a b ()
simModifyHistory f = do
history <- f <$> getSimHistory
modify $ \simState -> simState { simHistory = history }
hPushCommand :: Command p -> SimMonad p a b ()
hPushCommand cmd = modify
(\simState -> simState { simCommands = pushCommand (simCommands simState) cmd })
hAppendCommand :: Command p -> SimMonad p a b ()
hAppendCommand cmd = modify
(\simState -> simState { simCommands = appendCommand (simCommands simState) cmd })