packages feed

atelier-core 0.7.3.0 → 0.8.0.0

raw patch · 27 files changed

+667/−493 lines, 27 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Atelier.Effects.Publishing.Pub: [Publish] :: forall event (a :: Type -> Type). event -> Pub event a ()
- Atelier.Effects.Publishing.Pub: consume :: forall event (es :: [Effect]) a. (event -> Eff es ()) -> Eff (Pub event ': es) a -> Eff es a
- Atelier.Effects.Publishing.Pub: data Pub event (a :: Type -> Type) b
- Atelier.Effects.Publishing.Pub: map :: forall e1 e2 (es :: [Effect]) a. Pub e2 :> es => (e1 -> e2) -> Eff (Pub e1 ': es) a -> Eff es a
- Atelier.Effects.Publishing.Pub: mapM :: forall e1 e2 (es :: [Effect]) a. Pub e2 :> es => (e1 -> Eff es e2) -> Eff (Pub e1 ': es) a -> Eff es a
- Atelier.Effects.Publishing.Pub: publish :: forall event (es :: [Effect]). (HasCallStack, Pub event :> es) => event -> Eff es ()
- Atelier.Effects.Publishing.Pub: runNoOp :: forall event (es :: [(Type -> Type) -> Type -> Type]) a. Eff (Pub event ': es) a -> Eff es a
- Atelier.Effects.Publishing.Pub: toWriter :: forall event (es :: [Effect]) a. Writer [event] :> es => Eff (Pub event ': es) a -> Eff es a
- Atelier.Effects.Publishing.Sub: [ListenWith] :: forall (a :: Type -> Type) event. a () -> (UTCTime -> event -> a ()) -> Sub event a Void
- Atelier.Effects.Publishing.Sub: data Sub event (a :: Type -> Type) b
- Atelier.Effects.Publishing.Sub: forkListener :: forall event (es :: [Effect]). (Conc :> es, Concurrent :> es, Sub event :> es) => (UTCTime -> event -> Eff es ()) -> Eff es ()
- Atelier.Effects.Publishing.Sub: forkListener_ :: forall event (es :: [Effect]). (Conc :> es, Concurrent :> es, Sub event :> es) => (event -> Eff es ()) -> Eff es ()
- Atelier.Effects.Publishing.Sub: instance GHC.Show.Show (Atelier.Effects.Publishing.Sub.OnceEx ev)
- Atelier.Effects.Publishing.Sub: listen :: forall event (es :: [Effect]). Sub event :> es => (UTCTime -> event -> Eff es ()) -> Eff es Void
- Atelier.Effects.Publishing.Sub: listenOnce :: forall event (es :: [Effect]). Sub event :> es => Eff es (UTCTime, event)
- Atelier.Effects.Publishing.Sub: listenOnce_ :: forall event (es :: [Effect]). Sub event :> es => Eff es event
- Atelier.Effects.Publishing.Sub: listenUntil :: forall event (es :: [Effect]) a. Sub event :> es => (UTCTime -> event -> Maybe a) -> Eff es (UTCTime, a)
- Atelier.Effects.Publishing.Sub: listenUntilM :: forall event (es :: [Effect]) a. Sub event :> es => (UTCTime -> event -> Eff es (Maybe a)) -> Eff es (UTCTime, a)
- Atelier.Effects.Publishing.Sub: listenUntilM_ :: forall event (es :: [Effect]) a. Sub event :> es => (event -> Eff es (Maybe a)) -> Eff es a
- Atelier.Effects.Publishing.Sub: listenUntil_ :: forall event (es :: [Effect]) a. Sub event :> es => (event -> Maybe a) -> Eff es a
- Atelier.Effects.Publishing.Sub: listenWith :: forall event (es :: [Effect]). (HasCallStack, Sub event :> es) => Eff es () -> (UTCTime -> event -> Eff es ()) -> Eff es Void
- Atelier.Effects.Publishing.Sub: listenWith_ :: forall event (es :: [Effect]). Sub event :> es => Eff es () -> (event -> Eff es ()) -> Eff es Void
- Atelier.Effects.Publishing.Sub: listen_ :: forall event (es :: [Effect]). Sub event :> es => (event -> Eff es ()) -> Eff es Void
- Atelier.Types.QuietSnake: instance (Data.Aeson.Types.Class.GToJSON Data.Aeson.Types.Generic.Zero (GHC.Generics.Rep a), GHC.Generics.Generic a) => Data.Aeson.Types.ToJSON.ToJSON (Atelier.Types.QuietSnake.QuietSnake a)
- Atelier.Types.QuietSnake: instance (Data.Aeson.Types.FromJSON.GFromJSON Data.Aeson.Types.Generic.Zero (GHC.Generics.Rep a), GHC.Generics.Generic a) => Data.Aeson.Types.FromJSON.FromJSON (Atelier.Types.QuietSnake.QuietSnake a)
- Atelier.Types.QuietSnake: instance Data.Default.Internal.Default a => Data.Default.Internal.Default (Atelier.Types.QuietSnake.QuietSnake a)
+ Atelier.Effects.Input: map :: forall a (es :: [Effect]) b x. Input a :> es => (a -> b) -> Eff (Input b ': es) x -> Eff es x
+ Atelier.Effects.Input: withConst :: forall i (es :: [(Type -> Type) -> Type -> Type]) a. i -> Eff (Input i ': es) a -> Eff es a
+ Atelier.Effects.Input: withEff :: forall (es :: [Effect]) i a. Eff es i -> Eff (Input i ': es) a -> Eff es a
+ Atelier.Effects.Log: instance Data.Aeson.Types.ToJSON.ToJSON Atelier.Effects.Log.Config
+ Atelier.Effects.Log: instance Data.Aeson.Types.ToJSON.ToJSON Atelier.Effects.Log.Severity
+ Atelier.Effects.PubSub: run :: forall event (es :: [Effect]) a. (Chan :> es, Clock :> es) => Eff (Pub event ': (Sub event ': es)) a -> Eff es a
+ Atelier.Effects.PubSub.Pub: [Publish] :: forall event (a :: Type -> Type). event -> Pub event a ()
+ Atelier.Effects.PubSub.Pub: consume :: forall event (es :: [Effect]) a. (event -> Eff es ()) -> Eff (Pub event ': es) a -> Eff es a
+ Atelier.Effects.PubSub.Pub: data Pub event (a :: Type -> Type) b
+ Atelier.Effects.PubSub.Pub: map :: forall e1 e2 (es :: [Effect]) a. Pub e2 :> es => (e1 -> e2) -> Eff (Pub e1 ': es) a -> Eff es a
+ Atelier.Effects.PubSub.Pub: mapM :: forall e1 e2 (es :: [Effect]) a. Pub e2 :> es => (e1 -> Eff es e2) -> Eff (Pub e1 ': es) a -> Eff es a
+ Atelier.Effects.PubSub.Pub: publish :: forall event (es :: [Effect]). (HasCallStack, Pub event :> es) => event -> Eff es ()
+ Atelier.Effects.PubSub.Pub: runNoOp :: forall event (es :: [(Type -> Type) -> Type -> Type]) a. Eff (Pub event ': es) a -> Eff es a
+ Atelier.Effects.PubSub.Pub: toWriter :: forall event (es :: [Effect]) a. Writer [event] :> es => Eff (Pub event ': es) a -> Eff es a
+ Atelier.Effects.PubSub.Sub: [ListenWith] :: forall (a :: Type -> Type) event. a () -> (UTCTime -> event -> a ()) -> Sub event a Void
+ Atelier.Effects.PubSub.Sub: data Sub event (a :: Type -> Type) b
+ Atelier.Effects.PubSub.Sub: forkListener :: forall event (es :: [Effect]). (Conc :> es, Concurrent :> es, Sub event :> es) => (UTCTime -> event -> Eff es ()) -> Eff es ()
+ Atelier.Effects.PubSub.Sub: forkListener_ :: forall event (es :: [Effect]). (Conc :> es, Concurrent :> es, Sub event :> es) => (event -> Eff es ()) -> Eff es ()
+ Atelier.Effects.PubSub.Sub: instance GHC.Show.Show (Atelier.Effects.PubSub.Sub.OnceEx ev)
+ Atelier.Effects.PubSub.Sub: listen :: forall event (es :: [Effect]). Sub event :> es => (UTCTime -> event -> Eff es ()) -> Eff es Void
+ Atelier.Effects.PubSub.Sub: listenOnce :: forall event (es :: [Effect]). Sub event :> es => Eff es (UTCTime, event)
+ Atelier.Effects.PubSub.Sub: listenOnce_ :: forall event (es :: [Effect]). Sub event :> es => Eff es event
+ Atelier.Effects.PubSub.Sub: listenUntil :: forall event (es :: [Effect]) a. Sub event :> es => (UTCTime -> event -> Maybe a) -> Eff es (UTCTime, a)
+ Atelier.Effects.PubSub.Sub: listenUntilM :: forall event (es :: [Effect]) a. Sub event :> es => (UTCTime -> event -> Eff es (Maybe a)) -> Eff es (UTCTime, a)
+ Atelier.Effects.PubSub.Sub: listenUntilM_ :: forall event (es :: [Effect]) a. Sub event :> es => (event -> Eff es (Maybe a)) -> Eff es a
+ Atelier.Effects.PubSub.Sub: listenUntil_ :: forall event (es :: [Effect]) a. Sub event :> es => (event -> Maybe a) -> Eff es a
+ Atelier.Effects.PubSub.Sub: listenWith :: forall event (es :: [Effect]). (HasCallStack, Sub event :> es) => Eff es () -> (UTCTime -> event -> Eff es ()) -> Eff es Void
+ Atelier.Effects.PubSub.Sub: listenWith_ :: forall event (es :: [Effect]). Sub event :> es => Eff es () -> (event -> Eff es ()) -> Eff es Void
+ Atelier.Effects.PubSub.Sub: listen_ :: forall event (es :: [Effect]). Sub event :> es => (event -> Eff es ()) -> Eff es Void
+ Atelier.Effects.Reader: project :: forall a (es :: [Effect]) b x. Reader a :> es => (a -> b) -> Eff (Reader b ': es) x -> Eff es x
+ Atelier.Types.JSON.QuietSnake: QuietSnake :: a -> QuietSnake a
+ Atelier.Types.JSON.QuietSnake: [getQuietSnake] :: QuietSnake a -> a
+ Atelier.Types.JSON.QuietSnake: instance (Data.Aeson.Types.Class.GToJSON Data.Aeson.Types.Generic.Zero (GHC.Generics.Rep a), GHC.Generics.Generic a) => Data.Aeson.Types.ToJSON.ToJSON (Atelier.Types.JSON.QuietSnake.QuietSnake a)
+ Atelier.Types.JSON.QuietSnake: instance (Data.Aeson.Types.FromJSON.GFromJSON Data.Aeson.Types.Generic.Zero (GHC.Generics.Rep a), GHC.Generics.Generic a) => Data.Aeson.Types.FromJSON.FromJSON (Atelier.Types.JSON.QuietSnake.QuietSnake a)
+ Atelier.Types.JSON.QuietSnake: instance Data.Default.Internal.Default a => Data.Default.Internal.Default (Atelier.Types.JSON.QuietSnake.QuietSnake a)
+ Atelier.Types.JSON.QuietSnake: newtype QuietSnake a
+ Atelier.Types.JSON.QuietSnake: options :: Options
+ Atelier.Types.JSON.ReadShow: ReadShow :: a -> ReadShow a
+ Atelier.Types.JSON.ReadShow: [getReadShow] :: ReadShow a -> a
+ Atelier.Types.JSON.ReadShow: instance (GHC.Read.Read a, Data.Typeable.Internal.Typeable a) => Data.Aeson.Types.FromJSON.FromJSON (Atelier.Types.JSON.ReadShow.ReadShow a)
+ Atelier.Types.JSON.ReadShow: instance GHC.Show.Show a => Data.Aeson.Types.ToJSON.ToJSON (Atelier.Types.JSON.ReadShow.ReadShow a)
+ Atelier.Types.JSON.ReadShow: newtype ReadShow a
+ Atelier.Types.JSON.StringLiteral: StringLiteral :: a -> StringLiteral (literal :: Symbol) a
+ Atelier.Types.JSON.StringLiteral: [getStringLiteral] :: StringLiteral (literal :: Symbol) a -> a
+ Atelier.Types.JSON.StringLiteral: instance (Data.Default.Internal.Default a, GHC.TypeLits.KnownSymbol lit) => Data.Aeson.Types.FromJSON.FromJSON (Atelier.Types.JSON.StringLiteral.StringLiteral lit a)
+ Atelier.Types.JSON.StringLiteral: instance GHC.TypeLits.KnownSymbol lit => Data.Aeson.Types.ToJSON.ToJSON (Atelier.Types.JSON.StringLiteral.StringLiteral lit a)
+ Atelier.Types.JSON.StringLiteral: newtype StringLiteral (literal :: Symbol) a

Files

CHANGELOG.md view
@@ -7,6 +7,49 @@  ## [Unreleased] +## [0.8.0.0] - 2026-10-20++### Added++- `Atelier.Types.JSON.StringLiteral`: helper `newtype` for parsing and encoding+  values as exact string literals, regardless of their `Show` and `Read`+  instances.+- `Atelier.Types.JSON.ReadShow`: a copy of `Atelier.Types.JsonReadShow`, but+  with a better name.+- `Atelier.Types.JSON.QuietSnake`: a copy of `Atelier.Types.QuietSnake`, but+  with a better name.+- `Atelier.Effects.Input.withEff`: a copy of+  `Atelier.Effects.Input.runInputEff`, but with a better name.+- `Atelier.Effects.Input.withConst`: a copy of+  `Atelier.Effects.Input.runInputConst`, but with a better name.+- `Atelier.Effects.PubSub`: a copy of+  `Atelier.Effects.Publishing`, but with a better name.+- `Atelier.Effects.PubSub.Pub`: a copy of+  `Atelier.Effects.Publishing.Pub`, but with a better name.+- `Atelier.Effects.PubSub.Sub`: a copy of+  `Atelier.Effects.Publishing.Sub`, but with a better name.+- `Atelier.Effects.Reader.project`: a simple way to expose parts of another+  `Reader a` as another `Reader` effect.+- `Atelier.Effects.Input.map`: a function to transform an existing effect.+- `Atelier.Effects.Log.Config`: gets a `ToJSON` instance.+- `Atelier.Effects.Log.Severity`: gets a `ToJSON` instance.++### Changed++- `Atelier.Effects.Log.Config`: its `FromJSON` instance now fails gracefully+  using the `Default` instance.++### Deprecated++- `Atelier.Types.JsonReadShow`: superseded by `Atelier.Types.JSON.ReadShow`.+- `Atelier.Types.QuietSnake`: superseded by `Atelier.Types.JSON.QuietSnake`.+- `Atelier.Effects.Input.runInputEff`: superseded by `Atelier.Effects.Input.withEff`.+- `Atelier.Effects.Input.runInputConst`: superseded by `Atelier.Effects.Input.withConst`.+- `Atelier.Effects.Publishing`: superseded by `Atelier.Effects.PubSub`.+- `Atelier.Effects.Publishing.runPubSub`: superseded by `Atelier.Effects.PubSub.run`.+- `Atelier.Effects.Publishing.Pub`: superseded by `Atelier.Effects.PubSub.Pub`.+- `Atelier.Effects.Publishing.Sub`: superseded by `Atelier.Effects.PubSub.Sub`.+ ## [0.7.3.0] - 2026-10-02  ### Added
atelier-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           atelier-core-version:        0.7.3.0+version:        0.8.0.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@@ -61,6 +61,10 @@       Atelier.Effects.Publishing       Atelier.Effects.Publishing.Pub       Atelier.Effects.Publishing.Sub+      Atelier.Effects.PubSub+      Atelier.Effects.PubSub.Pub+      Atelier.Effects.PubSub.Sub+      Atelier.Effects.Reader       Atelier.Effects.Tally       Atelier.Effects.Timeout       Atelier.Effects.UUID@@ -70,6 +74,9 @@       Atelier.Time       Atelier.Types.Base64       Atelier.Types.HttpApiDataReadShow+      Atelier.Types.JSON.QuietSnake+      Atelier.Types.JSON.ReadShow+      Atelier.Types.JSON.StringLiteral       Atelier.Types.JsonReadShow       Atelier.Types.QuietSnake       Atelier.Types.Semaphore@@ -160,8 +167,8 @@       Unit.Atelier.Effects.FileWatcherSpec       Unit.Atelier.Effects.IteratorSpec       Unit.Atelier.Effects.LogSpec-      Unit.Atelier.Effects.Publishing.PubSpec-      Unit.Atelier.Effects.PublishingSpec+      Unit.Atelier.Effects.PubSub.PubSpec+      Unit.Atelier.Effects.PubSubSpec       Unit.Atelier.Effects.TallySpec       Unit.Atelier.Effects.YieldSpec       Unit.Atelier.Types.Semaphore.STMSpec
src/Atelier/Effects/Cache/Config.hs view
@@ -12,7 +12,7 @@ import Data.Default (Default (..)) import Data.Time (NominalDiffTime) -import Atelier.Types.QuietSnake (QuietSnake (..))+import Atelier.Types.JSON.QuietSnake (QuietSnake (..))   -- | Configuration for a TTL-evicting cache
src/Atelier/Effects/Input.hs view
@@ -6,10 +6,13 @@ module Atelier.Effects.Input     ( Input     , input-    , runInputEff-    , runInputConst+    , withEff+    , withConst     , toReader     , fromState+    , runInputEff+    , runInputConst+    , map     ) where @@ -18,6 +21,7 @@ import Effectful.Reader.Static (Reader, runReader) import Effectful.State.Static.Shared (State) import Effectful.TH (makeEffect)+import Prelude hiding (map)  import Effectful.State.Static.Shared qualified as State @@ -44,16 +48,30 @@  -- | Runs the passed effectful action every time 'input' is invoked. runInputEff :: Eff es i -> Eff (Input i : es) a -> Eff es a-runInputEff mk = interpret_ \Input -> mk+runInputEff = withEff+{-# DEPRECATED runInputEff "Use 'Atelier.Effects.Input.withEff' instead." #-}  +-- | Runs the passed effectful action every time 'input' is invoked.+withEff :: Eff es i -> Eff (Input i : es) a -> Eff es a+withEff mk = interpret_ \Input -> mk++ -- | Provides the same value for every invocation of the 'input' operation. -- This is equivalent to using 'Effectful.Reader.Static' or -- 'Effectful.Reader.Local', but is available here for testing. runInputConst :: i -> Eff (Input i : es) a -> Eff es a-runInputConst = runInputEff . pure+runInputConst = withConst+{-# DEPRECATED runInputConst "Use 'Atelier.Effects.Input.withConst' instead." #-}  +-- | Provides the same value for every invocation of the 'input' operation.+-- This is equivalent to using 'Effectful.Reader.Static' or+-- 'Effectful.Reader.Local', but is available here for testing.+withConst :: i -> Eff (Input i : es) a -> Eff es a+withConst = runInputEff . pure++ -- | Retrieves the value once, and exposes it as a 'Reader' effect. toReader :: (Input i :> es) => Eff (Reader i : es) a -> Eff es a toReader act = do@@ -63,3 +81,9 @@  fromState :: (State i :> es) => Eff (Input i : es) a -> Eff es a fromState = interpret_ \Input -> State.get+++-- | Create a new 'Input' effect based on an existing one, effectively+-- "mapping" the existing effect into a new one.+map :: (Input a :> es) => (a -> b) -> Eff (Input b : es) x -> Eff es x+map f = withEff $ f <$> input
src/Atelier/Effects/Internal/Coroutine.hs view
@@ -53,11 +53,11 @@  import Atelier.Effects.Chan (Chan) import Atelier.Effects.Conc (Conc)-import Atelier.Effects.Publishing.Sub (Sub)+import Atelier.Effects.PubSub.Sub (Sub)  import Atelier.Effects.Chan qualified as Chan import Atelier.Effects.Conc qualified as Conc-import Atelier.Effects.Publishing.Sub qualified as Sub+import Atelier.Effects.PubSub.Sub qualified as Sub   -- * Yield
src/Atelier/Effects/Iterator.hs view
@@ -18,11 +18,11 @@  import Atelier.Effects.Chan (Chan) import Atelier.Effects.Conc (Conc)-import Atelier.Effects.Publishing.Sub (Sub)+import Atelier.Effects.PubSub.Sub (Sub)  import Atelier.Effects.Chan qualified as Chan import Atelier.Effects.Conc qualified as Conc-import Atelier.Effects.Publishing.Sub qualified as Sub+import Atelier.Effects.PubSub.Sub qualified as Sub   -- | A pull-based iterator of (potentially infinite) values.
src/Atelier/Effects/Log.hs view
@@ -47,7 +47,7 @@     ) where -import Data.Aeson (FromJSON (..))+import Data.Aeson (FromJSON (..), ToJSON) import Data.Default (Default (..)) import Data.List (lookup) import Effectful (Effect, IOE)@@ -60,8 +60,9 @@ import Data.ByteString.Char8 qualified as B8  import Atelier.Effects.Env (Env, getEnvironment)-import Atelier.Types.JsonReadShow (JsonReadShow (..))-import Atelier.Types.QuietSnake (QuietSnake (..))+import Atelier.Types.JSON.QuietSnake (QuietSnake (..))+import Atelier.Types.JSON.ReadShow (ReadShow (..))+import Atelier.Types.WithDefaults (WithDefaults (..))   -- | Effect for structured logging with hierarchical namespaces.@@ -105,7 +106,8 @@     -- ^ Messages below this severity are discarded.     }     deriving stock (Eq, Generic, Show)-    deriving (FromJSON) via QuietSnake Config+    deriving (ToJSON) via QuietSnake Config+    deriving (FromJSON) via WithDefaults (QuietSnake Config)   -- | Log severity levels, ordered from least to most severe.@@ -119,7 +121,8 @@     | -- | A failure that needs attention.       ERROR     deriving stock (Bounded, Enum, Eq, Ord, Read, Show)-    deriving (FromJSON) via (JsonReadShow Severity)+    deriving (FromJSON) via ReadShow Severity+    deriving (ToJSON) via ReadShow Severity   instance Default Config where
+ src/Atelier/Effects/PubSub.hs view
@@ -0,0 +1,36 @@+module Atelier.Effects.PubSub (run) where++import Data.Time (UTCTime)+import Effectful.Dispatch.Dynamic (interpret, interpret_, localSeqUnlift)++import Atelier.Effects.Chan (Chan)+import Atelier.Effects.Clock (Clock)+import Atelier.Effects.PubSub.Pub (Pub (..))+import Atelier.Effects.PubSub.Sub (Sub (..))++import Atelier.Effects.Chan qualified as Chan+import Atelier.Effects.Clock qualified as Clock+++-- | Runs 'Pub' and 'Sub' effects with an internal channel for a specific event+-- type.+run+    :: forall event es a+     . (Chan :> es, Clock :> es)+    => Eff (Pub event : Sub event : es) a -> Eff es a+run action = do+    (inChan, _) <- Chan.newChan @(UTCTime, event)+    let handlePub = interpret_ \case+            Publish event -> do+                timestamp <- Clock.currentTime+                Chan.writeChan inChan (timestamp, event)++        handleSub = interpret \env -> \case+            ListenWith onSubscribed listener -> localSeqUnlift env \unlift -> do+                chan <- Chan.dupChan inChan+                unlift onSubscribed+                forever do+                    (timestamp, event) <- Chan.readChan chan+                    unlift $ listener timestamp event++    handleSub . handlePub $ action
+ src/Atelier/Effects/PubSub/Pub.hs view
@@ -0,0 +1,58 @@+module Atelier.Effects.PubSub.Pub+    ( -- * Effect+      Pub (..)+    , publish++      -- * Interpeters+    , runNoOp+    , toWriter+    , map+    , mapM+    , consume+    )+where++import Effectful (Effect)+import Effectful.Dispatch.Dynamic (interpret_)+import Effectful.TH (makeEffect)+import Effectful.Writer.Static.Shared (Writer, tell)+import Prelude hiding (map, mapM)+++-- | Effect for publishing events of type @event@.+data Pub (event :: Type) :: Effect where+    -- | Publish an event to all current subscribers.+    Publish :: event -> Pub event m ()+++makeEffect ''Pub+++runNoOp :: forall event es a. Eff (Pub event : es) a -> Eff es a+runNoOp = interpret_ \(Publish _) -> pure ()+++-- | Handler that uses a provided Writer effect instead of actually publishing.+-- Useful for testing and inspecting what events were published.+toWriter :: forall event es a. (Writer [event] :> es) => Eff (Pub event : es) a -> Eff es a+toWriter =+    interpret_ \case+        Publish event -> tell [event]+++-- | Convert published events of one type into another, utilizing an existing+-- effect in the effect stack.+map :: forall e1 e2 es a. (Pub e2 :> es) => (e1 -> e2) -> Eff (Pub e1 : es) a -> Eff es a+map f = interpret_ \(Publish event) -> publish $ f event+++-- | Convert published events of one type into another with an effectful+-- transformation, utilizing an existing effect int he effect stack.+mapM :: forall e1 e2 es a. (Pub e2 :> es) => (e1 -> Eff es e2) -> Eff (Pub e1 : es) a -> Eff es a+mapM f = interpret_ \(Publish event) -> f event >>= publish+++-- | Perform an effectful action for each published event.+consume :: (event -> Eff es ()) -> Eff (Pub event : es) a -> Eff es a+consume handler = interpret_ \case+    Publish event -> handler event
+ src/Atelier/Effects/PubSub/Sub.hs view
@@ -0,0 +1,155 @@+module Atelier.Effects.PubSub.Sub+    ( Sub (..)+    , listen+    , listen_+    , listenWith+    , listenWith_+    , listenOnce+    , listenOnce_+    , listenUntil+    , listenUntil_+    , listenUntilM+    , listenUntilM_+    , forkListener+    , forkListener_+    )+where++import Data.Time (UTCTime)+import Effectful (Effect, inject)+import Effectful.Concurrent.STM+    ( Concurrent+    , atomically+    , newEmptyTMVar+    , putTMVar+    , takeTMVar+    )+import Effectful.Error.Static (runErrorNoCallStack, throwError)+import Effectful.TH (makeEffect)++import Text.Show qualified as S++import Atelier.Effects.Conc (Conc, fork_)+++-- | Effect for subscribing to events of type @event@.+data Sub (event :: Type) :: Effect where+    -- | Subscribe, then run @onSubscribed@ once the subscription is established+    -- — after the internal channel has been duplicated and before any event is+    -- delivered — and thereafter deliver every published event to the listener,+    -- forever. The @onSubscribed@ hook lets a caller synchronize on "subscribed"+    -- so a concurrently-started publisher cannot race ahead of the subscription+    -- and have its events missed. Most callers want 'listen' (no hook); a caller+    -- that forks the listener and then publishes must wait on this hook first.+    ListenWith+        :: m ()+        -- ^ @onSubscribed@ hook to better synchronize on "subscribed".+        -> (UTCTime -> event -> m ())+        -- ^ Listener function to react to events.+        -> Sub event m Void+++makeEffect ''Sub+++-- | Subscribe and deliver every published event to the listener, forever.+-- Defined in terms of 'listenWith' with a no-op subscribed hook.+listen :: (Sub event :> es) => (UTCTime -> event -> Eff es ()) -> Eff es Void+listen = listenWith (pure ())+++-- | Like 'listen', but the listener ignores the event timestamp.+listen_ :: (Sub event :> es) => (event -> Eff es ()) -> Eff es Void+listen_ listener = listen $ \_timestamp event -> listener event+++-- | Like 'listen_', but runs @onSubscribed@ once the subscription is+-- established and before any event is delivered. See 'ListenWith'.+listenWith_ :: (Sub event :> es) => Eff es () -> (event -> Eff es ()) -> Eff es Void+listenWith_ onSubscribed listener = listenWith onSubscribed $ \_timestamp event -> listener event+++-- | Listens until the passed function returns @Just a@, returning said @a@+-- with a timestamp.+listenUntil :: (Sub event :> es) => (UTCTime -> event -> Maybe a) -> Eff es (UTCTime, a)+listenUntil f = do+    res <- runErrorNoCallStack+        $ listen+        $ \timestamp event -> whenJust (f timestamp event) \a -> do+            throwError $ OnceEx (timestamp, a)+    case res of+        Left (OnceEx x) -> pure x+        Right v -> absurd v+++listenUntil_ :: (Sub event :> es) => (event -> Maybe a) -> Eff es a+listenUntil_ f = snd <$> listenUntil (\_ -> f)+++-- | Listens until the passed event handler returns @Just a@, returning said+-- @a@ with a timestamp.+listenUntilM :: (Sub event :> es) => (UTCTime -> event -> Eff es (Maybe a)) -> Eff es (UTCTime, a)+listenUntilM f = do+    res <- runErrorNoCallStack+        $ listen+        $ \timestamp event -> whenJustM (inject $ f timestamp event) \a -> do+            throwError $ OnceEx (timestamp, a)+    case res of+        Left (OnceEx x) -> pure x+        Right v -> absurd v+++-- | Listens until the passed event handler returns @Just a@, returning said+-- @a@.+listenUntilM_ :: (Sub event :> es) => (event -> Eff es (Maybe a)) -> Eff es a+listenUntilM_ f = snd <$> listenUntilM (\_ -> f)+++-- | Fork a background listener and block until it has actually subscribed,+-- then return. The listener runs until the enclosing 'Conc' scope closes.+--+-- This is the safe way to start a listener you intend to publish to: a plain+-- @'fork_' . 'listen'@ followed by a 'publish' races the subscription (which+-- happens asynchronously in the forked thread) and, under scheduler pressure,+-- can drop early events and wedge the listener forever. 'forkListener' closes+-- that window by waiting on the subscribed hook before returning.+forkListener+    :: forall event es+     . (Conc :> es, Concurrent :> es, Sub event :> es)+    => (UTCTime -> event -> Eff es ())+    -> Eff es ()+forkListener listener = do+    subscribed <- atomically newEmptyTMVar+    fork_ $ listenWith (atomically (putTMVar subscribed ())) listener+    atomically (takeTMVar subscribed)+++-- | Like 'forkListener', but the listener ignores the timestamp.+forkListener_+    :: forall event es+     . (Conc :> es, Concurrent :> es, Sub event :> es)+    => (event -> Eff es ())+    -> Eff es ()+forkListener_ listener = forkListener @event (\_timestamp event -> listener event)+++-- | Wait for a single event and then return said event.+listenOnce :: forall event es. (Sub event :> es) => Eff es (UTCTime, event)+listenOnce = do+    res <- runErrorNoCallStack+        $ listen+        $ \timestamp event -> throwError $ OnceEx (timestamp, event)+    case res of+        Left (OnceEx x) -> pure x+        Right v -> absurd v+++-- | Same as 'listenOnce', but discards the timestamp.+listenOnce_ :: (Sub event :> es) => Eff es event+listenOnce_ = snd <$> listenOnce+++data OnceEx ev = OnceEx ev+++instance Show (OnceEx ev) where show _ = "OnceEx"
src/Atelier/Effects/Publishing.hs view
@@ -1,18 +1,11 @@-module Atelier.Effects.Publishing-    ( runPubSub-    )-where--import Data.Time (UTCTime)-import Effectful.Dispatch.Dynamic (interpret, interpret_, localSeqUnlift)+module Atelier.Effects.Publishing (runPubSub) where  import Atelier.Effects.Chan (Chan) import Atelier.Effects.Clock (Clock)-import Atelier.Effects.Publishing.Pub (Pub (..))-import Atelier.Effects.Publishing.Sub (Sub (..))+import Atelier.Effects.PubSub.Pub (Pub)+import Atelier.Effects.PubSub.Sub (Sub) -import Atelier.Effects.Chan qualified as Chan-import Atelier.Effects.Clock qualified as Clock+import Atelier.Effects.PubSub qualified as PubSub   -- | Runs 'Pub' and 'Sub' effects with an internal channel for a specific event@@ -21,19 +14,5 @@     :: forall event es a      . (Chan :> es, Clock :> es)     => Eff (Pub event : Sub event : es) a -> Eff es a-runPubSub action = do-    (inChan, _) <- Chan.newChan @(UTCTime, event)-    let handlePub = interpret_ \case-            Publish event -> do-                timestamp <- Clock.currentTime-                Chan.writeChan inChan (timestamp, event)--        handleSub = interpret \env -> \case-            ListenWith onSubscribed listener -> localSeqUnlift env \unlift -> do-                chan <- Chan.dupChan inChan-                unlift onSubscribed-                forever do-                    (timestamp, event) <- Chan.readChan chan-                    unlift $ listener timestamp event--    handleSub . handlePub $ action+runPubSub = PubSub.run+{-# DEPRECATED runPubSub "Use 'Atelier.Effects.PubSub.run' instead." #-}
src/Atelier/Effects/Publishing/Pub.hs view
@@ -1,58 +1,8 @@ module Atelier.Effects.Publishing.Pub-    ( -- * Effect-      Pub (..)-    , publish--      -- * Interpeters-    , runNoOp-    , toWriter-    , map-    , mapM-    , consume+    {-# DEPRECATED "Use 'Atelier.Effects.PubSub.Pub' instead." #-}+    ( module Pub     ) where -import Effectful (Effect)-import Effectful.Dispatch.Dynamic (interpret_)-import Effectful.TH (makeEffect)-import Effectful.Writer.Static.Shared (Writer, tell)-import Prelude hiding (map, mapM)----- | Effect for publishing events of type @event@.-data Pub (event :: Type) :: Effect where-    -- | Publish an event to all current subscribers.-    Publish :: event -> Pub event m ()---makeEffect ''Pub---runNoOp :: forall event es a. Eff (Pub event : es) a -> Eff es a-runNoOp = interpret_ \(Publish _) -> pure ()----- | Handler that uses a provided Writer effect instead of actually publishing.--- Useful for testing and inspecting what events were published.-toWriter :: forall event es a. (Writer [event] :> es) => Eff (Pub event : es) a -> Eff es a-toWriter =-    interpret_ \case-        Publish event -> tell [event]----- | Convert published events of one type into another, utilizing an existing--- effect in the effect stack.-map :: forall e1 e2 es a. (Pub e2 :> es) => (e1 -> e2) -> Eff (Pub e1 : es) a -> Eff es a-map f = interpret_ \(Publish event) -> publish $ f event----- | Convert published events of one type into another with an effectful--- transformation, utilizing an existing effect int he effect stack.-mapM :: forall e1 e2 es a. (Pub e2 :> es) => (e1 -> Eff es e2) -> Eff (Pub e1 : es) a -> Eff es a-mapM f = interpret_ \(Publish event) -> f event >>= publish-+import Atelier.Effects.PubSub.Pub as Pub --- | Perform an effectful action for each published event.-consume :: (event -> Eff es ()) -> Eff (Pub event : es) a -> Eff es a-consume handler = interpret_ \case-    Publish event -> handler event
src/Atelier/Effects/Publishing/Sub.hs view
@@ -1,155 +1,8 @@ module Atelier.Effects.Publishing.Sub-    ( Sub (..)-    , listen-    , listen_-    , listenWith-    , listenWith_-    , listenOnce-    , listenOnce_-    , listenUntil-    , listenUntil_-    , listenUntilM-    , listenUntilM_-    , forkListener-    , forkListener_+    {-# DEPRECATED "Use 'Atelier.Effects.PubSub.Sub' instead." #-}+    ( module Sub     ) where -import Data.Time (UTCTime)-import Effectful (Effect, inject)-import Effectful.Concurrent.STM-    ( Concurrent-    , atomically-    , newEmptyTMVar-    , putTMVar-    , takeTMVar-    )-import Effectful.Error.Static (runErrorNoCallStack, throwError)-import Effectful.TH (makeEffect)--import Text.Show qualified as S--import Atelier.Effects.Conc (Conc, fork_)----- | Effect for subscribing to events of type @event@.-data Sub (event :: Type) :: Effect where-    -- | Subscribe, then run @onSubscribed@ once the subscription is established-    -- — after the internal channel has been duplicated and before any event is-    -- delivered — and thereafter deliver every published event to the listener,-    -- forever. The @onSubscribed@ hook lets a caller synchronize on "subscribed"-    -- so a concurrently-started publisher cannot race ahead of the subscription-    -- and have its events missed. Most callers want 'listen' (no hook); a caller-    -- that forks the listener and then publishes must wait on this hook first.-    ListenWith-        :: m ()-        -- ^ @onSubscribed@ hook to better synchronize on "subscribed".-        -> (UTCTime -> event -> m ())-        -- ^ Listener function to react to events.-        -> Sub event m Void---makeEffect ''Sub----- | Subscribe and deliver every published event to the listener, forever.--- Defined in terms of 'listenWith' with a no-op subscribed hook.-listen :: (Sub event :> es) => (UTCTime -> event -> Eff es ()) -> Eff es Void-listen = listenWith (pure ())----- | Like 'listen', but the listener ignores the event timestamp.-listen_ :: (Sub event :> es) => (event -> Eff es ()) -> Eff es Void-listen_ listener = listen $ \_timestamp event -> listener event----- | Like 'listen_', but runs @onSubscribed@ once the subscription is--- established and before any event is delivered. See 'ListenWith'.-listenWith_ :: (Sub event :> es) => Eff es () -> (event -> Eff es ()) -> Eff es Void-listenWith_ onSubscribed listener = listenWith onSubscribed $ \_timestamp event -> listener event----- | Listens until the passed function returns @Just a@, returning said @a@--- with a timestamp.-listenUntil :: (Sub event :> es) => (UTCTime -> event -> Maybe a) -> Eff es (UTCTime, a)-listenUntil f = do-    res <- runErrorNoCallStack-        $ listen-        $ \timestamp event -> whenJust (f timestamp event) \a -> do-            throwError $ OnceEx (timestamp, a)-    case res of-        Left (OnceEx x) -> pure x-        Right v -> absurd v---listenUntil_ :: (Sub event :> es) => (event -> Maybe a) -> Eff es a-listenUntil_ f = snd <$> listenUntil (\_ -> f)----- | Listens until the passed event handler returns @Just a@, returning said--- @a@ with a timestamp.-listenUntilM :: (Sub event :> es) => (UTCTime -> event -> Eff es (Maybe a)) -> Eff es (UTCTime, a)-listenUntilM f = do-    res <- runErrorNoCallStack-        $ listen-        $ \timestamp event -> whenJustM (inject $ f timestamp event) \a -> do-            throwError $ OnceEx (timestamp, a)-    case res of-        Left (OnceEx x) -> pure x-        Right v -> absurd v----- | Listens until the passed event handler returns @Just a@, returning said--- @a@.-listenUntilM_ :: (Sub event :> es) => (event -> Eff es (Maybe a)) -> Eff es a-listenUntilM_ f = snd <$> listenUntilM (\_ -> f)----- | Fork a background listener and block until it has actually subscribed,--- then return. The listener runs until the enclosing 'Conc' scope closes.------ This is the safe way to start a listener you intend to publish to: a plain--- @'fork_' . 'listen'@ followed by a 'publish' races the subscription (which--- happens asynchronously in the forked thread) and, under scheduler pressure,--- can drop early events and wedge the listener forever. 'forkListener' closes--- that window by waiting on the subscribed hook before returning.-forkListener-    :: forall event es-     . (Conc :> es, Concurrent :> es, Sub event :> es)-    => (UTCTime -> event -> Eff es ())-    -> Eff es ()-forkListener listener = do-    subscribed <- atomically newEmptyTMVar-    fork_ $ listenWith (atomically (putTMVar subscribed ())) listener-    atomically (takeTMVar subscribed)----- | Like 'forkListener', but the listener ignores the timestamp.-forkListener_-    :: forall event es-     . (Conc :> es, Concurrent :> es, Sub event :> es)-    => (event -> Eff es ())-    -> Eff es ()-forkListener_ listener = forkListener @event (\_timestamp event -> listener event)----- | Wait for a single event and then return said event.-listenOnce :: forall event es. (Sub event :> es) => Eff es (UTCTime, event)-listenOnce = do-    res <- runErrorNoCallStack-        $ listen-        $ \timestamp event -> throwError $ OnceEx (timestamp, event)-    case res of-        Left (OnceEx x) -> pure x-        Right v -> absurd v----- | Same as 'listenOnce', but discards the timestamp.-listenOnce_ :: (Sub event :> es) => Eff es event-listenOnce_ = snd <$> listenOnce---data OnceEx ev = OnceEx ev-+import Atelier.Effects.PubSub.Sub as Sub -instance Show (OnceEx ev) where show _ = "OnceEx"
+ src/Atelier/Effects/Reader.hs view
@@ -0,0 +1,13 @@+module Atelier.Effects.Reader (project) where++import Effectful.Reader.Static (Reader)++import Effectful.Reader.Static qualified as Reader+++-- | Use the value from an existing 'Reader' effect to interpret another+-- 'Reader' effect.+project :: (Reader a :> es) => (a -> b) -> Eff (Reader b : es) x -> Eff es x+project f act = do+    b <- f <$> Reader.ask+    Reader.runReader b act
+ src/Atelier/Types/JSON/QuietSnake.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE UndecidableInstances #-}++-- | Derive 'FromJSON' and 'ToJSON' for a record so its Haskell field names map+-- to @quiet_snake_case@ JSON keys.+--+-- \"Quiet\" snake case lowercases and underscore-separates words without an+-- extra leading underscore, so the field @maxRetries@ becomes the JSON key+-- @max_retries@. Derive via this wrapper to keep idiomatic Haskell field names+-- while exposing snake-case JSON:+--+-- @+-- data Settings = Settings { maxRetries :: Int, dryRun :: Bool }+--     deriving stock (Generic)+--     deriving (FromJSON, ToJSON) via (QuietSnake Settings)+-- @+module Atelier.Types.JSON.QuietSnake+    ( QuietSnake (..)+    , options+    )+where++import Data.Aeson+    ( FromJSON (..)+    , GFromJSON+    , GToJSON+    , Options (..)+    , ToJSON (..)+    , Zero+    , camelTo2+    , defaultOptions+    , genericParseJSON+    , genericToJSON+    )+import Data.Default (Default (..))+import GHC.Generics (Rep)+++-- | Carrier for deriving @quiet_snake_case@ JSON instances generically.+newtype QuietSnake a = QuietSnake {getQuietSnake :: a}+++instance (Default a) => Default (QuietSnake a) where+    def = QuietSnake def+++instance (GFromJSON Zero (Rep a), Generic a) => FromJSON (QuietSnake a) where+    parseJSON = fmap QuietSnake . genericParseJSON options+++instance (GToJSON Zero (Rep a), Generic a) => ToJSON (QuietSnake a) where+    toJSON = genericToJSON options . getQuietSnake+++options :: Options+options =+    defaultOptions+        { constructorTagModifier = camelTo2 '_'+        , fieldLabelModifier = camelTo2 '_'+        }
+ src/Atelier/Types/JSON/ReadShow.hs view
@@ -0,0 +1,38 @@+module Atelier.Types.JSON.ReadShow (ReadShow (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), withText)+import Data.Typeable (typeRep)+++-- | Derive 'FromJSON' and 'ToJSON' for a type from its 'Read' and 'Show'+-- instances, encoding each value as a JSON string.+--+-- A value is stored as its 'Show' output and parsed back with 'readMaybe'. On+-- failure the error message names the type (via 'Typeable'), e.g.+-- @Failed to read Mode@.+--+-- @+-- data Mode = Fast | Slow+--     deriving stock (Read, Show)+--     deriving (FromJSON, ToJSON) via (ReadShow Mode)+-- @+--+-- Here @Fast@ serialises to the JSON string @\"Fast\"@.+newtype ReadShow a = ReadShow {getReadShow :: a}+++instance forall a. (Read a, Typeable a) => FromJSON (ReadShow a) where+    parseJSON =+        let+            typeName = show $ typeRep $ Proxy @a+        in+            withText typeName+                $ maybe+                    (fail $ "Failed to read " <> typeName)+                    (pure . ReadShow)+                    . readMaybe+                    . toString+++instance (Show a) => ToJSON (ReadShow a) where+    toJSON = String . show . getReadShow
+ src/Atelier/Types/JSON/StringLiteral.hs view
@@ -0,0 +1,29 @@+module Atelier.Types.JSON.StringLiteral (StringLiteral (..)) where++import Data.Aeson (FromJSON (..), ToJSON (..), withText)+import Data.Default (Default (..))+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+++-- | Parses and encodes to a specific string literal.+--+-- For parsing, if the parsed JSON value matches the specified string literal,+-- the 'Default' value of the type is returned. All other JSON values are+-- considered invalid.+--+-- This is useful for types consisting of a single nullary constructor that you+-- want to encode as a specific string (that is different from the 'Show' and+-- 'Read' instances of the constructor.)+newtype StringLiteral (literal :: Symbol) a = StringLiteral {getStringLiteral :: a}+++instance forall lit a. (Default a, KnownSymbol lit) => FromJSON (StringLiteral lit a) where+    parseJSON = withText "StringLiteral" \t ->+        if t == toText (symbolVal (Proxy :: Proxy lit))+            then pure $ StringLiteral def+            else fail $ "unexpected value of string. expected " <> symbolVal (Proxy :: Proxy lit)+++instance forall lit a. (KnownSymbol lit) => ToJSON (StringLiteral lit a) where+    toJSON _ = toJSON $ symbolVal (Proxy :: Proxy lit)+    toEncoding _ = toEncoding $ symbolVal (Proxy :: Proxy lit)
src/Atelier/Types/JsonReadShow.hs view
@@ -1,39 +1,12 @@--- | Derive 'FromJSON' and 'ToJSON' for a type from its 'Read' and 'Show'--- instances, encoding each value as a JSON string.------ A value is stored as its 'Show' output and parsed back with 'readMaybe'. On--- failure the error message names the type (via 'Typeable'), e.g.--- @Failed to read Mode@.------ @--- data Mode = Fast | Slow---     deriving stock (Read, Show)---     deriving (FromJSON, ToJSON) via (JsonReadShow Mode)--- @------ Here @Fast@ serialises to the JSON string @\"Fast\"@.-module Atelier.Types.JsonReadShow (JsonReadShow (..)) where--import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), withText)-import Data.Typeable (typeRep)----- | Carrier for deriving JSON instances via 'Read' and 'Show'.-newtype JsonReadShow a = JsonReadShow {getJsonReadShow :: a}+module Atelier.Types.JsonReadShow+    {-# DEPRECATED "Use Atelier.Types.JSON.ReadShow instead" #-}+    (JsonReadShow (..))+where +import Data.Aeson (FromJSON, ToJSON) -instance forall a. (Read a, Typeable a) => FromJSON (JsonReadShow a) where-    parseJSON =-        let-            typeName = show $ typeRep $ Proxy @a-        in-            withText typeName-                $ maybe-                    (fail $ "Failed to read " <> typeName)-                    (pure . JsonReadShow)-                    . readMaybe-                    . toString+import Atelier.Types.JSON.ReadShow (ReadShow (..))  -instance (Show a) => ToJSON (JsonReadShow a) where-    toJSON = String . show . getJsonReadShow+newtype JsonReadShow a = JsonReadShow {getJsonReadShow :: a}+    deriving (FromJSON, ToJSON) via ReadShow a
src/Atelier/Types/QuietSnake.hs view
@@ -1,54 +1,8 @@-{-# LANGUAGE UndecidableInstances #-}---- | Derive 'FromJSON' and 'ToJSON' for a record so its Haskell field names map--- to @quiet_snake_case@ JSON keys.------ \"Quiet\" snake case lowercases and underscore-separates words without an--- extra leading underscore, so the field @maxRetries@ becomes the JSON key--- @max_retries@. Derive via this wrapper to keep idiomatic Haskell field names--- while exposing snake-case JSON:------ @--- data Settings = Settings { maxRetries :: Int, dryRun :: Bool }---     deriving stock (Generic)---     deriving (FromJSON, ToJSON) via (QuietSnake Settings)--- @ module Atelier.Types.QuietSnake+    {-# DEPRECATED "Renamed to Atelier.Types.JSON.QuietSnake" #-}     ( QuietSnake (..)     ) where -import Data.Aeson-    ( FromJSON (..)-    , GFromJSON-    , GToJSON-    , Options-    , ToJSON (..)-    , Zero-    , genericParseJSON-    , genericToJSON-    )-import Data.Aeson.Types (defaultOptions, fieldLabelModifier)-import Data.Default (Default (..))-import GHC.Generics (Rep)-import Text.Casing (quietSnake)----- | Carrier for deriving @quiet_snake_case@ JSON instances generically.-newtype QuietSnake a = QuietSnake {getQuietSnake :: a}---instance (Default a) => Default (QuietSnake a) where-    def = QuietSnake def---instance (GFromJSON Zero (Rep a), Generic a) => FromJSON (QuietSnake a) where-    parseJSON = fmap QuietSnake . genericParseJSON opts---instance (GToJSON Zero (Rep a), Generic a) => ToJSON (QuietSnake a) where-    toJSON = genericToJSON opts . getQuietSnake-+import Atelier.Types.JSON.QuietSnake (QuietSnake (..)) -opts :: Options-opts = defaultOptions {fieldLabelModifier = quietSnake}
test/Unit/Atelier/ConfigSpec.hs view
@@ -10,7 +10,7 @@ import Data.Aeson.KeyMap qualified as KM  import Atelier.Config (LoadedConfig (..), extractNestedConfig)-import Atelier.Types.QuietSnake (QuietSnake (..))+import Atelier.Types.JSON.QuietSnake (QuietSnake (..)) import Atelier.Types.WithDefaults (WithDefaults (..))  
test/Unit/Atelier/Effects/Conc/TeardownStressSpec.hs view
@@ -28,12 +28,12 @@ import Atelier.Effects.Chan (Chan, runChan) import Atelier.Effects.Clock (Clock, runClock) import Atelier.Effects.Conc (Conc, fork, fork_, runConc, scoped)-import Atelier.Effects.Publishing (runPubSub)-import Atelier.Effects.Publishing.Pub (Pub)-import Atelier.Effects.Publishing.Sub (Sub)+import Atelier.Effects.PubSub.Pub (Pub)+import Atelier.Effects.PubSub.Sub (Sub)  import Atelier.Effects.Iterator qualified as Iter-import Atelier.Effects.Publishing.Pub qualified as Pub+import Atelier.Effects.PubSub qualified as PubSub+import Atelier.Effects.PubSub.Pub qualified as Pub   test_ConcTeardownStress :: IO TestTree@@ -133,4 +133,4 @@  -- | Mirrors 'IteratorSpec.runTest' — the full effect stack the real victim runs on. runIterTest :: Eff '[Pub Int, Sub Int, Chan, Clock, Conc, Concurrent, IOE] a -> IO a-runIterTest = runEff . runConcurrent . runConc . runClock . runChan . runPubSub @Int+runIterTest = runEff . runConcurrent . runConc . runClock . runChan . PubSub.run @Int
test/Unit/Atelier/Effects/IteratorSpec.hs view
@@ -9,12 +9,12 @@ import Atelier.Effects.Chan (Chan, runChan) import Atelier.Effects.Clock (Clock, runClock) import Atelier.Effects.Conc (Conc, fork, runConc)-import Atelier.Effects.Publishing (runPubSub)-import Atelier.Effects.Publishing.Pub (Pub)-import Atelier.Effects.Publishing.Sub (Sub)+import Atelier.Effects.PubSub.Pub (Pub)+import Atelier.Effects.PubSub.Sub (Sub)  import Atelier.Effects.Iterator qualified as Iter-import Atelier.Effects.Publishing.Pub qualified as Pub+import Atelier.Effects.PubSub qualified as PubSub+import Atelier.Effects.PubSub.Pub qualified as Pub   test_Iterator :: TestTree@@ -118,4 +118,4 @@         . runConc         . runClock         . runChan-        . runPubSub @Int+        . PubSub.run @Int
+ test/Unit/Atelier/Effects/PubSub/PubSpec.hs view
@@ -0,0 +1,62 @@+module Unit.Atelier.Effects.PubSub.PubSpec (test_Pub) where++import Effectful (runPureEff)+import Effectful.Writer.Static.Shared (execWriter)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++import Atelier.Effects.PubSub.Pub qualified as Pub+++data TestEvent = TestEvent Text+    deriving stock (Eq, Show)+++test_Pub :: TestTree+test_Pub =+    testGroup+        "Pub"+        [ testGroup+            "toWriter"+            [ testGroup+                "no events published"+                [ testCase "doesn't record events" do+                    let events =+                            runPureEff . execWriter . Pub.toWriter @TestEvent+                                $ pure ()++                    events @?= []+                ]+            , testGroup+                "events published"+                [ testCase "records events" do+                    let events =+                            runPureEff . execWriter . Pub.toWriter @TestEvent $ do+                                Pub.publish $ TestEvent "payload"+                                pure ()++                    events @?= [TestEvent "payload"]+                ]+            ]+        , testGroup+            "map"+            [ testCase "maps over one event" do+                let events =+                        runPureEff+                            . execWriter+                            . Pub.toWriter @Text+                            . Pub.map show+                            $ Pub.publish @Int 1++                events @?= ["1"]+            , testCase "maps over many events" do+                let events =+                        runPureEff+                            . execWriter+                            . Pub.toWriter @Text+                            . Pub.map show+                            $ traverse Pub.publish [1 .. 10 :: Int]++                events @?= ["1", "2", "3", "4", "5", "6", "7", "8", "9", "10"]+            ]+        ]
+ test/Unit/Atelier/Effects/PubSubSpec.hs view
@@ -0,0 +1,89 @@+module Unit.Atelier.Effects.PubSubSpec (test_PubSub) where++import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Data.Time (UTCTime, getCurrentTime)+import Effectful (IOE, runEff)+import Effectful.Concurrent (Concurrent, runConcurrent)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++import Atelier.Effects.Chan (Chan, runChan)+import Atelier.Effects.Clock (Clock, runClock, runClockConst)+import Atelier.Effects.Conc (Conc, runConc)+import Atelier.Effects.PubSub.Pub (Pub)+import Atelier.Effects.PubSub.Sub (Sub)++import Atelier.Effects.PubSub qualified as PubSub+import Atelier.Effects.PubSub.Pub qualified as Pub+import Atelier.Effects.PubSub.Sub qualified as Sub+++data TestEvent = TestEvent Text+    deriving stock (Eq, Show)+++test_PubSub :: TestTree+test_PubSub =+    testGroup+        "PubSub"+        [ testGroup+            "run"+            [ testCase "listener receives a published event" do+                result <- runPubSubTest $ do+                    received <- liftIO newEmptyMVar+                    Sub.forkListener_ @TestEvent \event ->+                        liftIO $ putMVar received event+                    Pub.publish (TestEvent "hello")+                    liftIO $ takeMVar received+                result @?= TestEvent "hello"+            , testCase "event timestamp matches Clock at publish time" do+                t0 <- getCurrentTime+                result <- runPubSubTestWithClock t0 $ do+                    received <- liftIO newEmptyMVar+                    Sub.forkListener @TestEvent \ts _event ->+                        liftIO $ putMVar received ts+                    Pub.publish (TestEvent "hello")+                    liftIO $ takeMVar received+                result @?= t0+            , testCase "multiple listeners each receive the published event" do+                result <- runPubSubTest $ do+                    recv1 <- liftIO newEmptyMVar+                    recv2 <- liftIO newEmptyMVar+                    Sub.forkListener_ @TestEvent \event -> liftIO $ putMVar recv1 event+                    Sub.forkListener_ @TestEvent \event -> liftIO $ putMVar recv2 event+                    Pub.publish (TestEvent "hello")+                    e1 <- liftIO $ takeMVar recv1+                    e2 <- liftIO $ takeMVar recv2+                    pure (e1, e2)+                result @?= (TestEvent "hello", TestEvent "hello")+            ]+        ]+++--------------------------------------------------------------------------------+-- Test Helpers+--------------------------------------------------------------------------------++runPubSubTest+    :: Eff '[Pub TestEvent, Sub TestEvent, Chan, Clock, Conc, Concurrent, IOE] a+    -> IO a+runPubSubTest =+    runEff+        . runConcurrent+        . runConc+        . runClock+        . runChan+        . PubSub.run @TestEvent+++runPubSubTestWithClock+    :: UTCTime+    -> Eff '[Pub TestEvent, Sub TestEvent, Chan, Clock, Conc, Concurrent, IOE] a+    -> IO a+runPubSubTestWithClock t =+    runEff+        . runConcurrent+        . runConc+        . runClockConst t+        . runChan+        . PubSub.run @TestEvent
− test/Unit/Atelier/Effects/Publishing/PubSpec.hs
@@ -1,62 +0,0 @@-module Unit.Atelier.Effects.Publishing.PubSpec (test_Pub) where--import Effectful (runPureEff)-import Effectful.Writer.Static.Shared (execWriter)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))--import Atelier.Effects.Publishing.Pub qualified as Pub---data TestEvent = TestEvent Text-    deriving stock (Eq, Show)---test_Pub :: TestTree-test_Pub =-    testGroup-        "Pub"-        [ testGroup-            "toWriter"-            [ testGroup-                "no events published"-                [ testCase "doesn't record events" do-                    let events =-                            runPureEff . execWriter . Pub.toWriter @TestEvent-                                $ pure ()--                    events @?= []-                ]-            , testGroup-                "events published"-                [ testCase "records events" do-                    let events =-                            runPureEff . execWriter . Pub.toWriter @TestEvent $ do-                                Pub.publish $ TestEvent "payload"-                                pure ()--                    events @?= [TestEvent "payload"]-                ]-            ]-        , testGroup-            "map"-            [ testCase "maps over one event" do-                let events =-                        runPureEff-                            . execWriter-                            . Pub.toWriter @Text-                            . Pub.map show-                            $ Pub.publish @Int 1--                events @?= ["1"]-            , testCase "maps over many events" do-                let events =-                        runPureEff-                            . execWriter-                            . Pub.toWriter @Text-                            . Pub.map show-                            $ traverse Pub.publish [1 .. 10 :: Int]--                events @?= ["1", "2", "3", "4", "5", "6", "7", "8", "9", "10"]-            ]-        ]
− test/Unit/Atelier/Effects/PublishingSpec.hs
@@ -1,89 +0,0 @@-module Unit.Atelier.Effects.PublishingSpec (test_Publishing) where--import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Data.Time (UTCTime, getCurrentTime)-import Effectful (IOE, runEff)-import Effectful.Concurrent (Concurrent, runConcurrent)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))--import Atelier.Effects.Chan (Chan, runChan)-import Atelier.Effects.Clock (Clock, runClock, runClockConst)-import Atelier.Effects.Conc (Conc, runConc)-import Atelier.Effects.Publishing (runPubSub)-import Atelier.Effects.Publishing.Pub (Pub)-import Atelier.Effects.Publishing.Sub (Sub)--import Atelier.Effects.Publishing.Pub qualified as Pub-import Atelier.Effects.Publishing.Sub qualified as Sub---data TestEvent = TestEvent Text-    deriving stock (Eq, Show)---test_Publishing :: TestTree-test_Publishing =-    testGroup-        "Publishing"-        [ testGroup-            "runPubSub"-            [ testCase "listener receives a published event" do-                result <- runPubSubTest $ do-                    received <- liftIO newEmptyMVar-                    Sub.forkListener_ @TestEvent \event ->-                        liftIO $ putMVar received event-                    Pub.publish (TestEvent "hello")-                    liftIO $ takeMVar received-                result @?= TestEvent "hello"-            , testCase "event timestamp matches Clock at publish time" do-                t0 <- getCurrentTime-                result <- runPubSubTestWithClock t0 $ do-                    received <- liftIO newEmptyMVar-                    Sub.forkListener @TestEvent \ts _event ->-                        liftIO $ putMVar received ts-                    Pub.publish (TestEvent "hello")-                    liftIO $ takeMVar received-                result @?= t0-            , testCase "multiple listeners each receive the published event" do-                result <- runPubSubTest $ do-                    recv1 <- liftIO newEmptyMVar-                    recv2 <- liftIO newEmptyMVar-                    Sub.forkListener_ @TestEvent \event -> liftIO $ putMVar recv1 event-                    Sub.forkListener_ @TestEvent \event -> liftIO $ putMVar recv2 event-                    Pub.publish (TestEvent "hello")-                    e1 <- liftIO $ takeMVar recv1-                    e2 <- liftIO $ takeMVar recv2-                    pure (e1, e2)-                result @?= (TestEvent "hello", TestEvent "hello")-            ]-        ]-------------------------------------------------------------------------------------- Test Helpers-----------------------------------------------------------------------------------runPubSubTest-    :: Eff '[Pub TestEvent, Sub TestEvent, Chan, Clock, Conc, Concurrent, IOE] a-    -> IO a-runPubSubTest =-    runEff-        . runConcurrent-        . runConc-        . runClock-        . runChan-        . runPubSub @TestEvent---runPubSubTestWithClock-    :: UTCTime-    -> Eff '[Pub TestEvent, Sub TestEvent, Chan, Clock, Conc, Concurrent, IOE] a-    -> IO a-runPubSubTestWithClock t =-    runEff-        . runConcurrent-        . runConc-        . runClockConst t-        . runChan-        . runPubSub @TestEvent
test/Unit/Atelier/Types/WithDefaultsSpec.hs view
@@ -7,7 +7,7 @@  import Data.ByteString.Lazy qualified as LBS -import Atelier.Types.QuietSnake (QuietSnake (..))+import Atelier.Types.JSON.QuietSnake (QuietSnake (..)) import Atelier.Types.WithDefaults (WithDefaults (..))