{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module System.Metrics.Prometheus.MetricId where

import           Data.Char (isDigit)
import           Data.Bifunctor (first)
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
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
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
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
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
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord 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
$cp1Ord :: Eq Name
Ord, Semigroup Name
Name
Semigroup Name
-> Name
-> (Name -> Name -> Name)
-> ([Name] -> Name)
-> Monoid 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
$cp1Monoid :: Semigroup Name
Monoid, b -> Name -> Name
NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup 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 :: 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 (Text -> Name) -> (String -> Text) -> String -> Name
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
(Int -> Labels -> ShowS)
-> (Labels -> String) -> ([Labels] -> ShowS) -> Show Labels
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
(Labels -> Labels -> Bool)
-> (Labels -> Labels -> Bool) -> Eq Labels
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
Eq Labels
-> (Labels -> Labels -> Ordering)
-> (Labels -> Labels -> Bool)
-> (Labels -> Labels -> Bool)
-> (Labels -> Labels -> Bool)
-> (Labels -> Labels -> Bool)
-> (Labels -> Labels -> Labels)
-> (Labels -> Labels -> Labels)
-> Ord 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
$cp1Ord :: Eq Labels
Ord, Semigroup Labels
Labels
Semigroup Labels
-> Labels
-> (Labels -> Labels -> Labels)
-> ([Labels] -> Labels)
-> Monoid 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
$cp1Monoid :: Semigroup Labels
Monoid, b -> Labels -> Labels
NonEmpty Labels -> Labels
Labels -> Labels -> Labels
(Labels -> Labels -> Labels)
-> (NonEmpty Labels -> Labels)
-> (forall b. Integral b => b -> Labels -> Labels)
-> Semigroup 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 :: 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
(MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> Bool) -> Eq MetricId
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
Eq MetricId
-> (MetricId -> MetricId -> Ordering)
-> (MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> Bool)
-> (MetricId -> MetricId -> MetricId)
-> (MetricId -> MetricId -> MetricId)
-> Ord 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
$cp1Ord :: Eq MetricId
Ord, Int -> MetricId -> ShowS
[MetricId] -> ShowS
MetricId -> String
(Int -> MetricId -> ShowS)
-> (MetricId -> String) -> ([MetricId] -> ShowS) -> Show MetricId
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 (Map Text Text -> Labels)
-> (Labels -> Map Text Text) -> Labels -> Labels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Text -> Text
makeValid Text
key) Text
val (Map Text Text -> Map Text Text)
-> (Labels -> Map Text Text) -> Labels -> Map Text Text
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 (Map Text Text -> Labels)
-> ([(Text, Text)] -> Map Text Text) -> [(Text, Text)] -> Labels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> (Text, Text) -> (Text, Text)
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 = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Text -> [(Text, Text)])
-> (Labels -> Map Text Text) -> Labels -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Labels -> Map Text Text
unLabels


null :: Labels -> Bool
null :: Labels -> Bool
null = Map Text Text -> Bool
forall k a. Map k a -> Bool
Map.null (Map Text Text -> Bool)
-> (Labels -> Map Text Text) -> Labels -> Bool
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_ Text -> Text -> Text
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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'


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