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