Log watching

1 files changed, 32 insertions, 0 deletions

diff --git a/src/AtomicPrint.hs b/src/AtomicPrint.hs
new file mode 100644
index 0000000..c2367dd
--- /dev/null
+++ b/src/AtomicPrint.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}
+module AtomicPrint (
+  atomicPrint, atomicPrintS,
+  atomicPrintNoWait, atomicPrintNoWaitS,
+) where
+
+import Control.Concurrent
+import Control.Monad (void)
+import Data.Text qualified as T
+import Data.Text.IO.Utf8 qualified as T
+import Data.Text (Text)
+import System.IO.Unsafe (unsafePerformIO)
+
+
+{-# NOINLINE mutex #-}
+mutex :: MVar ()
+mutex = unsafePerformIO (newMVar ())
+
+atomicPrintS :: String -> IO ()
+atomicPrintS = atomicPrint . T.pack
+
+atomicPrint :: Text -> IO ()
+atomicPrint text =
+  withMVar mutex $ \() ->
+    T.putStrLn text
+
+atomicPrintNoWaitS :: String -> IO ()
+atomicPrintNoWaitS = atomicPrintNoWait . T.pack
+
+-- | Does not block, so if you've masked exceptions, nothing will come through here
+atomicPrintNoWait :: Text -> IO ()
+atomicPrintNoWait text = void $ forkIO $ atomicPrint text