aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bindings/haskell/src/PPAML/Tracer.hs47
-rw-r--r--bindings/haskell/src/PPAML/Tracer/Exception.hs4
2 files changed, 50 insertions, 1 deletions
diff --git a/bindings/haskell/src/PPAML/Tracer.hs b/bindings/haskell/src/PPAML/Tracer.hs
index ddff15c..b2226c1 100644
--- a/bindings/haskell/src/PPAML/Tracer.hs
+++ b/bindings/haskell/src/PPAML/Tracer.hs
@@ -47,7 +47,7 @@ be finite. -}
module PPAML.Tracer
( -- * Tracers
Tracer, TracerHandle
- , withTracer
+ , withTracer, withTracer'
-- * Phases
, Phase, PhaseHandle
, withPhase
@@ -83,6 +83,7 @@ module PPAML.Tracer
OTFPhaseDefinitionFailure, OTFPhaseEntryFailure, OTFPhaseExitFailure,
OTFWriterCloseFailure, OTFTraceResolutionFailure,
OTFProcessDefinitionFailure
+ , TraceBaseUndefined
-- ** Timing exceptions
, TimingException, ClockAcquisitionFailure
) where
@@ -124,6 +125,36 @@ withTracer reportBaseName f =
(tracerDone tracerHandle)
(f tracerHandle)
+{-| Similar to 'withTracer'. Constructs a 'Tracer' and executes the specified
+computation. The trace report will be stored in Open Trace Format; all trace
+file paths will begin with the path contained in the environment variable
+'PPAMLTRACER_TRACE_BASE'.
+
+Throws:
+
+ * 'OTFManagerInitializationFailure' if the Open Trace Format manager could not
+ be initialized.
+
+ * 'OTFWriterInitializationFailure' if the Open Trace Format writer could not
+ be initialized.
+
+ * 'OTFTraceResolutionFailure' if setting the trace resolution failed.
+
+ * 'OTFProcessDefinitionFailure' if defining the main OTF process failed.
+
+ * 'OTFWriterCloseFailure' if the Open Trace Format writer could not be closed
+ after the computation ran.
+
+ * 'TraceBaseUndefined' if the 'PPAMLTRACER_TRACE_BASE' environment variable is
+ undefined or empty. -}
+
+withTracer' :: (TracerHandle -> IO a) -> IO a
+withTracer' f =
+ allocaBytes tracerSize $ \tracerHandle ->
+ bracket_ (tracerInitFromEnv tracerHandle)
+ (tracerDone tracerHandle)
+ (f tracerHandle)
+
{-| Constructs a 'Phase' and executes the specified computation.
Throws 'OTFPhaseDefinitionFailure' if the phase could not be defined. -}
@@ -186,6 +217,20 @@ tracerInit tracer reportNameBase =
4 -> throw OTFProcessDefinitionFailure
r -> unexpectedReturnCode r
+foreign import ccall unsafe "ppaml/tracer.h ppaml_tracer_init_from_env"
+ ppaml_tracer_init_from_env :: TracerHandle -> IO CInt
+
+tracerInitFromEnv :: TracerHandle -> IO ()
+tracerInitFromEnv tracer =
+ ppaml_tracer_init_from_env tracer >>= \case
+ 0 -> return ()
+ 1 -> throw OTFManagerInitializationFailure
+ 2 -> throw OTFWriterInitializationFailure
+ 3 -> throw OTFTraceResolutionFailure
+ 4 -> throw OTFProcessDefinitionFailure
+ 5 -> throw TraceBaseUndefined
+ r -> unexpectedReturnCode r
+
foreign import ccall unsafe "ppaml/tracer.h ppaml_tracer_done"
ppaml_tracer_done :: TracerHandle -> IO CInt
diff --git a/bindings/haskell/src/PPAML/Tracer/Exception.hs b/bindings/haskell/src/PPAML/Tracer/Exception.hs
index 9de2316..bced230 100644
--- a/bindings/haskell/src/PPAML/Tracer/Exception.hs
+++ b/bindings/haskell/src/PPAML/Tracer/Exception.hs
@@ -68,6 +68,10 @@ mkException 'OTFWriterException "OTFTraceResolutionFailure"
-- | Failure to define a process (i.e., a thread). Extends 'OTFWriterException'.
mkException 'OTFWriterException "OTFProcessDefinitionFailure"
+{-| Thrown by 'withTracer'' when it is called and 'PPAMLTRACER_TRACE_BASE' is
+unset or empty. -}
+mkException 'TracerException "TraceBaseUndefined"
+
------------------------------ Timing exceptions -------------------------------