content: {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module System.Metrics.Prometheus.MetricId where
  
  import Data.Bifunctor (first)
  import Data.Char (isDigit)
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Monoid (Monoid)
  import Data.Semigroup (Semigroup)
  import Data.String (IsString (..))
  import Data.Text (Text)
  import qualified Data.Text as Text
  import Prelude hiding (null)
  
  
  -- | Construct with 'makeName' to ensure that names use only valid characters
  newtype Name = Name {unName :: Text} deriving (Show, Eq, Ord, Monoid, Semigroup)
  
  
  instance IsString Name where
      fromString = makeName . Text.pack
  
  
  newtype Labels = Labels {unLabels :: Map Text Text} deriving (Show, Eq, Ord, Monoid, Semigroup)
  
  
  data MetricId = MetricId
      { name :: Name
      , labels :: Labels
      }
      deriving (Eq, Ord, Show)
  
  
  addLabel :: Text -> Text -> Labels -> Labels
  addLabel key val = Labels . Map.insert (makeValid key) val . unLabels
  
  
  fromList :: [(Text, Text)] -> Labels
  fromList = Labels . Map.fromList . map (first makeValid)
  
  
  toList :: Labels -> [(Text, Text)]
  toList = Map.toList . unLabels
  
  
  null :: Labels -> Bool
  null = Map.null . unLabels
  
  
  -- | Make the input match the regex @[a-zA-Z_][a-zA-Z0-9_]@ which
  -- defines valid metric and label names, according to
  -- <https://prometheus.io/docs/concepts/data_model/#metric-names-and-labels>
  -- Replace invalid characters with @_@ and add a leading @_@ if the
  -- first character is only valid as a later character.
  makeValid :: Text -> Text
  makeValid "" = "_"
  makeValid txt = prefix_ <> Text.map (\c -> if allowedChar c then c else '_') txt
    where
      prefix_ = if isDigit (Text.head txt) then "_" else ""
      allowedChar :: Char -> Bool
      allowedChar c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || isDigit c || c == '_'
  
  
  -- | Construct a 'Name', replacing disallowed characters.
  makeName :: Text -> Name
  makeName = Name . makeValid
  