{-# LANGUAGE OverloadedStrings #-}
module Debug.TraceEmbrace.Config.Type.EnvVar where

import Data.Aeson hiding (Error)
import Data.Char
import Data.Generics.Labels ()
import Data.Text qualified as T
import Data.Typeable
import GHC.Generics
import Refined

packageBasedEnvVarPrefix :: String
packageBasedEnvVarPrefix :: String
packageBasedEnvVarPrefix = String
"TRACE_EMBRACE_"

-- | Name of environment variable name.
data EnvironmentVariable
  = Ignored
  -- | Use upcased package name non alphanum chars are replaced with @_@,
  -- plus @TRACE_EMBRACE_@ prefix
  | CapsPackageName -- ^
  | EnvironmentVariable { EnvironmentVariable -> String
varName :: String }
  deriving (EnvironmentVariable -> EnvironmentVariable -> Bool
(EnvironmentVariable -> EnvironmentVariable -> Bool)
-> (EnvironmentVariable -> EnvironmentVariable -> Bool)
-> Eq EnvironmentVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvironmentVariable -> EnvironmentVariable -> Bool
== :: EnvironmentVariable -> EnvironmentVariable -> Bool
$c/= :: EnvironmentVariable -> EnvironmentVariable -> Bool
/= :: EnvironmentVariable -> EnvironmentVariable -> Bool
Eq, Int -> EnvironmentVariable -> ShowS
[EnvironmentVariable] -> ShowS
EnvironmentVariable -> String
(Int -> EnvironmentVariable -> ShowS)
-> (EnvironmentVariable -> String)
-> ([EnvironmentVariable] -> ShowS)
-> Show EnvironmentVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvironmentVariable -> ShowS
showsPrec :: Int -> EnvironmentVariable -> ShowS
$cshow :: EnvironmentVariable -> String
show :: EnvironmentVariable -> String
$cshowList :: [EnvironmentVariable] -> ShowS
showList :: [EnvironmentVariable] -> ShowS
Show, Eq EnvironmentVariable
Eq EnvironmentVariable =>
(EnvironmentVariable -> EnvironmentVariable -> Ordering)
-> (EnvironmentVariable -> EnvironmentVariable -> Bool)
-> (EnvironmentVariable -> EnvironmentVariable -> Bool)
-> (EnvironmentVariable -> EnvironmentVariable -> Bool)
-> (EnvironmentVariable -> EnvironmentVariable -> Bool)
-> (EnvironmentVariable
    -> EnvironmentVariable -> EnvironmentVariable)
-> (EnvironmentVariable
    -> EnvironmentVariable -> EnvironmentVariable)
-> Ord EnvironmentVariable
EnvironmentVariable -> EnvironmentVariable -> Bool
EnvironmentVariable -> EnvironmentVariable -> Ordering
EnvironmentVariable -> EnvironmentVariable -> EnvironmentVariable
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 :: EnvironmentVariable -> EnvironmentVariable -> Ordering
compare :: EnvironmentVariable -> EnvironmentVariable -> Ordering
$c< :: EnvironmentVariable -> EnvironmentVariable -> Bool
< :: EnvironmentVariable -> EnvironmentVariable -> Bool
$c<= :: EnvironmentVariable -> EnvironmentVariable -> Bool
<= :: EnvironmentVariable -> EnvironmentVariable -> Bool
$c> :: EnvironmentVariable -> EnvironmentVariable -> Bool
> :: EnvironmentVariable -> EnvironmentVariable -> Bool
$c>= :: EnvironmentVariable -> EnvironmentVariable -> Bool
>= :: EnvironmentVariable -> EnvironmentVariable -> Bool
$cmax :: EnvironmentVariable -> EnvironmentVariable -> EnvironmentVariable
max :: EnvironmentVariable -> EnvironmentVariable -> EnvironmentVariable
$cmin :: EnvironmentVariable -> EnvironmentVariable -> EnvironmentVariable
min :: EnvironmentVariable -> EnvironmentVariable -> EnvironmentVariable
Ord, (forall x. EnvironmentVariable -> Rep EnvironmentVariable x)
-> (forall x. Rep EnvironmentVariable x -> EnvironmentVariable)
-> Generic EnvironmentVariable
forall x. Rep EnvironmentVariable x -> EnvironmentVariable
forall x. EnvironmentVariable -> Rep EnvironmentVariable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvironmentVariable -> Rep EnvironmentVariable x
from :: forall x. EnvironmentVariable -> Rep EnvironmentVariable x
$cto :: forall x. Rep EnvironmentVariable x -> EnvironmentVariable
to :: forall x. Rep EnvironmentVariable x -> EnvironmentVariable
Generic)

instance ToJSON EnvironmentVariable where
  toEncoding :: EnvironmentVariable -> Encoding
toEncoding = Options -> EnvironmentVariable -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
instance FromJSON EnvironmentVariable


data EnvironmentVariableP

instance Predicate EnvironmentVariableP EnvironmentVariable where
  validate :: Proxy EnvironmentVariableP
-> EnvironmentVariable -> Maybe RefineException
validate Proxy EnvironmentVariableP
p = \case
    EnvironmentVariable
Ignored -> Maybe RefineException
forall a. Maybe a
Nothing
    EnvironmentVariable
CapsPackageName -> Maybe RefineException
forall a. Maybe a
Nothing
    EnvironmentVariable String
n ->
      case String
n of
        [] -> TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (Proxy EnvironmentVariableP -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy EnvironmentVariableP
p) Text
"Environment variable name cannot be empty"
        (Char
h:String
t)
          | Char -> Bool
isUpper Char
h Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c) String
t -> Maybe RefineException
forall a. Maybe a
Nothing
          | Bool
otherwise ->
            TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (Proxy EnvironmentVariableP -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy EnvironmentVariableP
p)
              (Text
"Bad environment variable name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ShowS
forall a. Show a => a -> String
show String
n))