module Composite.Ekg (EkgMetric(ekgMetric)) where

import Composite.Record ((:->)(Val), Rec((:&), RNil), Record)
import Data.Char (isUpper, toLower)
import Data.Functor.Identity (Identity(Identity))
import qualified Data.Text as Text
import Data.Proxy (Proxy(Proxy))
import Data.Text (Text, pack)
import GHC.TypeLits (KnownSymbol, symbolVal)
import System.Metrics (Store, createCounter, createGauge, createLabel, createDistribution)
import System.Metrics.Counter (Counter)
import System.Metrics.Gauge (Gauge)
import System.Metrics.Label (Label)
import System.Metrics.Distribution (Distribution)

-- |Type class for constructing a configured EKG metric store for record type of named fields
--
-- For example, given:
--
-- > type FActiveUsers    = "activeUsers"           :-> Gauge
-- > type FResponseTimes  = "endpointResponseTimes" :-> Distribution
-- > type FOrdersPlaced   = "ordersPlaced"          :-> Counter
-- > type EkgMetrics = '[FActiveUsers, FResponseTimes, FRevenue]
--
-- And then used in:
--
-- > configureMetrics :: IO (Rec EkgMetrics)
-- > configureMetrics = do
-- >   store <- newStore
-- >   metrics <- ekgMetric "myapp" store
-- >   _ <- forkServerWith store "localhost" 8080
-- >   pure metrics
--
-- Compare to a more traditional:
--
-- > metrics <- EkgMetrics
-- >  <$> createGauge "myapp.active_users store
-- >  <*> createDistribution "myapp.endpoint_response_times" store
-- >  <*> createCounter "myapp.orders_placed" store
--
-- The former is more concise and harder to make naming errors particularly in larger store sets
class EkgMetric a where
  ekgMetric :: Text -> Store -> IO a

instance forall a s rs. (EkgMetric a, EkgMetric (Record rs), KnownSymbol s) => EkgMetric (Record ((s :-> a) ': rs)) where
  ekgMetric :: Text -> Store -> IO (Record ((s :-> a) : rs))
ekgMetric Text
prefix Store
store =
    forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Symbol) a. a -> s :-> a
Val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. EkgMetric a => Text -> Store -> IO a
ekgMetric (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> (Text -> Text
upperScores forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal) (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)) Store
store)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. EkgMetric a => Text -> Store -> IO a
ekgMetric Text
prefix Store
store

instance EkgMetric (Record '[]) where
  ekgMetric :: Text -> Store -> IO (Record '[])
ekgMetric Text
_ Store
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {u} (a :: u -> *). Rec a '[]
RNil

instance EkgMetric Counter where
  ekgMetric :: Text -> Store -> IO Counter
ekgMetric = Text -> Store -> IO Counter
createCounter

instance EkgMetric Gauge where
  ekgMetric :: Text -> Store -> IO Gauge
ekgMetric = Text -> Store -> IO Gauge
createGauge

instance EkgMetric Label where
  ekgMetric :: Text -> Store -> IO Label
ekgMetric = Text -> Store -> IO Label
createLabel

instance EkgMetric Distribution where
  ekgMetric :: Text -> Store -> IO Distribution
ekgMetric = Text -> Store -> IO Distribution
createDistribution

upperScores :: Text -> Text
upperScores :: Text -> Text
upperScores = (Char -> Bool) -> Text -> Text
Text.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'_') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
score
  where score :: Char -> Text
        score :: Char -> Text
score Char
c | Char -> Bool
isUpper Char
c = Text
"_" forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton (Char -> Char
toLower Char
c)
        score Char
c = Char -> Text
Text.singleton Char
c