-- | This module contains the 'Values' type, which stores environment variable names and values, and its typeclass instances.
module RichEnv.Types.Values (Values (Values, unValues), fromList) where

import Data.Aeson (FromJSON (parseJSON), Options (unwrapUnaryRecords), ToJSON (toJSON), Value, defaultOptions, genericParseJSON)
import Data.Aeson.Types (Parser)
import Data.HashMap.Strict qualified as HM
import Data.Text (Text)
import GHC.Generics (Generic)

-- | A list of key-value pairs representing environment variables. The internal representation is a 'HashMap Text Text', where the key is the variable name and the value is the variable value.
newtype Values = Values {Values -> HashMap Text Text
unValues :: HM.HashMap Text Text}
  deriving stock (Values -> Values -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Values -> Values -> Bool
$c/= :: Values -> Values -> Bool
== :: Values -> Values -> Bool
$c== :: Values -> Values -> Bool
Eq, Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> String
$cshow :: Values -> String
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> Values -> ShowS
Show, forall x. Rep Values x -> Values
forall x. Values -> Rep Values x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Values x -> Values
$cfrom :: forall x. Values -> Rep Values x
Generic)

instance FromJSON Values where
  parseJSON :: Value -> Parser Values
  parseJSON :: Value -> Parser Values
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ Options
defaultOptions {unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True}

instance ToJSON Values where
  toJSON :: Values -> Value
  toJSON :: Values -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues

instance Semigroup Values where
  (<>) :: Values -> Values -> Values
  <> :: Values -> Values -> Values
(<>) (Values HashMap Text Text
a) (Values HashMap Text Text
b) = HashMap Text Text -> Values
Values (HashMap Text Text
a forall a. Semigroup a => a -> a -> a
<> HashMap Text Text
b)

instance Monoid Values where
  mempty :: Values
  mempty :: Values
mempty = HashMap Text Text -> Values
Values forall a. Monoid a => a
mempty

-- | Build a 'Values' object from a list of key-value pairs.
fromList :: [(Text, Text)] -> Values
fromList :: [(Text, Text)] -> Values
fromList = HashMap Text Text -> Values
Values forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList