core-telemetry 0.1.7.2 → 0.1.7.3
raw patch · 3 files changed
+67/−29 lines, 3 filesdep +locatorsdep +uuiddep ~core-programPVP ok
version bump matches the API change (PVP)
Dependencies added: locators, uuid
Dependency ranges changed: core-program
API changes (from Hackage documentation)
Files
- core-telemetry.cabal +4/−2
- lib/Core/Telemetry/Console.hs +6/−5
- lib/Core/Telemetry/Observability.hs +57/−22
core-telemetry.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: core-telemetry-version: 0.1.7.2+version: 0.1.7.3 synopsis: Advanced telemetry description: This is part of a library to help build command-line programs, both tools and longer-running daemons.@@ -53,11 +53,12 @@ , bytestring , chronologique , core-data >=0.2.1.11- , core-program >=0.3.0.8+ , core-program >=0.3.4 , core-text >=0.3.5 , exceptions , http-streams , io-streams+ , locators , mtl , random , safe-exceptions@@ -66,4 +67,5 @@ , template-haskell >=2.14 && <3 , text , unix+ , uuid default-language: Haskell2010
lib/Core/Telemetry/Console.hs view
@@ -34,7 +34,7 @@ import Core.Text.Utilities import qualified Data.List as List -{-|+{- | Output metrics to the terminal. This is mostly useful for debugging, but it can also be used as general output mechanism if your program is mostly concerned with gathering metrics and displaying them.@@ -67,20 +67,21 @@ processOne datum = do let start = spanTimeFrom datum let text =- (intoEscapes pureGrey)+ singletonRope '\n'+ <> intoEscapes pureGrey <> spanNameFrom datum <> singletonRope ':' <> let pairs :: [(JsonKey, JsonValue)] pairs = fromMap (attachedMetadataFrom datum) in List.foldl' f emptyRope pairs- <> (intoEscapes resetColour)+ <> intoEscapes resetColour now <- getCurrentTimeNanoseconds let result = formatLogMessage start now- SeverityDebug+ SeverityInternal text atomically $ do writeTQueue out (Just result)@@ -88,7 +89,7 @@ f :: Rope -> (JsonKey, JsonValue) -> Rope f acc (k, v) = acc <> "\n "- <> (intoEscapes pureGrey)+ <> intoEscapes pureGrey <> intoRope k <> " = " <> render 80 v
lib/Core/Telemetry/Observability.hs view
@@ -164,6 +164,7 @@ import Core.Encoding.Json import Core.Program.Arguments import Core.Program.Context+import Core.Program.Execute (sleepThread) import Core.Program.Logging import Core.System.Base (liftIO) import Core.System.External (TimeStamp (unTimeStamp), getCurrentTimeNanoseconds)@@ -171,13 +172,14 @@ 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.Locator (padWithZeros, toBase62, toLatin25) import Data.Scientific (Scientific) import qualified Data.Text as T (Text) import qualified Data.Text.Lazy as U (Text)-import System.Random (newStdGen, randomRs)+import Data.UUID (UUID, toWords)+import Data.UUID.V1 (nextUUID) {- | A telemetry value that can be sent over the wire. This is a wrapper around@@ -378,8 +380,9 @@ encloseSpan label action = do context <- getContext - unique <- liftIO randomIdentifier- debug "span" unique+ unique <- generateIdentifierBase62+ internal label emptyRope+ internal "span = " unique liftIO $ do -- prepare new span@@ -426,21 +429,54 @@ -- now back to your regularly scheduled Haskell program pure result -represent :: Int -> Char-represent x- | x < 10 = chr (48 + x)- | x < 36 = chr (65 + x - 10)- | x < 62 = chr (97 + x - 36)- | otherwise = '@'+getUniqueId :: Program τ UUID+getUniqueId = do+ next <- liftIO nextUUID+ case next of+ Just uuid -> pure uuid+ Nothing -> do+ sleepThread 0.000001+ getUniqueId --- TODO replace this with something that gets a UUID-randomIdentifier :: IO Rope-randomIdentifier = do- gen <- newStdGen- let result = packRope . fmap represent . take 16 . randomRs (0, 61) $ gen+{- |+Generate a UUID but expressed in Latin 25, with least significant bits (the+time stamp) ordered to the left so that visual distinctiveness is on the left.+The MAC address in the lower 48 bits is /not/ reversed, leaving the most+distinctiveness [the actual host as opposed to manufacturer] hanging on the+right hand edge of the identifier.+-}+generateIdentifierLatin25 :: Program τ Rope+generateIdentifierLatin25 = do+ uuid <- getUniqueId+ let (w1, w2, w3, w4) = toWords uuid+ l1 = convertL w1+ l2 = convertL w2+ l3 = convertB w3+ l4 = convertB w4+ result = l1 <> l2 <> l3 <> l4 pure result+ where+ convertL = intoRope . padWithZeros 7 . reverse . toLatin25 . fromIntegral+ convertB = intoRope . padWithZeros 7 . toLatin25 . fromIntegral {- |+Generate a UUID but expressed in Base 62.+-}+generateIdentifierBase62 :: Program τ Rope+generateIdentifierBase62 = do+ uuid <- getUniqueId+ let (w1, w2, w3, w4) = toWords uuid+ b1 = convertL w1+ b2 = convertL w2+ b3 = convertB w3+ b4 = convertB w4+ result = b1 <> b2 <> b3 <> b4+ pure result+ where+ convertL = intoRope . padWithZeros 6 . reverse . toBase62 . fromIntegral+ convertB = intoRope . padWithZeros 6 . toBase62 . fromIntegral++{- | Start a new trace. A random identifier will be generated. You /must/ have a single \"root span\" immediately below starting a new trace.@@ -455,7 +491,7 @@ -} beginTrace :: Program τ α -> Program τ α beginTrace action = do- trace <- liftIO randomIdentifier+ trace <- generateIdentifierLatin25 usingTrace (Trace trace) Nothing action {- |@@ -490,10 +526,10 @@ case possibleParent of Nothing -> do- debug "trace" (unTrace trace)+ internal "trace = " (unTrace trace) Just parent -> do- debug "trace" (unTrace trace)- debug "parent" (unSpan parent)+ internal "trace = " (unTrace trace)+ internal "parent = " (unSpan parent) liftIO $ do -- prepare new span@@ -564,15 +600,14 @@ Record telemetry about an event. Specify a label for the event and then whichever metrics you wish to record. - The emphasis of this package is to create traces and spans. There are, however, times when you just want to send telemetry about an event. You can use 'sendEvent' to accomplish this. If you do call 'sendEvent' within an enclosing span created with 'encloseSpan' (the usual and expected use case) then this event will be \"linked\" to this-span so that the observability tool can display it attached to the span in-the in which it occured.+span so that the observability tool can display it attached to the span in the+in which it occured. @ 'sendEvent'