atelier-core 0.7.1.0 → 0.7.2.0

raw patch · 4 files changed

+68/−7 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• atelier-core.cabal +2/−1
• src/Atelier/Effects/FileWatcher.hs +25/−6
• src/Atelier/Signal.hs +35/−0

@@ -7,6 +7,12 @@  ## [Unreleased] +## [0.7.2.0] - 2026-09-21++### Added++- `Atelier.Signal`: For properly handling termination of an application.+ ## [0.7.1.0] - 2026-09-17  ### Added

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           atelier-core-version:        0.7.1.0+version:        0.7.2.0 synopsis:       Foundational Effectful-based effects and utilities description:    Core effects and utilities for effect-based applications, built on Effectful — part of the atelier toolkit. category:       Control@@ -66,6 +66,7 @@       Atelier.Effects.UUID       Atelier.Effects.Yield       Atelier.Exception+      Atelier.Signal       Atelier.Time       Atelier.Types.Base64       Atelier.Types.HttpApiDataReadShow

@@ -69,11 +69,9 @@ where  import Control.Concurrent (threadDelay)-import Control.Concurrent.STM (retry) import Data.List (nub) import Effectful (Effect, IOE) import Effectful.Concurrent (Concurrent)-import Effectful.Concurrent.STM (atomically) import Effectful.Dispatch.Dynamic (interpretWith, localSeqUnlift, localUnliftIO, reinterpret) import Effectful.State.Static.Shared (evalState, get, put) import Effectful.TH (makeEffect)@@ -82,6 +80,7 @@ import System.FilePath (takeExtension)  import Data.Text qualified as T+import Effectful.Concurrent qualified as Concurrent import System.FSNotify qualified as FSN  import Atelier.Effects.Conc (concStrat)@@ -198,12 +197,32 @@                 for_ dedupedDirs \d ->                     watchTree mgr d (matchesAny absWatches . eventPath) \fsEvent ->                         void $ unliftIO $ callback (eventPath fsEvent) (toFileEvent fsEvent)-                forever $ threadDelay 1_000_000+                -- Park indefinitely to hold the manager open. fsnotify delivers+                -- events on its own threads, so there is nothing to do here, and+                -- waking up is not free: each wake-up ends the RTS idle period+                -- and re-arms idle GC, costing a full major collection. 'forever'+                -- is belt-and-braces in case the delay ever returns early.+                --+                -- Preferred over @atomically retry@: a transaction that retries+                -- without having read a 'TVar' has no wakeup path, so it stays+                -- parked only for as long as GC still sees this thread as+                -- reachable. Should it ever become unreachable the RTS throws+                -- @BlockedIndefinitelyOnSTM@, which would unwind 'withManager'+                -- and silently stop all watching. A delay carries no such+                -- dependency on how callers happen to retain the thread.+                forever $ threadDelay maxBound   -- | Scripted interpreter for testing.--- Delivers all scripted events to the callback in order, then blocks--- indefinitely — matching the blocking semantics of 'runFileWatcherIO'.+--+-- Delivers all scripted events to the callback in order, then parks forever,+-- matching the blocking semantics of 'runFileWatcherIO' — 'WatchFilePaths'+-- returns 'Void', so callers must never be resumed. Parks with a delay rather+-- than @atomically retry@ for the same reason as 'runFileWatcherIO': a retry+-- that read no 'TVar' stays parked only while GC sees the thread as reachable,+-- so whether it survives depends on whether the test happens to hold onto the+-- 'ThreadId'.+-- -- The 'Watch' specification is ignored; the caller controls what events are fed in. runFileWatcherScripted     :: (Concurrent :> es) => [(FilePath, FileEvent)] -> Eff (FileWatcher : es) a -> Eff es a@@ -213,7 +232,7 @@             events' <- get             put []             for_ events' \(path, fileEvent) -> unlift $ callback path fileEvent-            atomically retry+            forever $ Concurrent.threadDelay maxBound   -- Helpers

@@ -0,0 +1,35 @@+-- | Termination handler based on Cabal's `Distribution.Client.Signal`.+-- See https://github.com/haskell/cabal/blob/aeb7dbfabad38289cb36da6fdf78acee99b69e3b/cabal-install/src/Distribution/Client/Signal.hs+module Atelier.Signal (installTerminationHandler) where++import Effectful (IOE, withSeqEffToIO)+import Effectful.Concurrent (Concurrent, myThreadId, throwTo)+import Effectful.Exception (asyncExceptionFromException, asyncExceptionToException)+import System.Posix.Signals (Handler (..), installHandler, sigTERM)+import Text.Show (Show (..))+++-- | Terminated is an asynchronous exception, thrown when+-- SIGTERM is received. It's to 'kill' what 'UserInterrupt'+-- is to Ctrl-C.+data Terminated = Terminated+++instance Exception Terminated where+    toException = asyncExceptionToException+    fromException = asyncExceptionFromException+++instance Show Terminated where+    show Terminated = "terminated"+++installTerminationHandler :: (Concurrent :> es, IOE :> es) => Eff es ()+installTerminationHandler = do+    mainThreadId <- myThreadId+    void+        $ withSeqEffToIO \unlift ->+            installHandler+                sigTERM+                (CatchOnce $ unlift $ throwTo mainThreadId Terminated)+                Nothing