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)

-- | Dump monitoring to the eventlog using the Opentelemetry package
monitoring :: IO Monitoring
monitoring :: IO Monitoring
monitoring
  | Bool
userTracingEnabled = do
    IORef [IO ()]
actions <- forall a. a -> IO (IORef a)
newIORef []
    let registerCounter :: Text -> IO a -> IO ()
registerCounter Text
name IO a
read = do
            ValueObserver
observer <- forall (m :: * -> *).
MonadIO m =>
InstrumentName -> m ValueObserver
mkValueObserver (Text -> InstrumentName
encodeUtf8 Text
name)
            let update :: IO ()
update = forall (m :: * -> *) (a :: Additivity) (m' :: Monotonicity).
MonadIO m =>
Instrument 'Asynchronous a m' -> Int -> m ()
observe ValueObserver
observer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
read
            forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'_ IORef [IO ()]
actions (IO ()
update forall a. a -> [a] -> [a]
:)
        registerGauge :: Text -> IO Int64 -> IO ()
registerGauge = forall {a}. Integral a => Text -> IO a -> IO ()
registerCounter
    let start :: IO (IO ())
start = do
            Async ()
a <- Seconds -> IO () -> IO (Async ())
regularly Seconds
1 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef IORef [IO ()]
actions
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Async a -> IO ()
cancel Async ()
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 ()
start :: IO (IO ())
registerCounter :: Text -> IO Int64 -> IO ()
registerGauge :: Text -> IO Int64 -> IO ()
start :: IO (IO ())
registerGauge :: Text -> IO Int64 -> IO ()
registerCounter :: forall {a}. Integral a => Text -> IO a -> IO ()
..}
  | Bool
otherwise = forall a. Monoid a => a
mempty


regularly :: Seconds -> IO () -> IO (Async ())
regularly :: Seconds -> IO () -> IO (Async ())
regularly Seconds
delay IO ()
act = forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO ()
act forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Seconds -> IO ()
sleep Seconds
delay)