simulation: force and print sim events in lockstep

Author: Saizan

simulation/src/Sample.hs

@@ -4,7 +4,6 @@
 
 module Sample where
 
-import Control.Monad
 import Data.Aeson
 import Data.Aeson.Encoding
 import qualified Data.ByteString.Lazy as BSL
@@ -48,24 +47,25 @@ runSampleModel' traceFile logEvent (SampleModel s0 accum render) stop =
   process m
     | Just f <- traceFile =
         withFile f WriteMode $ (`go` m) . writeEvents
-    | otherwise = go (const $ pure ()) m
-  go :: ([(Time, event)] -> IO ()) -> SimVizModel event state -> IO ()
-  go w m = case stepSimViz 10000 m of
-    (before, m'@(SimVizModel ((now, _) : _) _)) -> do
-      w before
-      putStrLn $ "time reached: " ++ show now
-      hFlush stdout
-      go w m'
-    (before, SimVizModel [] s) -> do
-      w before
-      putStrLn "done."
-      hFlush stdout
-      render s
-  stepSimViz n (SimVizModel es s) = case splitAt n es of
-    (before, after) -> (,) before $ SimVizModel after (foldl' (\x (t, e) -> accum t e x) s before)
-  writeEvents h es = forM_ es $ \(Time t, e) ->
+    | otherwise = go (\(SimVizModel es st) -> return $ foldl' (\x (t, e) -> accum t e x) st es) m
+  go :: (SimVizModel event state -> IO state) -> SimVizModel event state -> IO ()
+  go w (SimVizModel es st) = case splitAt 10000 es of
+    (before, after) -> do
+      st' <- w (SimVizModel before st)
+      case after of
+        ((now, _) : _) -> do
+          putStrLn $ "time reached: " ++ show now
+          hFlush stdout
+          go w (SimVizModel after st')
+        [] -> do
+          putStrLn "done."
+          hFlush stdout
+          render st'
+  writeEvents _h (SimVizModel [] st) = return st
+  writeEvents h (SimVizModel ((t'@(Time t), e) : es) st) = do
     case logEvent t e of
       Nothing -> return ()
       Just x -> do
         BSL.hPutStr h (encodingToLazyByteString x)
         BSL.hPutStr h "\n"
+    writeEvents h (SimVizModel es (accum t' e st))