etc

bin/minipat

@@ -41,6 +41,4 @@ SCRIPT="$(realpath "${SCRIPT}")"
 
 set -x
 
-stack build --fast "minipat-${BACKEND}"
-
 exec stack ghci --ghci-options "-ghci-script=\"${SCRIPT}\"" "minipat-${BACKEND}"

minipat-live/src/Minipat/Live/Boot.hs

@@ -26,6 +26,7 @@ module Minipat.Live.Boot
   , panic
   , play
   , stop
+  , status
   , checkTasks
   , peek
   , d
@@ -136,6 +137,9 @@ play = setPlaying True
 stop :: (LiveSt) => IO ()
 stop = setPlaying False
 
+status :: (LiveSt) => IO ()
+status = readLiveSt >>= void . C.status
+
 checkTasks :: (LiveSt) => IO ()
 checkTasks = readLiveSt >>= void . C.checkTasks
 

minipat-live/src/Minipat/Live/Core.hs

@@ -29,6 +29,7 @@ module Minipat.Live.Core
   , clearAllOrbits
   , hush
   , panic
+  , status
   , checkTasks
   , logAsyncState
   , peek
@@ -425,6 +426,19 @@ logAsyncState logger name task = do
         Left e -> False <$ logException logger ("Task " <> name <> " failed") e
         Right _ -> False <$ logWarn logger ("Task " <> name <> " not running")
 
+status :: St i -> IO ()
+status st = do
+  let logger = stLogger st
+      dom = stDom st
+      rep :: (Show a) => (Domain -> TVar a) -> Text -> IO ()
+      rep p l = readTVarIO (p dom) >>= logInfo logger . (\v -> l <> ": " <> v) . T.pack . show
+  rep domPlaying "Playing"
+  rep domGenCycle "GenCycle"
+  rep domAbsGenCycle "AbsGenCycle"
+  rep domCps "CPS"
+  rep domGpc "GPC"
+  rep domDebug "Debug"
+
 checkTasks :: (Backend i) => St i -> IO Bool
 checkTasks st =
   let logger = stLogger st