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)
newtype Mappings = Mappings {Mappings -> HashMap Text Text
unMappings :: HM.HashMap Text Text}
deriving stock (Mappings -> Mappings -> Bool
(Mappings -> Mappings -> Bool)
-> (Mappings -> Mappings -> Bool) -> Eq Mappings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mappings -> Mappings -> Bool
== :: Mappings -> Mappings -> Bool
$c/= :: Mappings -> Mappings -> Bool
/= :: Mappings -> Mappings -> Bool
Eq, Int -> Mappings -> ShowS
[Mappings] -> ShowS
Mappings -> String
(Int -> Mappings -> ShowS)
-> (Mappings -> String) -> ([Mappings] -> ShowS) -> Show Mappings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mappings -> ShowS
showsPrec :: Int -> Mappings -> ShowS
$cshow :: Mappings -> String
show :: Mappings -> String
$cshowList :: [Mappings] -> ShowS
showList :: [Mappings] -> ShowS
Show, (forall x. Mappings -> Rep Mappings x)
-> (forall x. Rep Mappings x -> Mappings) -> Generic Mappings
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
$cfrom :: forall x. Mappings -> Rep Mappings x
from :: forall x. Mappings -> Rep Mappings x
$cto :: forall x. Rep Mappings x -> Mappings
to :: forall x. Rep Mappings x -> Mappings
Generic)
instance FromJSON Mappings where
parseJSON :: Value -> Parser Mappings
parseJSON :: Value -> Parser Mappings
parseJSON = Options -> Value -> Parser Mappings
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Mappings)
-> Options -> Value -> Parser Mappings
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions {unwrapUnaryRecords = True}
instance ToJSON Mappings where
toJSON :: Mappings -> Value
toJSON :: Mappings -> Value
toJSON = HashMap Text Text -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text Text -> Value)
-> (Mappings -> HashMap Text Text) -> Mappings -> Value
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 HashMap Text Text -> HashMap Text Text -> HashMap Text Text
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 HashMap Text Text
forall a. Monoid a => a
mempty
fromList :: [(Text, Text)] -> Mappings
fromList :: [(Text, Text)] -> Mappings
fromList = HashMap Text Text -> Mappings
Mappings (HashMap Text Text -> Mappings)
-> ([(Text, Text)] -> HashMap Text Text)
-> [(Text, Text)]
-> Mappings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList