{-# 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 {Name -> Text
unName :: Text} deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Semigroup Name
Name
[Name] -> Name
Name -> Name -> Name
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Name] -> Name
$cmconcat :: [Name] -> Name
mappend :: Name -> Name -> Name
$cmappend :: Name -> Name -> Name
mempty :: Name
$cmempty :: Name
Monoid, NonEmpty Name -> Name
Name -> Name -> Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
sconcat :: NonEmpty Name -> Name
$csconcat :: NonEmpty Name -> Name
<> :: Name -> Name -> Name
$c<> :: Name -> Name -> Name
Semigroup)


instance IsString Name where
    fromString :: String -> Name
fromString = Text -> Name
makeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack


newtype Labels = Labels {Labels -> Map Text Text
unLabels :: Map Text Text} deriving (Int -> Labels -> ShowS
[Labels] -> ShowS
Labels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Labels] -> ShowS
$cshowList :: [Labels] -> ShowS
show :: Labels -> String
$cshow :: Labels -> String
showsPrec :: Int -> Labels -> ShowS
$cshowsPrec :: Int -> Labels -> ShowS
Show, Labels -> Labels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Labels -> Labels -> Bool
$c/= :: Labels -> Labels -> Bool
== :: Labels -> Labels -> Bool
$c== :: Labels -> Labels -> Bool
Eq, Eq Labels
Labels -> Labels -> Bool
Labels -> Labels -> Ordering
Labels -> Labels -> Labels
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Labels -> Labels -> Labels
$cmin :: Labels -> Labels -> Labels
max :: Labels -> Labels -> Labels
$cmax :: Labels -> Labels -> Labels
>= :: Labels -> Labels -> Bool
$c>= :: Labels -> Labels -> Bool
> :: Labels -> Labels -> Bool
$c> :: Labels -> Labels -> Bool
<= :: Labels -> Labels -> Bool
$c<= :: Labels -> Labels -> Bool
< :: Labels -> Labels -> Bool
$c< :: Labels -> Labels -> Bool
compare :: Labels -> Labels -> Ordering
$ccompare :: Labels -> Labels -> Ordering
Ord, Semigroup Labels
Labels
[Labels] -> Labels
Labels -> Labels -> Labels
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Labels] -> Labels
$cmconcat :: [Labels] -> Labels
mappend :: Labels -> Labels -> Labels
$cmappend :: Labels -> Labels -> Labels
mempty :: Labels
$cmempty :: Labels
Monoid, NonEmpty Labels -> Labels
Labels -> Labels -> Labels
forall b. Integral b => b -> Labels -> Labels
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Labels -> Labels
$cstimes :: forall b. Integral b => b -> Labels -> Labels
sconcat :: NonEmpty Labels -> Labels
$csconcat :: NonEmpty Labels -> Labels
<> :: Labels -> Labels -> Labels
$c<> :: Labels -> Labels -> Labels
Semigroup)


data MetricId = MetricId
    { MetricId -> Name
name :: Name
    , MetricId -> Labels
labels :: Labels
    }
    deriving (MetricId -> MetricId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricId -> MetricId -> Bool
$c/= :: MetricId -> MetricId -> Bool
== :: MetricId -> MetricId -> Bool
$c== :: MetricId -> MetricId -> Bool
Eq, Eq MetricId
MetricId -> MetricId -> Bool
MetricId -> MetricId -> Ordering
MetricId -> MetricId -> MetricId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetricId -> MetricId -> MetricId
$cmin :: MetricId -> MetricId -> MetricId
max :: MetricId -> MetricId -> MetricId
$cmax :: MetricId -> MetricId -> MetricId
>= :: MetricId -> MetricId -> Bool
$c>= :: MetricId -> MetricId -> Bool
> :: MetricId -> MetricId -> Bool
$c> :: MetricId -> MetricId -> Bool
<= :: MetricId -> MetricId -> Bool
$c<= :: MetricId -> MetricId -> Bool
< :: MetricId -> MetricId -> Bool
$c< :: MetricId -> MetricId -> Bool
compare :: MetricId -> MetricId -> Ordering
$ccompare :: MetricId -> MetricId -> Ordering
Ord, Int -> MetricId -> ShowS
[MetricId] -> ShowS
MetricId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricId] -> ShowS
$cshowList :: [MetricId] -> ShowS
show :: MetricId -> String
$cshow :: MetricId -> String
showsPrec :: Int -> MetricId -> ShowS
$cshowsPrec :: Int -> MetricId -> ShowS
Show)


addLabel :: Text -> Text -> Labels -> Labels
addLabel :: Text -> Text -> Labels -> Labels
addLabel Text
key Text
val = Map Text Text -> Labels
Labels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Text -> Text
makeValid Text
key) Text
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labels -> Map Text Text
unLabels


fromList :: [(Text, Text)] -> Labels
fromList :: [(Text, Text)] -> Labels
fromList = Map Text Text -> Labels
Labels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
makeValid)


toList :: Labels -> [(Text, Text)]
toList :: Labels -> [(Text, Text)]
toList = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labels -> Map Text Text
unLabels


null :: Labels -> Bool
null :: Labels -> Bool
null = forall k a. Map k a -> Bool
Map.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labels -> Map Text Text
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 :: Text -> Text
makeValid Text
"" = Text
"_"
makeValid Text
txt = Text
prefix_ forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> Text -> Text
Text.map (\Char
c -> if Char -> Bool
allowedChar Char
c then Char
c else Char
'_') Text
txt
  where
    prefix_ :: Text
prefix_ = if Char -> Bool
isDigit (Text -> Char
Text.head Text
txt) then Text
"_" else Text
""
    allowedChar :: Char -> Bool
    allowedChar :: Char -> Bool
allowedChar Char
c = (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'


-- | Construct a 'Name', replacing disallowed characters.
makeName :: Text -> Name
makeName :: Text -> Name
makeName = Text -> Name
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
makeValid