diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,19 @@
+Copyright © 2018-2021 Athae Eredh Siniath and Others
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
diff --git a/core-telemetry.cabal b/core-telemetry.cabal
new file mode 100644
--- /dev/null
+++ b/core-telemetry.cabal
@@ -0,0 +1,65 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           core-telemetry
+version:        0.1.6.0
+synopsis:       Advanced telemetry
+description:    This is part of a library to help build command-line programs, both tools and
+                longer-running daemons.
+                .
+                This package in particular adds helpers for recording telemetry for
+                subsequent analysis. You can instrument your code with tracing and spans,
+                and also emit events carrying arbitrary metadata. Backends are provided for
+                structured logs, sending traces to observability services, or even just
+                outputting the telemetry to console.
+                .
+                See "Core.Telemetry.Observability" to get started.
+category:       System
+stability:      experimental
+homepage:       https://github.com/aesiniath/unbeliever#readme
+bug-reports:    https://github.com/aesiniath/unbeliever/issues
+author:         Andrew Cowie <istathar@gmail.com>
+maintainer:     Andrew Cowie <istathar@gmail.com>
+copyright:      © 2021 Athae Eredh Siniath and Others
+license:        MIT
+license-file:   LICENSE
+build-type:     Simple
+tested-with:
+    GHC == 8.10.7
+
+source-repository head
+  type: git
+  location: https://github.com/aesiniath/unbeliever
+
+library
+  exposed-modules:
+      Core.Telemetry
+      Core.Telemetry.Observability
+      Core.Telemetry.Console
+      Core.Telemetry.Honeycomb
+  hs-source-dirs:
+      lib
+  ghc-options: -Wall -Wwarn -fwarn-tabs
+  build-depends:
+      async
+    , base >=4.11 && <5
+    , bytestring
+    , chronologique
+    , core-data
+    , core-program >=0.3.0
+    , core-text >=0.3.2
+    , exceptions
+    , http-streams
+    , io-streams
+    , mtl
+    , random
+    , safe-exceptions
+    , scientific
+    , stm
+    , template-haskell >=2.14 && <3
+    , text
+    , unix
+  default-language: Haskell2010
diff --git a/lib/Core/Telemetry.hs b/lib/Core/Telemetry.hs
new file mode 100644
--- /dev/null
+++ b/lib/Core/Telemetry.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_HADDOCK not-home #-}
+
+{- |
+Support for building observability into your program by marking spans and
+sub-spans, forming them into traces, and sending them to a backend capable of
+ingesting such telemetry and performing analysis on it.
+
+This is intended to be used directly:
+
+@
+import "Core.Telemetry"
+@
+
+the submodules are mostly there to group documentation, along with grouping
+the implementations for each of the different supported backends.
+-}
+module Core.Telemetry (
+    -- * Traces and Spans
+
+    -- |
+    -- Adding observability tracing to your program.
+    module Core.Telemetry.Observability,
+
+    -- * Exporting to backends
+
+    -- |
+    -- Processors to export telemetry to a backend.
+    module Core.Telemetry.Console,
+    module Core.Telemetry.Honeycomb,
+) where
+
+import Core.Telemetry.Console
+import Core.Telemetry.Honeycomb
+import Core.Telemetry.Observability
diff --git a/lib/Core/Telemetry/Console.hs b/lib/Core/Telemetry/Console.hs
new file mode 100644
--- /dev/null
+++ b/lib/Core/Telemetry/Console.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+{- |
+Implementations of different backends that telemetry can be exported to.
+-}
+module Core.Telemetry.Console (
+    consoleExporter,
+) where
+
+import Control.Concurrent.STM (atomically)
+import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)
+import Core.Data.Structures (fromMap)
+import Core.Encoding.Json
+import Core.Program.Arguments
+import Core.Program.Context
+import Core.Program.Logging
+import Core.System.External (getCurrentTimeNanoseconds)
+import Core.Text.Colour
+import Core.Text.Rope
+import Core.Text.Utilities
+import qualified Data.List as List
+
+-- TODO convert this into a Render instance
+
+consoleExporter :: Exporter
+consoleExporter =
+    Exporter
+        { codenameFrom = "console"
+        , setupConfigFrom = setupConsoleConfig
+        , setupActionFrom = setupConsoleAction
+        }
+
+setupConsoleConfig :: Config -> Config
+setupConsoleConfig = id
+
+setupConsoleAction :: Context τ -> IO Forwarder
+setupConsoleAction context = do
+    let out = outputChannelFrom context
+    pure
+        ( Forwarder
+            { telemetryHandlerFrom = process out
+            }
+        )
+
+process :: TQueue (Maybe Rope) -> [Datum] -> IO ()
+process out datums = do
+    mapM_ processOne datums
+  where
+    processOne :: Datum -> IO ()
+    processOne datum = do
+        now <- getCurrentTimeNanoseconds
+        let start = spanTimeFrom datum
+        let text =
+                (intoEscapes pureGrey)
+                    <> spanNameFrom datum
+                    <> singletonRope ':'
+                    <> let pairs :: [(JsonKey, JsonValue)]
+                           pairs = fromMap (attachedMetadataFrom datum)
+                        in List.foldl' f emptyRope pairs
+                            <> (intoEscapes resetColour)
+
+        let result = formatLogMessage start now SeverityDebug text
+        atomically $ do
+            writeTQueue out (Just result)
+
+f :: Rope -> (JsonKey, JsonValue) -> Rope
+f acc (k, v) =
+    acc <> "\n  "
+        <> (intoEscapes pureGrey)
+        <> intoRope k
+        <> " = "
+        <> render 80 v
diff --git a/lib/Core/Telemetry/Honeycomb.hs b/lib/Core/Telemetry/Honeycomb.hs
new file mode 100644
--- /dev/null
+++ b/lib/Core/Telemetry/Honeycomb.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
+{- |
+A backend exporter that sends telemetry in the form of traces of your
+application's behaviour, or event data—accompanied either way by [conceivably
+very wide] additional metadata—to the Honeycomb observability service.
+
+When specifying the 'honeycombExporter' you have to specify certain
+command-line options and environment variables to enable it:
+
+@
+\$ export HONEYCOMB_TEAM="62e3626a2cc34475adef4d799eca0407"
+\$ burger-service --telemetry=honeycomb --dataset=prod-restaurant-001
+@
+
+/Notice/
+
+This library is Open Source but the Honeycomb service is /not/. Honeycomb
+offers a free tier which is quite suitable for individual use and small local
+applications. You can also look at "Core.Telemetry.Other" if you instead want
+to forward to a generic OpenTelemetry provider. There's also
+"Core.Telemetry.Console" which simply dumps telemetry to console.
+-}
+module Core.Telemetry.Honeycomb (
+    Dataset,
+    honeycombExporter,
+) where
+
+import Core.Data.Structures (Map, fromMap, insertKeyValue, intoMap, lookupKeyValue)
+import Core.Encoding.Json
+import Core.Program.Arguments
+import Core.Program.Context
+import Core.Program.Logging
+import Core.System.Base (stdout)
+import Core.System.External (TimeStamp (unTimeStamp), getCurrentTimeNanoseconds)
+import Core.Text.Bytes
+import Core.Text.Colour
+import Core.Text.Rope
+import Core.Text.Utilities
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B (ByteString)
+import qualified Data.ByteString.Char8 as C (append, null, putStrLn)
+import qualified Data.ByteString.Lazy as L (ByteString)
+import Data.Fixed
+import qualified Data.List as List
+import Network.Http.Client
+import System.Environment (lookupEnv)
+import System.Exit (ExitCode (..))
+import System.IO.Streams (InputStream)
+import qualified System.Posix.Process as Posix (exitImmediately)
+
+{- |
+Indicate which \"dataset\" spans and events will be posted into
+-}
+type Dataset = Rope
+
+type ApiKey = Rope
+
+{- |
+Configure your application to send telemetry in the form of spans and traces
+to the Honeycomb observability service.
+
+@
+    context <- 'Core.Program.Execute.configure' ...
+    context' <- 'Core.Telemetry.Observability.initializeTelemetry' ['honeycombExporter'] context
+    'Core.Program.Execute.executeWith' context' ...
+@
+-}
+honeycombExporter :: Exporter
+honeycombExporter =
+    Exporter
+        { codenameFrom = "honeycomb"
+        , setupConfigFrom = setupHoneycombConfig
+        , setupActionFrom = setupHoneycombAction
+        }
+
+-- so this is annoying: we're _under_ (and indeed, before) the Program monad
+-- and in the guts of the library. So all the work we've done to provide
+-- sensible access to environment variables etc isn't available here and we
+-- have to replicate a bunch of stuff we've done elsewhere.
+
+setupHoneycombConfig :: Config -> Config
+setupHoneycombConfig config0 =
+    let config1 =
+            appendOption
+                ( Variable
+                    "HONEYCOMB_TEAM"
+                    "The API key used to permit writes to Honeycomb."
+                )
+                config0
+
+        config2 =
+            appendOption
+                ( Option
+                    "dataset"
+                    Nothing
+                    (Value "DATASET")
+                    "The name of the dataset within your Honeycomb account that this program's telemetry will be written to."
+                )
+                config1
+     in config2
+
+setupHoneycombAction :: Context τ -> IO Forwarder
+setupHoneycombAction context = do
+    let params = commandLineFrom context
+        pairs = environmentValuesFrom params
+        possibleTeam = lookupKeyValue "HONEYCOMB_TEAM" pairs
+
+    apikey <- case possibleTeam of
+        Nothing -> do
+            putStrLn "error: Need to supply an API key in the HONEYCOMB_TEAM environment variable."
+            Posix.exitImmediately (ExitFailure 99)
+            undefined
+        Just param -> case param of
+            Empty -> do
+                putStrLn "error: Need to actually supply a value in HONEYCOMB_TEAM environment variable."
+                Posix.exitImmediately (ExitFailure 99)
+                undefined
+            Value value -> pure (intoRope value)
+
+    let options = parameterValuesFrom params
+        possibleDataset = lookupKeyValue "dataset" options
+
+    dataset <- case possibleDataset of
+        Nothing -> do
+            putStrLn "error: Need to specify the dataset that metrics will be written to via --dataset."
+            Posix.exitImmediately (ExitFailure 99)
+            undefined
+        Just param -> case param of
+            Empty -> do
+                putStrLn "error: Need to actually supply a value to the --dataset option."
+                Posix.exitImmediately (ExitFailure 99)
+                undefined
+            Value "" -> do
+                putStrLn "error: Need to actually supply a value to the --dataset option."
+                Posix.exitImmediately (ExitFailure 99)
+                undefined
+            Value value -> pure (intoRope value)
+
+    pure
+        Forwarder
+            { telemetryHandlerFrom = process apikey dataset
+            }
+
+-- use partually applied
+process :: ApiKey -> Dataset -> [Datum] -> IO ()
+process apikey dataset datums = do
+    let json = JsonArray (fmap convertDatumToJson datums)
+    postEventToHoneycombAPI apikey dataset json
+
+convertDatumToJson :: Datum -> JsonValue
+convertDatumToJson datum =
+    let spani = spanIdentifierFrom datum
+        trace = traceIdentifierFrom datum
+        parent = parentIdentifierFrom datum
+        meta0 = attachedMetadataFrom datum
+
+        meta1 = insertKeyValue "name" (JsonString (spanNameFrom datum)) meta0
+
+        meta2 = case spani of
+            Nothing -> case trace of
+                Nothing -> meta1
+                Just _ -> insertKeyValue "meta.annotation_type" (JsonString "span_event") meta1
+            Just value -> insertKeyValue "trace.span_id" (JsonString (unSpan value)) meta1
+
+        meta3 = case parent of
+            Nothing -> meta2
+            Just value -> insertKeyValue "trace.parent_id" (JsonString (unSpan value)) meta2
+
+        meta4 = case trace of
+            Nothing -> meta3
+            Just value -> insertKeyValue "trace.trace_id" (JsonString (unTrace value)) meta3
+
+        meta5 = case serviceNameFrom datum of
+            Nothing -> meta4
+            Just service -> insertKeyValue "service_name" (JsonString service) meta4
+
+        meta6 = case durationFrom datum of
+            Nothing -> meta5
+            Just duration ->
+                insertKeyValue
+                    "duration_ms"
+                    (JsonNumber (fromRational (toRational duration / 1e6)))
+                    meta5
+
+        -- start = show (fromRational (toRational (spanTimeFrom datum) / 1e9) :: Fixed E9)
+        -- meta7 = insertKeyValue "timestamp" (JsonString (intoRope (show (spanTimeFrom datum)))) meta6
+        time = intoRope (show (spanTimeFrom datum))
+        point =
+            JsonObject
+                ( intoMap
+                    [ (JsonKey "time", JsonString time)
+                    , (JsonKey "data", JsonObject meta6)
+                    ]
+                )
+     in point
+
+postEventToHoneycombAPI :: ApiKey -> Dataset -> JsonValue -> IO ()
+postEventToHoneycombAPI apikey dataset json = do
+    ctx <- baselineContextSSL
+    c <- openConnectionSSL ctx "api.honeycomb.io" 443
+
+    let q = buildRequest1 $ do
+            http POST (C.append "/1/batch/" (fromRope dataset))
+            setContentType "application/json"
+            setHeader "X-Honeycomb-Team" (fromRope (apikey))
+
+    sendRequest c q (simpleBody (fromBytes (encodeToUTF8 json)))
+    receiveResponse c handler
+  where
+    {-
+    Response to Batch API looks like:
+
+    [{"status":202}]
+
+    -}
+    handler :: Response -> InputStream ByteString -> IO ()
+    handler p i = do
+        let code = getStatusCode p
+        case code of
+            200 -> do
+                body <- simpleHandler p i
+                let responses = decodeFromUTF8 (intoBytes body)
+                case responses of
+                    Just (JsonArray pairs) -> mapM_ f pairs
+                      where
+                        f pair = case pair of
+                            JsonObject kvs -> case lookupKeyValue "status" kvs of
+                                Just (JsonNumber 202) -> pure ()
+                                _ -> do
+                                    putStrLn "No status returned;"
+                                    C.putStrLn body
+                            _ -> putStrLn "internal: wtf?"
+                    _ -> do
+                        putStrLn "internal: Unexpected response from Honeycomb"
+                        C.putStrLn body
+            _ -> do
+                putStrLn "internal: Failed to post to Honeycomb"
+                debugHandler p i
diff --git a/lib/Core/Telemetry/Observability.hs b/lib/Core/Telemetry/Observability.hs
new file mode 100644
--- /dev/null
+++ b/lib/Core/Telemetry/Observability.hs
@@ -0,0 +1,580 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+
+{- |
+To use this capability, first you need to initialize the telemetry subsystem
+with an appropriate exporter.
+
+@
+import "Core.Program"
+import "Core.Telemetry"
+
+main :: 'IO' ()
+main = do
+    context <- 'Core.Program.Execute.configure' \"1.0\" 'Core.Program.Execute.None' ('simpleConfig' [])
+    context' <- 'initializeTelemetry' ['Core.Telemetry.Console.consoleExporter', 'Core.Telemetry.Console.structuredExporter', 'Core.Telemetry.Console.honeycombExporter'] context
+    'Core.Program.Execute.executeWith' context' program
+@
+
+/Traces and Spans/
+
+For spans to be connected together by an observability tool they need to be
+part of a /trace/.
+
+At the top of your program or request loop you need to start a new trace (with
+'beginTrace') or continue one inherited from another service (with
+'usingTrace'):
+
+@
+program :: 'Core.Program.Execute.Program' 'Core.Program.Execute.None' ()
+program = do
+    'beginTrace' $ do
+        'encloseSpan' \"Service Request\" $ do
+
+            -- do stuff!
+            
+            ...
+
+            -- add appropriate telemetry values to the span 
+            'telemetry'
+                [ 'metric' \"colour\" currentSkyObservation
+                , 'metric' \"temperature" currentAirTemperature
+                ]
+@
+
+will result in @colour=\"Blue\"@ and @temperature=26.1@ or whatever being sent
+by the telemetry system to the observability service that's been activated.
+
+The real magic here is that spans /nest/. As you go into each subcomponent on
+your request path you can again call 'encloseSpan' creating a new span. Any
+metrics added before entering the new span will be inherited by the subspan
+and sent when it finishes so you don't have to keep re-attaching data if it's
+common across all the spans in your trace.
+
+/Events/
+
+In other circumstances you will just want to send metrics:
+
+@
+            -- not again!
+            'sendEvent' \"Cat meowed\"
+                [ 'metric' \"room\" (\"living room\" :: 'Rope')
+                , 'metric' "volume\" (127.44 :: 'Float') -- decibels
+                , 'metric' \"apparently_hungry\" 'True'
+                ]
+@
+
+will result in @room=\"living room\"@, @volume=127.44@, and
+@apparently_hungry=true@ being sent as you'd expect. Ordinarily when you call
+'metric' you are passing in a variable that already has a type, but when
+hardcoding literals like in this example (less common but not unheard of)
+you'll need to add a type annotation.
+
+You /do not/ have to call 'sendEvent' from within a span, but if you do
+appropriate metadata will be added to help the observability system link the
+event to the context of the span it occured during.
+
+Either way, explicitly sending an event, or upon exiting a span, the telemetry
+will be gathered up and sent via the chosen exporter and forwarded to the
+observability or monitoring service you have chosen.
+-}
+module Core.Telemetry.Observability (
+    -- * Initializing
+    Exporter,
+    initializeTelemetry,
+
+    -- * Traces
+    Trace (..),
+    Span (..),
+    beginTrace,
+    usingTrace,
+    setServiceName,
+
+    -- * Spans
+    Label,
+    encloseSpan,
+    setStartTime,
+
+    -- * Creating telemetry
+    MetricValue,
+    Telemetry (metric),
+    telemetry,
+
+    -- * Events
+    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)
+
+{- |
+A telemetry value that can be sent over the wire. This is a wrapper around
+JSON values of type string, number, or boolean. You create these using the
+'metric' method provided by a 'Telemetry' instance and passing them to the
+'telemetry' function in a span or 'sendEvent' if noting an event.
+-}
+
+-- a bit specific to Honeycomb's very limited data model, but what else is
+-- there?
+data MetricValue
+    = MetricValue JsonKey JsonValue
+    deriving (Show)
+
+{- |
+Record the name of the service that this span and its children are a part of.
+A reasonable default is the name of the binary that's running, but frequently
+you'll want to put something a bit more nuanced or specific to your
+application. This is the overall name of the independent service, component,
+or program complimenting the @label@ set when calling 'encloseSpan', which by
+contrast descibes the name of the current phase, step, or even function name
+within the overall scope of the \"service\".
+
+This will end up as the @service_name@ parameter when exported.
+-}
+
+-- This field name appears to be very Honeycomb specific, but looking around
+-- Open Telemmtry it was just a property floating around and regardless of
+-- what it gets called it needs to get sent.
+setServiceName :: Rope -> Program τ ()
+setServiceName service = do
+    context <- getContext
+    let v = currentDatumFrom context
+    liftIO $ do
+        modifyMVar_
+            v
+            ( \datum -> do
+                let datum' =
+                        datum
+                            { serviceNameFrom = Just service
+                            }
+                pure datum'
+            )
+
+class Telemetry σ where
+    metric :: Rope -> σ -> MetricValue
+
+instance Telemetry Int where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromIntegral v))
+
+instance Telemetry Int32 where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromIntegral v))
+
+instance Telemetry Int64 where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromIntegral v))
+
+instance Telemetry Integer where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromInteger v))
+
+-- HELP is this the efficient way to get to a Scientific?
+instance Telemetry Float where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromRational (toRational v)))
+
+-- HELP is this the efficient way to get to a Scientific?
+instance Telemetry Double where
+    metric k v = MetricValue (JsonKey k) (JsonNumber (fromRational (toRational v)))
+
+instance Telemetry Scientific where
+    metric k v = MetricValue (JsonKey k) (JsonNumber v)
+
+instance Telemetry Rope where
+    metric k v = MetricValue (JsonKey k) (JsonString v)
+
+instance Telemetry String where
+    metric k v = MetricValue (JsonKey k) (JsonString (intoRope v))
+
+{- |
+The usual warning about assuming the @ByteString@ is ASCII or UTF-8 applies
+here. Don't use this to send binary mush.
+-}
+instance Telemetry B.ByteString where
+    metric k v = MetricValue (JsonKey k) (JsonString (intoRope v))
+
+{- |
+The usual warning about assuming the @ByteString@ is ASCII or UTF-8 applies
+here. Don't use this to send binary mush.
+-}
+instance Telemetry L.ByteString where
+    metric k v = MetricValue (JsonKey k) (JsonString (intoRope v))
+
+instance Telemetry T.Text where
+    metric k v = MetricValue (JsonKey k) (JsonString (intoRope v))
+
+instance Telemetry U.Text where
+    metric k v = MetricValue (JsonKey k) (JsonString (intoRope v))
+
+instance Telemetry Bool where
+    metric k v = MetricValue (JsonKey k) (JsonBool v)
+
+instance Telemetry JsonValue where
+    metric k v = MetricValue (JsonKey k) v
+
+{- |
+Activate the telemetry subsystem for use within the
+'Core.Program.Execute.Program' monad.
+
+Each exporter specified here will add setup and configuration to the context,
+including command-line options and environment variables needed as
+approrpiate:
+
+@
+    context' <- 'initializeTelemetry' ['Core.Telemetry.Console.consoleExporter'] context
+@
+
+This will allow you to then select the appropriate backend at runtime:
+
+@
+$ burger-service --telemetry=console
+@
+
+which will result in it spitting out metrics as it goes,
+
+@
+  calories = 667.0
+  flavour = true
+  meal_name = "hamburger"
+  precise = 45.0
+@
+
+and so on.
+-}
+initializeTelemetry :: [Exporter] -> Context τ -> IO (Context τ)
+initializeTelemetry exporters1 context =
+    let exporters0 = initialExportersFrom context
+        exporters2 = exporters0 ++ exporters1
+
+        codenames =
+            fmap (\name -> singletonRope '"' <> name <> singletonRope '"')
+                . fmap codenameFrom
+                $ exporters2
+
+        config0 = initialConfigFrom context
+        config1 =
+            appendOption
+                ( Option
+                    "telemetry"
+                    Nothing
+                    (Value "EXPORTER")
+                    ( [quote|
+                    Turn on telemetry. Tracing data and metrics from events
+                    will be forwarded via the specified exporter. Valid values
+                    are
+                      |]
+                        <> oxford codenames
+                    )
+                )
+                config0
+
+        config2 = List.foldl' f config1 exporters2
+     in pure
+            ( context
+                { initialConfigFrom = config2
+                , initialExportersFrom = exporters2
+                }
+            )
+  where
+    -- This doesn't actually setup the telemetry processor; that's done in
+    -- executeAction. Here we're setting up each  of the exporters so they
+    -- show up in --help. When we process command-line arguments we'll find
+    -- out which exporter was activated, if any.
+    f :: Config -> Exporter -> Config
+    f config exporter =
+        let setup = setupConfigFrom exporter
+         in setup config
+
+type Label = Rope
+
+{- |
+Begin a span.
+
+You need to call this from within the context of a trace, which is established
+either by calling `beginTrace` or `usingTrace` somewhere above this point in
+the program.
+
+You can nest spans as you make your way through your program, which means each
+span has a parent (except for the first one, which is the root span) In the
+context of a trace, allows an observability tool to reconstruct the sequence
+of events and to display them as a nested tree correspoding to your program
+flow.
+
+The current time will be noted when entering the 'Program' this span encloses,
+and its duration recorded when the sub @Program@ exits. Start time, duration,
+the unique identifier of the span (generated for you), the identifier of the
+parent, and the unique identifier of the overall trace will be appended as
+metadata points and then sent to the telemetry channel.
+-}
+encloseSpan :: Label -> Program z a -> Program z a
+encloseSpan label action = do
+    context <- getContext
+
+    unique <- liftIO randomIdentifier
+    debug "span" unique
+
+    liftIO $ do
+        -- prepare new span
+        start <- getCurrentTimeNanoseconds
+
+        -- slightly tricky: create a new Context with a new MVar with an
+        -- forked copy of the current Datum, creating the nested span.
+        let v = currentDatumFrom context
+        datum <- readMVar v
+
+        let datum' =
+                datum
+                    { spanIdentifierFrom = Just (Span unique)
+                    , spanNameFrom = label
+                    , spanTimeFrom = start
+                    , parentIdentifierFrom = spanIdentifierFrom datum
+                    }
+
+        v2 <- newMVar datum'
+
+        let context2 =
+                context
+                    { currentDatumFrom = v2
+                    }
+
+        -- execute nested program
+
+        result <- subProgram context2 action
+
+        -- extract the Datum as it stands after running the action, finalize
+        -- with its duration, and send it
+        finish <- getCurrentTimeNanoseconds
+        datum2 <- readMVar v2
+        let datum2' =
+                datum2
+                    { durationFrom = Just (unTimeStamp finish - unTimeStamp start)
+                    }
+
+        let tel = telemetryChannelFrom context
+
+        atomically $ do
+            writeTQueue tel (Just datum2')
+
+        -- 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 = '@'
+
+-- 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
+    pure result
+
+{- |
+Start a new trace. A random identifier will be generated.
+
+You /must/ have a single \"root span\" immediately below starting a new trace.
+
+@
+program :: 'Core.Program.Execute.Program' 'Core.Program.Execute.None' ()
+program = do
+    'beginTrace' $ do
+        'encloseSpan' \"Service Request\" $ do
+            ...
+@
+-}
+beginTrace :: Program τ α -> Program τ α
+beginTrace action = do
+    trace <- liftIO randomIdentifier
+    usingTrace (Trace trace) Nothing action
+
+{- |
+Begin a new trace, but using a trace identifier provided externally. This is
+the most common case. Internal services that are play a part of a larger
+request will inherit a job identifier, sequence number, or other externally
+supplied unique code. Even an internet facing web service might have a
+correlation ID provided by the outside load balancers.
+
+If you are continuting an existing trace within the execution path of another,
+larger, enclosing service then you need to specify what the parent span's
+identifier is in the second argument.
+
+@
+program :: 'Core.Program.Execute.Program' 'Core.Program.Execute.None' ()
+program = do
+    
+    -- do something that gets the trace ID
+    trace <- ...
+
+    -- and somethign to get the parent span ID
+    parent <- ...
+
+    'usingTrace' ('Trace' trace) ('Just' ('Span' span)) $ do
+        'encloseSpan' \"Internal processing\" $ do
+            ...
+@
+-}
+usingTrace :: Trace -> Maybe Span -> Program τ α -> Program τ α
+usingTrace trace possibleParent action = do
+    context <- getContext
+
+    case possibleParent of
+        Nothing -> do
+            debug "trace" (unTrace trace)
+        Just parent -> do
+            debug "trace" (unTrace trace)
+            debug "parent" (unSpan parent)
+
+    liftIO $ do
+        -- prepare new span
+        let v = currentDatumFrom context
+        datum <- readMVar v
+
+        let datum2 =
+                datum
+                    { traceIdentifierFrom = Just trace
+                    , parentIdentifierFrom = possibleParent
+                    }
+
+        -- fork the Context
+        v2 <- newMVar datum2
+
+        let context2 =
+                context
+                    { currentDatumFrom = v2
+                    }
+
+        -- execute nested program
+        subProgram context2 action
+
+{- |
+Add measurements to the current span.
+
+@
+            telemetry
+                [ metric "calories" (667 :: Int)
+                , metric "precise" measurement
+                , metric "meal_name" ("hamburger" :: Rope)
+                , metric "flavour" True
+                ]
+@
+
+The 'metric' function is a method provided by instances of the 'Telemtetry'
+typeclass which is mostly a wrapper around constructing key/value pairs
+suitable to be sent as measurements up to an observability service.
+-}
+telemetry :: [MetricValue] -> Program τ ()
+telemetry values = do
+    context <- getContext
+
+    liftIO $ do
+        -- get the map out
+        let v = currentDatumFrom context
+        modifyMVar_
+            v
+            ( \datum -> do
+                let meta = attachedMetadataFrom datum
+
+                -- update the map
+                let meta' = List.foldl' f meta values
+
+                -- replace the map back into the Datum (and thereby back into the
+                -- Context), updating it
+                let datum' =
+                        datum
+                            { attachedMetadataFrom = meta'
+                            }
+                pure datum'
+            )
+  where
+    f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
+    f acc (MetricValue k v) = insertKeyValue k v acc
+
+{- |
+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 accomplush this.
+
+If you 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 deisplay it attached to the span in
+the in which it occured.
+
+Not every situation is in the context of traces and spans and so you can use
+this to send arbitrary telemetry.
+-}
+sendEvent :: Label -> [MetricValue] -> Program τ ()
+sendEvent label values = do
+    context <- getContext
+
+    liftIO $ do
+        now <- getCurrentTimeNanoseconds
+        -- get the map out
+        let v = currentDatumFrom context
+        datum <- readMVar v
+
+        let meta = attachedMetadataFrom datum
+
+        -- update the map
+        let meta' = List.foldl' f meta values
+        -- replace the map back into the Datum and queue for sending
+        let datum' =
+                datum
+                    { spanNameFrom = label
+                    , spanIdentifierFrom = Nothing
+                    , parentIdentifierFrom = spanIdentifierFrom datum
+                    , spanTimeFrom = now
+                    , attachedMetadataFrom = meta'
+                    }
+
+        let tel = telemetryChannelFrom context
+        atomically $ do
+            writeTQueue tel (Just datum')
+  where
+    f :: Map JsonKey JsonValue -> MetricValue -> Map JsonKey JsonValue
+    f acc (MetricValue k v) = insertKeyValue k v acc
+
+-- get current time after digging out datum and override spanTimeFrom before
+-- sending Datum
+
+{- |
+Override the start time of the current span.
+
+Under normal circumstances this shouldn't be necessary. The start and end of a
+span are recorded automatically when calling 'encloseSpan'. Observabilty tools
+are designed to be used live; traces and spans should be created in real time
+in your code.
+-}
+setStartTime :: TimeStamp -> Program τ ()
+setStartTime time = do
+    context <- getContext
+
+    liftIO $ do
+        -- get the map out
+        let v = currentDatumFrom context
+        modifyMVar_
+            v
+            (\datum -> pure datum{spanTimeFrom = time})
