Record Tree DSLs

This repository provides packages to work with DSLs based on trees of records, just like @servant@. The basic structure was inspired by @servant@ and extracted into the record-tree-dsl package.

Next to it, there is the record-tree-prometheus package for defining and observing metrics for prometheus via a servant-like interface.

Tree primitives

The primitives for defining trees are a :|| b for defining a sibling relationship (i.e. a and b exist next to each other), and a :> b for defining a hierarchical relationship (i.e. a is a parent of b).

This allows expressing trees such as A :> (B :|| (C :> D)), corresponding to

 A 
/ \
B  C
   |
   D

Since :|| just represents a product type (i.e. a tuple), we can generalize this concept to arbitrary record types. This gives rise to the Named and :- combinators. Generally, Named A can be read as interpreting a generic record type A as a series of :||. The mode :- T combinator expresses that T is interpreted using a concrete mode supplied later. This mode argument allows us to define interpretations of the record type that potentially change the type of the fields. With these combinators, we can write the above tree as the following record types:

data MyRecord mode = MyRecord {
        a :: mode :- A :> Named NestedRec
    }
    deriving (Generic)

data NestedRec mode = NestedRec {
        b :: mode :- B,
        cd :: mode :- C :> D
    }
    deriving (Generic)

Just by itself, the tree is not terribly useful yet. Just as with servant, the power comes from then defining interpretations of the abstract tree into something more concrete.

Prometheus

The record-tree-prometheus package provides some additional types for tree nodes, as well as an interpretation into prometheus-client metrics. Using those additional types, we can declaratively describe the metrics we want to have in our application:

-- | Equivalent definition of the request latency metric in @wai-middleware-prometheus@.
type RequestLatency =
  DynamicLabel "handler" T.Text
    :> DynamicLabel "method" T.Text
    :> DynamicLabel "status_code" Int
    :> Metric
         "http_request_duration_seconds"
         "The HTTP request latencies in seconds."
         (Histogram DefaultBuckets)

-- | Metrics are defined as a tree of records, with 'Metric' types in the leaves.
data MyAppMetrics mode = MyAppMetrics
  { myAppCounter :: mode :- Metric "my_counter" "Some counting" Counter,
    myAppRequests :: mode :- RequestLatency,
    -- Nested records can be included via the 'Named' wrapper.
    myAppNested ::
      mode
        -- Labels defined at a higher level automatically apply to all nested metrics, i.e. all
        -- metrics from 'MySubAppMetrics' receive these labels.
        :- StaticLabel "app" "nested"
        :> DynamicLabel "cluster" Int
        :> Named MySubAppMetrics
  }
  deriving (Generic)

data MySubAppMetrics mode = MySubAppMetrics
  { mySubAppGauge :: mode :- Metric "my_gauge" "A nested gauge" Gauge,
    mySubAppLabeledGauge ::
      mode
        :- DynamicLabel "foo" String
        :> Metric "my_labeled_gauge" "A nested gauge with even more labels" Gauge
  }
  deriving (Generic)

(See record-tree-prometheus/app/PromExample.hs for the full example.)

Here, the leaves of our tree describe the concrete metrics (via the Metric type), while the inner nodes (used with :>) describe the labels we attach to those metrics.

Registering these metrics with prometheus-client is then as simple as doing

myMetrics <- register (Proxy @(Named MyAppMetrics))

This registers the corresponding prometheus-client metric types in the global registry, and returns the handles for then providing values to the metrics in the same MyAppMetrics record, with the AsRegisterMetricsT mode. In a MyAppMetrics AsRegisterMetricsT value, all the fields simply contain the underlying metrics type, e.g. Prometheus.Counter. Labels are expressed via Prometheus.Vector with a type-safe n-ary tuple as the label type.

For a higher-level interface, it is then possible to automatically derive functions in IO that update the corresponding metrics, via:

let myObserver = mkObserver (Proxy @(Named MyAppMetrics)) myMetrics

This returns the record in the AsObserveMetricsT mode, where all fields now have a function type that takes the label values (if any) and finally the value to update the metric with. For example, we can update the nested labeled gauge by first providing the outer label value (for "cluster"), then providing the inner label value (for "foo") and finally providing the value of the metric:

  mySubAppLabeledGauge
    (myAppNested myObserver (Tagged @"cluster" 2))
    (Tagged @"foo" "bar")
    1337