Move the Telemetry effect into its own module.

semantic.cabal

@@ -143,6 +143,7 @@ library
                      , Semantic.Queue
                      , Semantic.Stat
                      , Semantic.Task
+                     , Semantic.Telemetry
                      , Semantic.Util
                     -- Custom Prelude
   other-modules:       Prologue

src/Semantic/Task.hs

@@ -54,6 +54,7 @@ import qualified Semantic.IO as IO
 import           Semantic.Log
 import           Semantic.Queue
 import           Semantic.Stat as Stat
+import           Semantic.Telemetry
 import           System.Exit (die)
 import           System.IO (Handle, stderr)
 
@@ -66,12 +67,6 @@ data TaskF output where
   Diff          :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2)
   Render        :: Renderer input output -> input -> TaskF output
 
--- | A queue for logging.
-type LogQueue = AsyncQueue Message Options
-
--- | A queue for stats.
-type StatQueue = AsyncQueue Stat StatsClient
-
 -- | A high-level task producing some result, e.g. parsing, diffing, rendering. 'Task's can also specify explicit concurrency via 'distribute', 'distributeFor', and 'distributeFoldMap'
 type Task = Eff '[Distribute WrappedTask, TaskF, Reader Options, Telemetry, Reader LogQueue, Reader StatQueue, Exc SomeException, IO]
 
@@ -97,14 +92,6 @@ readBlobPairs = send . ReadBlobPairs
 writeToOutput :: Member TaskF effs => Either Handle FilePath -> B.ByteString -> Eff effs ()
 writeToOutput path = send . WriteToOutput path
 
--- | A task which logs a message at a specific log level to stderr.
-writeLog :: Member Telemetry effs => Level -> String -> [(String, String)] -> Eff effs ()
-writeLog level message pairs = send (WriteLog level message pairs)
-
--- | A task which writes a stat.
-writeStat :: Member Telemetry effs => Stat -> Eff effs ()
-writeStat stat = send (WriteStat stat)
-
 -- | A task which measures and stats the timing of another task.
 time :: Members '[Telemetry, IO] effs => String -> [(String, String)] -> Eff effs output -> Eff effs output
 time statName tags task = do
@@ -208,17 +195,6 @@ runTaskF = interpret (\ task -> case task of
   Render renderer input -> pure (renderer input))
 
 
--- | Statting and logging effects.
-data Telemetry output where
-  WriteStat :: Stat                                  -> Telemetry ()
-  WriteLog  :: Level -> String -> [(String, String)] -> Telemetry ()
-
-runTelemetry :: Members '[Reader LogQueue, Reader StatQueue, IO] effs => Eff (Telemetry ': effs) a -> Eff effs a
-runTelemetry = interpret (\ t -> case t of
-  WriteStat stat -> ask >>= \ statter -> liftIO (queue (statter :: StatQueue) stat)
-  WriteLog level message pairs -> ask >>= \ logger -> queueLogMessage logger level message pairs)
-
-
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
 --
 --   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.

src/Semantic/Telemetry.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE GADTs, TypeOperators #-}
+module Semantic.Telemetry where
+
+import Control.Monad.Effect
+import Control.Monad.Effect.Reader
+import Control.Monad.IO.Class
+import Semantic.Log
+import Semantic.Queue
+import Semantic.Stat
+
+-- | Statting and logging effects.
+data Telemetry output where
+  WriteStat :: Stat                                  -> Telemetry ()
+  WriteLog  :: Level -> String -> [(String, String)] -> Telemetry ()
+
+-- | A task which logs a message at a specific log level to stderr.
+writeLog :: Member Telemetry effs => Level -> String -> [(String, String)] -> Eff effs ()
+writeLog level message pairs = send (WriteLog level message pairs)
+
+-- | A task which writes a stat.
+writeStat :: Member Telemetry effs => Stat -> Eff effs ()
+writeStat stat = send (WriteStat stat)
+
+
+-- | A queue for logging.
+type LogQueue = AsyncQueue Message Options
+
+-- | A queue for stats.
+type StatQueue = AsyncQueue Stat StatsClient
+
+
+runTelemetry :: Members '[Reader LogQueue, Reader StatQueue, IO] effs => Eff (Telemetry ': effs) a -> Eff effs a
+runTelemetry = interpret (\ t -> case t of
+  WriteStat stat -> ask >>= \ statter -> liftIO (queue (statter :: StatQueue) stat)
+  WriteLog level message pairs -> ask >>= \ logger -> queueLogMessage logger level message pairs)