contra-tracer 0.2.1.0 → 0.2.1.1

raw patch · 4 files changed

+43/−11 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• contra-tracer.cabal +1/−1
• src/Control/Tracer.hs +8/−2
• src/Control/Tracer/Arrow.hs +30/−8

@@ -1,3 +1,7 @@+# 0.2.1.1++- Merged PR #15 from @Russoul to decrease allocations and costs incurred by laziness+ # 0.2.1.0  - `traceAll` and `traceTraversable` defined (https://github.com/avieth/contra-tracer/pull/9)

@@ -1,5 +1,5 @@ name:                contra-tracer-version:             0.2.1.0+version:             0.2.1.1 synopsis:            Arrow and contravariant tracers description:         A simple interface for logging, tracing and monitoring license:             Apache-2.0

@@ -51,6 +51,7 @@  {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}  module Control.Tracer     ( Tracer (..)@@ -140,7 +141,7 @@ -- >   case event of -- >     This i -> use tr  -< i -- >     That _ -> squelch -< ()--- +-- -- The key point of using the arrow representation we have here is that this -- tracer will not necessarily need to force @event@: if the input tracer @tr@ -- does not force its value, then @event@ will not be forced. To elaborate,@@ -170,7 +171,12 @@ newtype Tracer m a = Tracer { runTracer :: Arrow.TracerA m a () }  instance Monad m => Contravariant (Tracer m) where-  contramap f tracer = Tracer (arr f >>> use tracer)+  -- Strict in `tracer` and strict in the `Tracer` constructor: a lazy+  -- contramap builds a thunk that retains references to the arguments,+  -- potentially keeping large heap objects alive. If the tracer is never+  -- dispatched through (e.g. the relevant event never occurs), those objects+  -- are never released.+  contramap f !tracer = Tracer $! (arr f >>> use tracer)  -- | @tr1 <> tr2@ will run @tr1@ and then @tr2@ with the same input. instance Monad m => Semigroup (Tracer m s) where

@@ -75,18 +75,40 @@  instance Monad m => Arrow (TracerA m) where   arr = compute-  Squelching l     *** Squelching r     = Squelching (l  *** r )-  Squelching l     *** Emitting   re rp = Emitting   (id *** re) (l  *** rp)-  Emitting   le lp *** Squelching r     = Emitting   (le *** id) (lp *** r )-  Emitting   le lp *** Emitting   re rp = Emitting   (le *** re) (lp *** rp)+  Squelching l     *** Squelching r     = Squelching (l  **** r )+  Squelching l     *** Emitting   re rp = Emitting   (id **** re) (l  **** rp)+  Emitting   le lp *** Squelching r     = Emitting   (le **** id) (lp **** r )+  Emitting   le lp *** Emitting   re rp = Emitting   (le **** re) (lp **** rp)  instance Monad m => ArrowChoice (TracerA m) where-  Squelching l     +++ Squelching r     = Squelching (l +++ r)-  Squelching l     +++ Emitting   re rp = Emitting   (id +++ re) (l  +++ rp)-  Emitting   le lp +++ Squelching r     = Emitting   (le +++ id) (lp +++ r )-  Emitting   le lp +++ Emitting   re rp = Emitting   (le +++ re) (lp +++ rp)+  Squelching l     +++ Squelching r     = Squelching (l   +++ r )+  Squelching l     +++ Emitting   re rp = Emitting   (id  +++ re) (l   +++ rp)+  Emitting   le lp +++ Squelching r     = Emitting   (le  +++ id) (lp  +++ r )+  Emitting   le lp +++ Emitting   re rp = Emitting   (le  +++ re) (lp  +++ rp) +  -- Without explicit (|||) equations the class default fires:+  --   f ||| g = left f >>> arr (either id id) >>> right g+  -- which inserts an extra arr (either id id) step on every dispatch.+  Squelching l     ||| Squelching r     = Squelching (l   ||| r )+  Squelching l     ||| Emitting   re rp = Emitting   (id  +++ re) (l   ||| rp)+  Emitting   le lp ||| Squelching r     = Emitting   (le  +++ id) (lp  ||| r )+  Emitting   le lp ||| Emitting   re rp = Emitting   (le  +++ re) (lp  ||| rp)+ -- | Use a natural transformation to change the underlying monad. nat :: (forall x . m x -> n x) -> TracerA m a b -> TracerA n a b nat h (Squelching (Kleisli k))             = Squelching (Kleisli (h . k)) nat h (Emitting   (Kleisli k) (Kleisli l)) = Emitting   (Kleisli (h . k)) (Kleisli (h . l))++-- Optimal parallel composition for 'Kleisli' arrows. The 'Arrow' class default+--+--   f *** g = first f >>> arr swap >>> first g >>> arr swap+--+-- allocates ~1,000 bytes of short-lived thunks per '(***)' level per dispatch+-- because the lazy irrefutable pattern @~(b,d)@ in 'first' allocates two+-- thunks on every call that the simplifier cannot eliminate. This strict+-- version eliminates all per-dispatch allocation.+infixr 3 ****+(****) :: Monad m => Kleisli m a b -> Kleisli m c d -> Kleisli m (a, c) (b, d)+(Kleisli f) **** (Kleisli g) =+    Kleisli $ \(b, d) -> f b >>= \c -> g d >>= \e -> return (c, e)+{-# INLINE (****) #-}