{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
module Core.Telemetry.Observability (
Exporter,
initializeTelemetry,
Trace (..),
Span (..),
beginTrace,
usingTrace,
setServiceName,
Label,
encloseSpan,
setStartTime,
MetricValue,
Telemetry (metric),
telemetry,
sendEvent,
) where
import Control.Concurrent.MVar (modifyMVar_, newMVar, readMVar)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue (writeTQueue)
import Core.Data.Structures (Map, insertKeyValue)
import Core.Encoding.Json
import Core.Program.Arguments
import Core.Program.Context
import Core.Program.Logging
import Core.System.Base (liftIO)
import Core.System.External (TimeStamp (unTimeStamp), getCurrentTimeNanoseconds)
import Core.Text.Rope
import Core.Text.Utilities (oxford, quote)
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Lazy as L (ByteString)
import Data.Char (chr)
import Data.Int (Int32, Int64)
import qualified Data.List as List (foldl')
import Data.Scientific (Scientific)
import qualified Data.Text as T (Text)
import qualified Data.Text.Lazy as U (Text)
import System.Random (newStdGen, randomRs)
data MetricValue
= MetricValue JsonKey JsonValue
deriving (Int -> MetricValue -> ShowS
[MetricValue] -> ShowS
MetricValue -> String
(Int -> MetricValue -> ShowS)
-> (MetricValue -> String)
-> ([MetricValue] -> ShowS)
-> Show MetricValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricValue] -> ShowS
$cshowList :: [MetricValue] -> ShowS
show :: MetricValue -> String
$cshow :: MetricValue -> String
showsPrec :: Int -> MetricValue -> ShowS
$cshowsPrec :: Int -> MetricValue -> ShowS
Show)
setServiceName :: Rope -> Program τ ()
setServiceName :: Rope -> Program τ ()
setServiceName Rope
service = do
Context τ
context <- Program τ (Context τ)
forall τ. Program τ (Context τ)
getContext
let v :: MVar Datum
v = Context τ -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context τ
context
IO () -> Program τ ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Program τ ()) -> IO () -> Program τ ()
forall a b. (a -> b) -> a -> b
$ do
MVar Datum -> (Datum -> IO Datum) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_
MVar Datum
v
( \Datum
datum -> do
let datum' :: Datum
datum' =
Datum
datum
{ $sel:serviceNameFrom:Datum :: Maybe Rope
serviceNameFrom = Rope -> Maybe Rope
forall a. a -> Maybe a
Just Rope
service
}
Datum -> IO Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum
datum'
)
class Telemetry σ where
metric :: Rope -> σ -> MetricValue
instance Telemetry Int where
metric :: Rope -> Int -> MetricValue
metric Rope
k Int
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v))
instance Telemetry Int32 where
metric :: Rope -> Int32 -> MetricValue
metric Rope
k Int32
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v))
instance Telemetry Int64 where
metric :: Rope -> Int64 -> MetricValue
metric Rope
k Int64
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v))
instance Telemetry Integer where
metric :: Rope -> Integer -> MetricValue
metric Rope
k Integer
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Integer
v))
instance Telemetry Float where
metric :: Rope -> Float -> MetricValue
metric Rope
k Float
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Float -> Rational
forall a. Real a => a -> Rational
toRational Float
v)))
instance Telemetry Double where
metric :: Rope -> Double -> MetricValue
metric Rope
k Double
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
v)))
instance Telemetry Scientific where
metric :: Rope -> Scientific -> MetricValue
metric Rope
k Scientific
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Scientific -> JsonValue
JsonNumber Scientific
v)
instance Telemetry Rope where
metric :: Rope -> Rope -> MetricValue
metric Rope
k Rope
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString Rope
v)
instance Telemetry String where
metric :: Rope -> String -> MetricValue
metric Rope
k String
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString (String -> Rope
forall α. Textual α => α -> Rope
intoRope String
v))
instance Telemetry B.ByteString where
metric :: Rope -> ByteString -> MetricValue
metric Rope
k ByteString
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString (ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope ByteString
v))
instance Telemetry L.ByteString where
metric :: Rope -> ByteString -> MetricValue
metric Rope
k ByteString
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString (ByteString -> Rope
forall α. Textual α => α -> Rope
intoRope ByteString
v))
instance Telemetry T.Text where
metric :: Rope -> Text -> MetricValue
metric Rope
k Text
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
v))
instance Telemetry U.Text where
metric :: Rope -> Text -> MetricValue
metric Rope
k Text
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Rope -> JsonValue
JsonString (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
v))
instance Telemetry Bool where
metric :: Rope -> Bool -> MetricValue
metric Rope
k Bool
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) (Bool -> JsonValue
JsonBool Bool
v)
instance Telemetry JsonValue where
metric :: Rope -> JsonValue -> MetricValue
metric Rope
k JsonValue
v = JsonKey -> JsonValue -> MetricValue
MetricValue (Rope -> JsonKey
JsonKey Rope
k) JsonValue
v
initializeTelemetry :: [Exporter] -> Context τ -> IO (Context τ)
initializeTelemetry :: [Exporter] -> Context τ -> IO (Context τ)
initializeTelemetry [Exporter]
exporters1 Context τ
context =
let exporters0 :: [Exporter]
exporters0 = Context τ -> [Exporter]
forall τ. Context τ -> [Exporter]
initialExportersFrom Context τ
context
exporters2 :: [Exporter]
exporters2 = [Exporter]
exporters0 [Exporter] -> [Exporter] -> [Exporter]
forall a. [a] -> [a] -> [a]
++ [Exporter]
exporters1
codenames :: [Rope]
codenames =
(Rope -> Rope) -> [Rope] -> [Rope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rope
name -> Char -> Rope
singletonRope Char
'"' Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
name Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Char -> Rope
singletonRope Char
'"')
([Rope] -> [Rope])
-> ([Exporter] -> [Rope]) -> [Exporter] -> [Rope]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exporter -> Rope) -> [Exporter] -> [Rope]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exporter -> Rope
codenameFrom
([Exporter] -> [Rope]) -> [Exporter] -> [Rope]
forall a b. (a -> b) -> a -> b
$ [Exporter]
exporters2
config0 :: Config
config0 = Context τ -> Config
forall τ. Context τ -> Config
initialConfigFrom Context τ
context
config1 :: Config
config1 =
Options -> Config -> Config
appendOption
( LongName -> Maybe Char -> ParameterValue -> Rope -> Options
Option
LongName
"telemetry"
Maybe Char
forall a. Maybe a
Nothing
(String -> ParameterValue
Value String
"EXPORTER")
( [quote|
Turn on telemetry. Tracing data and metrics from events
will be forwarded via the specified exporter. Valid values
are
|]
Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [Rope] -> Rope
oxford [Rope]
codenames
)
)
Config
config0
config2 :: Config
config2 = (Config -> Exporter -> Config) -> Config -> [Exporter] -> Config
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Config -> Exporter -> Config
f Config
config1 [Exporter]
exporters2
in Context τ -> IO (Context τ)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Context τ
context
{ $sel:initialConfigFrom:Context :: Config
initialConfigFrom = Config
config2
, $sel:initialExportersFrom:Context :: [Exporter]
initialExportersFrom = [Exporter]
exporters2
}
)
where
f :: Config -> Exporter -> Config
f :: Config -> Exporter -> Config
f Config
config Exporter
exporter =
let setup :: Config -> Config
setup = Exporter -> Config -> Config
setupConfigFrom Exporter
exporter
in Config -> Config
setup Config
config
type Label = Rope
encloseSpan :: Label -> Program z a -> Program z a
encloseSpan :: Rope -> Program z a -> Program z a
encloseSpan Rope
label Program z a
action = do
Context z
context <- Program z (Context z)
forall τ. Program τ (Context τ)
getContext
Rope
unique <- IO Rope -> Program z Rope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Rope
randomIdentifier
Rope -> Rope -> Program z ()
forall τ. Rope -> Rope -> Program τ ()
debug Rope
"span" Rope
unique
IO a -> Program z a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Program z a) -> IO a -> Program z a
forall a b. (a -> b) -> a -> b
$ do
TimeStamp
start <- IO TimeStamp
getCurrentTimeNanoseconds
let v :: MVar Datum
v = Context z -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context z
context
Datum
datum <- MVar Datum -> IO Datum
forall a. MVar a -> IO a
readMVar MVar Datum
v
let datum' :: Datum
datum' =
Datum
datum
{ $sel:spanIdentifierFrom:Datum :: Maybe Span
spanIdentifierFrom = Span -> Maybe Span
forall a. a -> Maybe a
Just (Rope -> Span
Span Rope
unique)
, $sel:spanNameFrom:Datum :: Rope
spanNameFrom = Rope
label
, $sel:spanTimeFrom:Datum :: TimeStamp
spanTimeFrom = TimeStamp
start
, $sel:parentIdentifierFrom:Datum :: Maybe Span
parentIdentifierFrom = Datum -> Maybe Span
spanIdentifierFrom Datum
datum
}
MVar Datum
v2 <- Datum -> IO (MVar Datum)
forall a. a -> IO (MVar a)
newMVar Datum
datum'
let context2 :: Context z
context2 =
Context z
context
{ $sel:currentDatumFrom:Context :: MVar Datum
currentDatumFrom = MVar Datum
v2
}
a
result <- Context z -> Program z a -> IO a
forall τ α. Context τ -> Program τ α -> IO α
subProgram Context z
context2 Program z a
action
TimeStamp
finish <- IO TimeStamp
getCurrentTimeNanoseconds
Datum
datum2 <- MVar Datum -> IO Datum
forall a. MVar a -> IO a
readMVar MVar Datum
v2
let datum2' :: Datum
datum2' =
Datum
datum2
{ $sel:durationFrom:Datum :: Maybe Int64
durationFrom = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (TimeStamp -> Int64
unTimeStamp TimeStamp
finish Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- TimeStamp -> Int64
unTimeStamp TimeStamp
start)
}
let tel :: TQueue (Maybe Datum)
tel = Context z -> TQueue (Maybe Datum)
forall τ. Context τ -> TQueue (Maybe Datum)
telemetryChannelFrom Context z
context
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
TQueue (Maybe Datum) -> Maybe Datum -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe Datum)
tel (Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
datum2')
a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
represent :: Int -> Char
represent :: Int -> Char
represent Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Int
65 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
62 = Int -> Char
chr (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
36)
| Bool
otherwise = Char
'@'
randomIdentifier :: IO Rope
randomIdentifier :: IO Rope
randomIdentifier = do
StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
let result :: Rope
result = String -> Rope
packRope (String -> Rope) -> (StdGen -> String) -> StdGen -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
represent ([Int] -> String) -> (StdGen -> [Int]) -> StdGen -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
16 ([Int] -> [Int]) -> (StdGen -> [Int]) -> StdGen -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0, Int
61) (StdGen -> Rope) -> StdGen -> Rope
forall a b. (a -> b) -> a -> b
$ StdGen
gen
Rope -> IO Rope
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
result
beginTrace :: Program τ α -> Program τ α
beginTrace :: Program τ α -> Program τ α
beginTrace Program τ α
action = do
Rope
trace <- IO Rope -> Program τ Rope
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Rope
randomIdentifier
Trace -> Maybe Span -> Program τ α -> Program τ α
forall τ α. Trace -> Maybe Span -> Program τ α -> Program τ α
usingTrace (Rope -> Trace
Trace Rope
trace) Maybe Span
forall a. Maybe a
Nothing Program τ α
action
usingTrace :: Trace -> Maybe Span -> Program τ α -> Program τ α
usingTrace :: Trace -> Maybe Span -> Program τ α -> Program τ α
usingTrace Trace
trace Maybe Span
possibleParent Program τ α
action = do
Context τ
context <- Program τ (Context τ)
forall τ. Program τ (Context τ)
getContext
case Maybe Span
possibleParent of
Maybe Span
Nothing -> do
Rope -> Rope -> Program τ ()
forall τ. Rope -> Rope -> Program τ ()
debug Rope
"trace" (Trace -> Rope
unTrace Trace
trace)
Just Span
parent -> do
Rope -> Rope -> Program τ ()
forall τ. Rope -> Rope -> Program τ ()
debug Rope
"trace" (Trace -> Rope
unTrace Trace
trace)
Rope -> Rope -> Program τ ()
forall τ. Rope -> Rope -> Program τ ()
debug Rope
"parent" (Span -> Rope
unSpan Span
parent)
IO α -> Program τ α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO α -> Program τ α) -> IO α -> Program τ α
forall a b. (a -> b) -> a -> b
$ do
let v :: MVar Datum
v = Context τ -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context τ
context
Datum
datum <- MVar Datum -> IO Datum
forall a. MVar a -> IO a
readMVar MVar Datum
v
let datum2 :: Datum
datum2 =
Datum
datum
{ $sel:traceIdentifierFrom:Datum :: Maybe Trace
traceIdentifierFrom = Trace -> Maybe Trace
forall a. a -> Maybe a
Just Trace
trace
, $sel:parentIdentifierFrom:Datum :: Maybe Span
parentIdentifierFrom = Maybe Span
possibleParent
}
MVar Datum
v2 <- Datum -> IO (MVar Datum)
forall a. a -> IO (MVar a)
newMVar Datum
datum2
let context2 :: Context τ
context2 =
Context τ
context
{ $sel:currentDatumFrom:Context :: MVar Datum
currentDatumFrom = MVar Datum
v2
}
Context τ -> Program τ α -> IO α
forall τ α. Context τ -> Program τ α -> IO α
subProgram Context τ
context2 Program τ α
action
telemetry :: [MetricValue] -> Program τ ()
telemetry :: [MetricValue] -> Program τ ()
telemetry [MetricValue]
values = do
Context τ
context <- Program τ (Context τ)
forall τ. Program τ (Context τ)
getContext
IO () -> Program τ ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Program τ ()) -> IO () -> Program τ ()
forall a b. (a -> b) -> a -> b
$ do
let v :: MVar Datum
v = Context τ -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context τ
context
MVar Datum -> (Datum -> IO Datum) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_
MVar Datum
v
( \Datum
datum -> do
let meta :: Map JsonKey JsonValue
meta = Datum -> Map JsonKey JsonValue
attachedMetadataFrom Datum
datum
let meta' :: Map JsonKey JsonValue
meta' = (Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue)
-> Map JsonKey JsonValue -> [MetricValue] -> Map JsonKey JsonValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f Map JsonKey JsonValue
meta [MetricValue]
values
let datum' :: Datum
datum' =
Datum
datum
{ $sel:attachedMetadataFrom:Datum :: Map JsonKey JsonValue
attachedMetadataFrom = Map JsonKey JsonValue
meta'
}
Datum -> IO Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum
datum'
)
where
f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f Map JsonKey JsonValue
acc (MetricValue JsonKey
k JsonValue
v) = JsonKey
-> JsonValue -> Map JsonKey JsonValue -> Map JsonKey JsonValue
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
k JsonValue
v Map JsonKey JsonValue
acc
sendEvent :: Label -> [MetricValue] -> Program τ ()
sendEvent :: Rope -> [MetricValue] -> Program τ ()
sendEvent Rope
label [MetricValue]
values = do
Context τ
context <- Program τ (Context τ)
forall τ. Program τ (Context τ)
getContext
IO () -> Program τ ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Program τ ()) -> IO () -> Program τ ()
forall a b. (a -> b) -> a -> b
$ do
TimeStamp
now <- IO TimeStamp
getCurrentTimeNanoseconds
let v :: MVar Datum
v = Context τ -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context τ
context
Datum
datum <- MVar Datum -> IO Datum
forall a. MVar a -> IO a
readMVar MVar Datum
v
let meta :: Map JsonKey JsonValue
meta = Datum -> Map JsonKey JsonValue
attachedMetadataFrom Datum
datum
let meta' :: Map JsonKey JsonValue
meta' = (Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue)
-> Map JsonKey JsonValue -> [MetricValue] -> Map JsonKey JsonValue
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f Map JsonKey JsonValue
meta [MetricValue]
values
let datum' :: Datum
datum' =
Datum
datum
{ $sel:spanNameFrom:Datum :: Rope
spanNameFrom = Rope
label
, $sel:spanIdentifierFrom:Datum :: Maybe Span
spanIdentifierFrom = Maybe Span
forall a. Maybe a
Nothing
, $sel:parentIdentifierFrom:Datum :: Maybe Span
parentIdentifierFrom = Datum -> Maybe Span
spanIdentifierFrom Datum
datum
, $sel:spanTimeFrom:Datum :: TimeStamp
spanTimeFrom = TimeStamp
now
, $sel:attachedMetadataFrom:Datum :: Map JsonKey JsonValue
attachedMetadataFrom = Map JsonKey JsonValue
meta'
}
let tel :: TQueue (Maybe Datum)
tel = Context τ -> TQueue (Maybe Datum)
forall τ. Context τ -> TQueue (Maybe Datum)
telemetryChannelFrom Context τ
context
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
TQueue (Maybe Datum) -> Maybe Datum -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe Datum)
tel (Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
datum')
where
f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
f Map JsonKey JsonValue
acc (MetricValue JsonKey
k JsonValue
v) = JsonKey
-> JsonValue -> Map JsonKey JsonValue -> Map JsonKey JsonValue
forall κ ν. Key κ => κ -> ν -> Map κ ν -> Map κ ν
insertKeyValue JsonKey
k JsonValue
v Map JsonKey JsonValue
acc
setStartTime :: TimeStamp -> Program τ ()
setStartTime :: TimeStamp -> Program τ ()
setStartTime TimeStamp
time = do
Context τ
context <- Program τ (Context τ)
forall τ. Program τ (Context τ)
getContext
IO () -> Program τ ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Program τ ()) -> IO () -> Program τ ()
forall a b. (a -> b) -> a -> b
$ do
let v :: MVar Datum
v = Context τ -> MVar Datum
forall τ. Context τ -> MVar Datum
currentDatumFrom Context τ
context
MVar Datum -> (Datum -> IO Datum) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_
MVar Datum
v
(\Datum
datum -> Datum -> IO Datum
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum
datum{$sel:spanTimeFrom:Datum :: TimeStamp
spanTimeFrom = TimeStamp
time})