diff --git a/bin/minipat b/bin/minipat index 98eb19b..2bcf150 100755 --- a/bin/minipat +++ b/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}" diff --git a/minipat-live/src/Minipat/Live/Boot.hs b/minipat-live/src/Minipat/Live/Boot.hs index a857421..827f90e 100644 --- a/minipat-live/src/Minipat/Live/Boot.hs +++ b/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 diff --git a/minipat-live/src/Minipat/Live/Core.hs b/minipat-live/src/Minipat/Live/Core.hs index e058bb1..cad529f 100644 --- a/minipat-live/src/Minipat/Live/Core.hs +++ b/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