| Copyright | (c) Alexander Vieth 2019 |
|---|---|
| License | Apache-2.0 |
| Maintainer | aovieth@gmail.com |
| Safe Haskell | None |
| Language | Haskell2010 |
Control.Tracer
Description
General usage
Tracer is a contravariant functor intended to express the pattern in which
values of its parameter type are used to produce effects which are prescribed
by the caller, as in tracing, logging, code instrumentation, etc.
Programs should be written to use as specific a tracer as possible, i.e. to
take as a parameter a Tracer m domainSpecificType. To combine these programs
into an executable which does meaningful tracing, an implementation of that
tracing should be used to make a Tracer probablyIO implementationTracingType,
which is contramapped to fit Tracer m domainSpecificType wherever it is
needed, for the various domainSpecificTypes that appear throughout the
program.
An example
This short example shows how a tracer can be deployed, highlighting the use of
contramap to fit a general tracer which writes text to a file, where a
specific tracer which takes domain-specific events is expected.
-- Writes text to some log file.
traceToLogFile :: FilePath -> Tracer IO Text
-- Domain-specific event type.
data Event = EventA | EventB Int
-- The log-file format for an Event.
eventToText :: Event -> Text
-- Some action that can use any tracer on Event, in any monad.
actionWithTrace :: Monad m => Tracer m Event -> m ()
actionWithTrace tracer = do
traceWith tracer EventA
traceWith tracer (EventB 42)
-- Set up a log file tracer, then use it where the Event tracer is expected.
main :: IO ()
main = do
textTacer <- traceToLogFile "log.txt"
let eventTracer :: Tracer IO Event
eventTracer = contramap eventToText tracer
actionWithTrace eventTracerSynopsis
- newtype Tracer m a = Tracer {}
- traceWith :: Monad m => Tracer m a -> a -> m ()
- arrow :: Tracer m a () -> Tracer m a
- use :: Tracer m a -> Tracer m a ()
- squelch :: Applicative m => Tracer m a ()
- emit :: Applicative m => (a -> m ()) -> Tracer m a ()
- effect :: (a -> m b) -> Tracer m a b
- nullTracer :: Monad m => Tracer m a
- stdoutTracer :: Tracer IO String
- debugTracer :: Applicative m => Tracer m String
- natTracer :: forall m n s. (forall x. m x -> n x) -> Tracer m s -> Tracer n s
- nat :: (forall x. m x -> n x) -> Tracer m a b -> Tracer n a b
- traceMaybe :: Monad m => (a -> Maybe b) -> Tracer m b -> Tracer m a
- squelchUnless :: Monad m => (a -> Bool) -> Tracer m a -> Tracer m a
- class Contravariant (f :: Type -> Type) where
Documentation
This type describes some effect in m which depends upon some value of
type a, for which the output value is not of interest (only the effects).
The motivating use case is to describe tracing, logging, monitoring, and similar features, in which the programmer wishes to provide some values to some other program which will do some real world side effect, such as writing to a log file or bumping a counter in some monitoring system.
The actual implementation of such a program will probably work on rather
large, domain-agnostic types like Text, ByteString, JSON values for
structured logs, etc.
But the call sites which ultimately invoke these implementations will deal with smaller, domain-specific types that concisely describe events, metrics, debug information, etc.
This difference is reconciled by the Contravariant instance for Tracer.
contramap is used to change the input type of
a tracer. This allows for a more general tracer to be used where a more
specific one is expected.
Intuitively: if you can map your domain-specific type Event to a Text
representation, then any Tracer m Text can stand in where a
Tracer m Event is required.
eventToText :: Event -> Text traceTextToLogFile :: Tracer m Text traceEventToLogFile :: Tracer m Event traceEventToLogFile = contramap eventToText traceTextToLogFile
Effectful tracers that actually do interesting stuff can be defined
using emit, and composed via contramap.
The nullTracer can be used as a stand-in for any tracer, doing no
side-effects and producing no interesting value.
To deal with branching, the arrow interface on the underlying
Tracer should be used. Arrow notation can be helpful
here.
For example, a common pattern is to trace only some variants of a sum type.
data Event = This Int | That Bool
traceOnlyThat :: Tracer m Int -> Tracer m Bool
traceOnlyThat tr = Tracer $ proc event -> do
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,
suppose tr is nullTracer. Then this expression becomes
classify (This i) = Left i classify (That _) = Right () traceOnlyThat tr = Tracer $ Pure classify >>> (squelch ||| squelch) >>> Pure (either id id) = Tracer $ Pure classify >>> Pure (either (const (Left ())) (const (Right ()))) >>> Pure (either id id) = Tracer $ Pure (classify >>> either (const (Left ())) (const (Right ())) >>> either id id)
So that when this tracer is run by traceWith we get
traceWith (traceOnlyThat tr) x = traceWith (Pure _) = pure ()
It is _essential_ that the computation of the tracing effects cannot itself
have side-effects, as this would ruin the ability to short-circuit when
it is known that no tracing will be done: the side-effects of a branch
could change the outcome of another branch. This would fly in the face of
a crucial design goal: you can leave your tracer calls in the program so
they do not bitrot, but can also make them zero runtime cost by substituting
nullTracer appropriately.
use :: Tracer m a -> Tracer m a () Source #
Inverse of arrow. Useful when writing arrow tracers which use a
contravariant tracer (the newtype in this module).
squelch :: Applicative m => Tracer m a () Source #
Ignore the input and do not emit. The name is intended to lead to clear and suggestive arrow expressions.
emit :: Applicative m => (a -> m ()) -> Tracer m a () Source #
Do an emitting effect. Contrast with effect which does not make the
tracer an emitting tracer.
effect :: (a -> m b) -> Tracer m a b Source #
Do a non-emitting effect. This effect will only be run if some part of
the tracer downstream emits (see emit).
Simple tracers
nullTracer :: Monad m => Tracer m a Source #
A tracer which does nothing.
stdoutTracer :: Tracer IO String Source #
Trace strings to stdout. Output could be jumbled when this is used from
multiple threads. Consider debugTracer instead.
debugTracer :: Applicative m => Tracer m String Source #
Trace strings using traceM. This will use stderr. See
documentation in Debug.Trace for more details.
Transforming tracers
natTracer :: forall m n s. (forall x. m x -> n x) -> Tracer m s -> Tracer n s Source #
Use a natural transformation to change the m type. This is useful, for
instance, to use concrete IO tracers in monad transformer stacks that have
IO as their base.
nat :: (forall x. m x -> n x) -> Tracer m a b -> Tracer n a b Source #
Use a natural transformation to change the underlying monad.
traceMaybe :: Monad m => (a -> Maybe b) -> Tracer m b -> Tracer m a Source #
Run a tracer only for the Just variant of a Maybe. If it's Nothing, the
nullTracer is used (no output).
The arrow representation allows for proper laziness: if the tracer parameter
does not produce any tracing effects, then the predicate won't even be
evaluated. Contrast with the simple contravariant representation as
a -> m (), in which the predicate _must_ be forced no matter what,
because it's impossible to know a priori whether that function will not
produce any tracing effects.
It's written out explicitly for demonstration. Could also use arrow notation:
traceMaybe p tr = Tracer $ proc a -> do
case k a of
Just b -> use tr -< b
Nothing -> Arrow.squelch -< ()squelchUnless :: Monad m => (a -> Bool) -> Tracer m a -> Tracer m a Source #
Uses traceMaybe to give a tracer which emits only if a predicate is true.
Re-export of Contravariant
class Contravariant (f :: Type -> Type) where #
The class of contravariant functors.
Whereas in Haskell, one can think of a Functor as containing or producing
values, a contravariant functor is a functor that can be thought of as
consuming values.
As an example, consider the type of predicate functions a -> Bool. One
such predicate might be negative x = x < 0, which
classifies integers as to whether they are negative. However, given this
predicate, we can re-use it in other situations, providing we have a way to
map values to integers. For instance, we can use the negative predicate
on a person's bank balance to work out if they are currently overdrawn:
newtype Predicate a = Predicate { getPredicate :: a -> Bool }
instance Contravariant Predicate where
contramap f (Predicate p) = Predicate (p . f)
| `- First, map the input...
`----- then apply the predicate.
overdrawn :: Predicate Person
overdrawn = contramap personBankBalance negative
Any instance should be subject to the following laws:
Note, that the second law follows from the free theorem of the type of
contramap and the first law, so you need only check that the former
condition holds.
Minimal complete definition