Allow IOG's contra-tracer

Author: jasagredo

bench/macro/lsm-tree-bench-wp8.hs

@@ -211,13 +211,21 @@ mkTableConfigOverride GlobalOpts{diskCachePolicy} RunOpts {pipelined} =
 mkTracer :: GlobalOpts -> Tracer IO LSM.LSMTreeTrace
 mkTracer gopts
   | trace gopts =
+#if MIN_VERSION_contra_tracer(0,2,0)
       -- Don't trace update/lookup messages, because they are too noisy
       squelchUnless
         (\case
           LSM.TraceTable _ LSM.TraceUpdates{} -> False
           LSM.TraceTable _ LSM.TraceLookups{} -> False
           _                                   -> True )
         (show `contramap` stdoutTracer)
+#else
+      Tracer $
+        \case
+          LSM.TraceTable _ LSM.TraceUpdates{} -> pure ()
+          LSM.TraceTable _ LSM.TraceLookups{} -> pure ()
+          e                                   -> traceWith (show `contramap` stdoutTracer) e
+#endif
   | otherwise   = nullTracer
 
 -------------------------------------------------------------------------------

lsm-tree.cabal

@@ -613,7 +613,7 @@ library
     , bytestring              ^>=0.11.4.0 || ^>=0.12.1.0
     , cborg                   ^>=0.2.10.0
     , containers              ^>=0.6      || ^>=0.7
-    , contra-tracer           ^>=0.2
+    , contra-tracer           ^>=0.1      || ^>=0.2
     , crc32c                  ^>=0.2.1
     , deepseq                 ^>=1.4      || ^>=1.5
     , filepath

src/Database/LSMTree/Internal/Unsafe.hs

@@ -202,12 +202,17 @@ data TableTrace =
   | TraceSupplyUnionCredits UnionCredits
   deriving stock Show
 
+#if MIN_VERSION_contra_tracer(0,2,0)
 contramapTraceMerge :: Monad m => Tracer m TableTrace -> Tracer m (AtLevel MergeTrace)
 #ifdef DEBUG_TRACES
 contramapTraceMerge t = TraceMerge `contramap` t
 #else
 contramapTraceMerge t = traceMaybe (const Nothing) t
 #endif
+#else
+contramapTraceMerge :: Applicative m => Tracer m TableTrace -> Tracer m (AtLevel MergeTrace)
+contramapTraceMerge _t = nullTracer
+#endif
 
 data CursorTrace =
     TraceCreateCursor TableId

test-prototypes/Test/ScheduledMerges.hs

@@ -1,10 +1,14 @@
+{-# LANGUAGE CPP #-}
+
 module Test.ScheduledMerges (tests) where
 
 import           Control.Exception
 import           Control.Monad (replicateM_, when)
 import           Control.Monad.ST
 import           Control.Tracer (Tracer (Tracer))
+#if MIN_VERSION_contra_tracer(0,2,0)
 import qualified Control.Tracer as Tracer
+#endif
 import           Data.Foldable (find, traverse_)
 import           Data.Maybe (fromJust)
 import           Data.STRef
@@ -526,7 +530,11 @@ genShrinkTrace !n x
 runWithTracer :: (Tracer (ST RealWorld) Event -> IO a) -> IO a
 runWithTracer action = do
     events <- stToIO $ newSTRef []
-    let tracer = Tracer $ Tracer.emit $ \e -> modifySTRef events (e :)
+    let tracer = Tracer $
+#if MIN_VERSION_contra_tracer(0,2,0)
+                   Tracer.emit $
+#endif
+                     \e -> modifySTRef events (e :)
     action tracer `catch` \e -> do
       if isDiscard e  -- don't intercept these
         then throwIO e

test/Test/Database/LSMTree.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
@@ -134,11 +135,16 @@ prop_openSession_restoreSession =
 -- | A tracer that records session open, session new, and session restore
 -- messages in a mutable variable.
 mkSessionOpenModeTracer :: IORef [String] -> Tracer IO LSMTreeTrace
-mkSessionOpenModeTracer var = Tracer $ emit $ \case
-    TraceOpenSession{} -> modifyIORef var ("Open" :)
-    TraceNewSession{} -> modifyIORef var ("New" :)
-    TraceRestoreSession{} -> modifyIORef var ("Restore" :)
-    _ -> pure ()
+mkSessionOpenModeTracer var =
+  Tracer $
+#if MIN_VERSION_contra_tracer(0,2,0)
+    emit $
+#endif
+      \case
+        TraceOpenSession{} -> modifyIORef var ("Open" :)
+        TraceNewSession{} -> modifyIORef var ("New" :)
+        TraceRestoreSession{} -> modifyIORef var ("Restore" :)
+        _ -> pure ()
 
 {-------------------------------------------------------------------------------
   Session: happy path