From e3ea04d8e71370032da56ad9ea66dcb82d257812 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 8 May 2026 20:59:08 +0100 Subject: Instrument handler blocks --- src/AtomicPrint.hs | 33 --------------------------------- src/Index.hs | 3 ++- src/Main.hs | 2 +- src/Mmap.hs | 2 +- 4 files changed, 4 insertions(+), 36 deletions(-) delete mode 100644 src/AtomicPrint.hs (limited to 'src') diff --git a/src/AtomicPrint.hs b/src/AtomicPrint.hs deleted file mode 100644 index 82a8552..0000000 --- a/src/AtomicPrint.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# 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 -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 >> hFlush stdout - -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 diff --git a/src/Index.hs b/src/Index.hs index 89a24e3..148f314 100644 --- a/src/Index.hs +++ b/src/Index.hs @@ -41,7 +41,8 @@ import System.FilePath import System.FSNotify qualified as FN import Text.Read (readMaybe) -import AtomicPrint +import Network.HTTP.Server.Mini.Internal.Instrument (atomicPrintS, atomicPrint) + import Debounce import Cache import Config (Channel(..), prettyChannel) diff --git a/src/Main.hs b/src/Main.hs index 6b8e884..247b345 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -26,10 +26,10 @@ import Text.Mustache.Types (Value(..)) import Text.Read (readMaybe) import Network.HTTP.Server.Mini +import Network.HTTP.Server.Mini.Internal.Instrument (atomicPrintS) -- import Debug.Trace -import AtomicPrint import Calendar import Config import Index diff --git a/src/Mmap.hs b/src/Mmap.hs index ff32d0f..34d5d38 100644 --- a/src/Mmap.hs +++ b/src/Mmap.hs @@ -9,7 +9,7 @@ import Foreign.C.Types import System.Posix.IO import System.Posix.Types -import AtomicPrint +import Network.HTTP.Server.Mini.Internal.Instrument (atomicPrintNoWaitS) foreign import ccall "tirclogv_mmap" -- cgit v1.3.1