{-# LANGUAGE TemplateHaskell #-}

-- | Effect for handling metrics
module Calamity.Metrics.Eff (
  Counter,
  Gauge,
  Histogram,
  HistogramSample (..),
  MetricEff (..),
  registerCounter,
  registerGauge,
  registerHistogram,
  addCounter,
  modifyGauge,
  observeHistogram,
) where

import Calamity.Metrics.Internal
import Data.Default.Class
import Data.Map qualified as Map
import Data.Text
import Optics.TH
import Polysemy
import TextShow

data HistogramSample = HistogramSample
  { HistogramSample -> Map Double Double
buckets :: Map.Map Double Double
  , HistogramSample -> Double
sum :: Double
  , HistogramSample -> Int
count :: Int
  }
  deriving (HistogramSample -> HistogramSample -> Bool
(HistogramSample -> HistogramSample -> Bool)
-> (HistogramSample -> HistogramSample -> Bool)
-> Eq HistogramSample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HistogramSample -> HistogramSample -> Bool
== :: HistogramSample -> HistogramSample -> Bool
$c/= :: HistogramSample -> HistogramSample -> Bool
/= :: HistogramSample -> HistogramSample -> Bool
Eq, Int -> HistogramSample -> ShowS
[HistogramSample] -> ShowS
HistogramSample -> String
(Int -> HistogramSample -> ShowS)
-> (HistogramSample -> String)
-> ([HistogramSample] -> ShowS)
-> Show HistogramSample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HistogramSample -> ShowS
showsPrec :: Int -> HistogramSample -> ShowS
$cshow :: HistogramSample -> String
show :: HistogramSample -> String
$cshowList :: [HistogramSample] -> ShowS
showList :: [HistogramSample] -> ShowS
Show)
  deriving
    (Int -> HistogramSample -> Text
Int -> HistogramSample -> Builder
Int -> HistogramSample -> Text
[HistogramSample] -> Text
[HistogramSample] -> Builder
[HistogramSample] -> Text
HistogramSample -> Text
HistogramSample -> Builder
HistogramSample -> Text
(Int -> HistogramSample -> Builder)
-> (HistogramSample -> Builder)
-> ([HistogramSample] -> Builder)
-> (Int -> HistogramSample -> Text)
-> (HistogramSample -> Text)
-> ([HistogramSample] -> Text)
-> (Int -> HistogramSample -> Text)
-> (HistogramSample -> Text)
-> ([HistogramSample] -> Text)
-> TextShow HistogramSample
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: Int -> HistogramSample -> Builder
showbPrec :: Int -> HistogramSample -> Builder
$cshowb :: HistogramSample -> Builder
showb :: HistogramSample -> Builder
$cshowbList :: [HistogramSample] -> Builder
showbList :: [HistogramSample] -> Builder
$cshowtPrec :: Int -> HistogramSample -> Text
showtPrec :: Int -> HistogramSample -> Text
$cshowt :: HistogramSample -> Text
showt :: HistogramSample -> Text
$cshowtList :: [HistogramSample] -> Text
showtList :: [HistogramSample] -> Text
$cshowtlPrec :: Int -> HistogramSample -> Text
showtlPrec :: Int -> HistogramSample -> Text
$cshowtl :: HistogramSample -> Text
showtl :: HistogramSample -> Text
$cshowtlList :: [HistogramSample] -> Text
showtlList :: [HistogramSample] -> Text
TextShow)
    via FromStringShow HistogramSample

instance Default HistogramSample where
  def :: HistogramSample
def = Map Double Double -> Double -> Int -> HistogramSample
HistogramSample Map Double Double
forall k a. Map k a
Map.empty Double
0.0 Int
0

data MetricEff m a where
  -- | Register a 'Counter'
  RegisterCounter ::
    -- | Name
    Text ->
    -- | Labels
    [(Text, Text)] ->
    MetricEff m Counter
  -- | Register a 'Gauge'
  RegisterGauge ::
    -- | Name
    Text ->
    -- | Labels
    [(Text, Text)] ->
    MetricEff m Gauge
  -- | Register a 'Histogram'
  RegisterHistogram ::
    -- | Name
    Text ->
    -- | Labels
    [(Text, Text)] ->
    -- | Upper bounds
    [Double] ->
    MetricEff m Histogram
  AddCounter :: Int -> Counter -> MetricEff m Int
  ModifyGauge :: (Double -> Double) -> Gauge -> MetricEff m Double
  ObserveHistogram :: Double -> Histogram -> MetricEff m HistogramSample

makeSem ''MetricEff

$(makeFieldLabelsNoPrefix ''HistogramSample)