-- | This module contains the 'Mappings' type, which is used to store environment variable name mappings, and its typeclass instances.
module RichEnv.Types.Mappings (Mappings (Mappings, unMappings), 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 variable name mappings. The internal representation is a 'HashMap Text Text', where the key is the final variable name and the value is the current one which will be replaced.
newtype Mappings = Mappings {Mappings -> HashMap Text Text
unMappings :: HM.HashMap Text Text}
  deriving stock (Mappings -> Mappings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mappings -> Mappings -> Bool
$c/= :: Mappings -> Mappings -> Bool
== :: Mappings -> Mappings -> Bool
$c== :: Mappings -> Mappings -> Bool
Eq, Int -> Mappings -> ShowS
[Mappings] -> ShowS
Mappings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mappings] -> ShowS
$cshowList :: [Mappings] -> ShowS
show :: Mappings -> String
$cshow :: Mappings -> String
showsPrec :: Int -> Mappings -> ShowS
$cshowsPrec :: Int -> Mappings -> ShowS
Show, forall x. Rep Mappings x -> Mappings
forall x. Mappings -> Rep Mappings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mappings x -> Mappings
$cfrom :: forall x. Mappings -> Rep Mappings x
Generic)

instance FromJSON Mappings where
  parseJSON :: Value -> Parser Mappings
  parseJSON :: Value -> Parser Mappings
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 Mappings where
  toJSON :: Mappings -> Value
  toJSON :: Mappings -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mappings -> HashMap Text Text
unMappings

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

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

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