module Development.IDE.Monitoring.OpenTelemetry (monitoring) where
import Control.Concurrent.Async (Async, async, cancel)
import Control.Monad (forever)
import Data.IORef.Extra (atomicModifyIORef'_,
newIORef, readIORef)
import Data.Text.Encoding (encodeUtf8)
import Debug.Trace.Flags (userTracingEnabled)
import Development.IDE.Types.Monitoring (Monitoring (..))
import OpenTelemetry.Eventlog (mkValueObserver, observe)
import System.Time.Extra (Seconds, sleep)
monitoring :: IO Monitoring
monitoring :: IO Monitoring
monitoring
| Bool
userTracingEnabled = do
IORef [IO ()]
actions <- [IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef []
let registerCounter :: Text -> IO a -> IO ()
registerCounter Text
name IO a
readA = do
ValueObserver
observer <- InstrumentName -> IO ValueObserver
forall (m :: * -> *).
MonadIO m =>
InstrumentName -> m ValueObserver
mkValueObserver (Text -> InstrumentName
encodeUtf8 Text
name)
let update :: IO ()
update = ValueObserver -> Int -> IO ()
forall (m :: * -> *) (a :: Additivity) (m' :: Monotonicity).
MonadIO m =>
Instrument 'Asynchronous a m' -> Int -> m ()
observe ValueObserver
observer (Int -> IO ()) -> (a -> Int) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
readA
IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef [IO ()]
actions (IO ()
update :)
registerGauge :: Text -> IO Int64 -> IO ()
registerGauge = Text -> IO Int64 -> IO ()
forall {a}. Integral a => Text -> IO a -> IO ()
registerCounter
let start :: IO (IO ())
start = do
Async ()
a <- Seconds -> IO () -> IO (Async ())
regularly Seconds
1 (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> IO [IO ()] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORef IORef [IO ()]
actions
IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
a)
Monitoring -> IO Monitoring
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Monitoring{IO (IO ())
Text -> IO Int64 -> IO ()
forall {a}. Integral a => Text -> IO a -> IO ()
registerCounter :: forall {a}. Integral a => Text -> IO a -> IO ()
registerGauge :: Text -> IO Int64 -> IO ()
start :: IO (IO ())
registerGauge :: Text -> IO Int64 -> IO ()
registerCounter :: Text -> IO Int64 -> IO ()
start :: IO (IO ())
..}
| Bool
otherwise = IO Monitoring
forall a. Monoid a => a
mempty
regularly :: Seconds -> IO () -> IO (Async ())
regularly :: Seconds -> IO () -> IO (Async ())
regularly Seconds
delay IO ()
act = IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO ()
act IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Seconds -> IO ()
sleep Seconds
delay)