-- | This module contains the basic types used by the library and their typeclass instances.
module RichEnv.Types
  ( -- * Types
    RichEnv (..),
    defaultRichEnv,
    Environment,
    Mappings (..),
    Values (..),
    Prefixes (..),

    -- * Environment transformations
    toEnvironment,
    fromEnvironment,
  )
where

import Data.Aeson (FromJSON, ToJSON)
import Data.Bifunctor (bimap)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import RichEnv.Types.Mappings (Mappings (..))
import RichEnv.Types.Prefixes (Prefixes (..))
import RichEnv.Types.Values (Values (..))

-- | A list of key-value pairs representing environment variables.
type Environment = [(Text, Text)]

-- | Get back a @[(String, String)]@ from an 'Environment'.
fromEnvironment :: Environment -> [(String, String)]
fromEnvironment :: Environment -> [(String, String)]
fromEnvironment = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> String
T.unpack Text -> String
T.unpack)

-- | Transform the type returned from 'System.Environment.getEnvironment' (@[(String, String)]@) to use 'Text' instead.
toEnvironment :: [(String, String)] -> Environment
toEnvironment :: [(String, String)] -> Environment
toEnvironment = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
T.pack String -> Text
T.pack)

-- | Type that represents a set of rules that generate environment variables. A value of this type can be retrieved from a configuration file (e.g. YAML) due to its 'FromJSON' instance, or persisted into one with 'ToJSON'.
data RichEnv = RichEnv
  { -- | A list of environment variables to be set with their values.
    RichEnv -> Values
values :: Values,
    -- | Mappings from one existing environment variable name to another.
    RichEnv -> Mappings
mappings :: Mappings,
    -- | Mappings from different prefixes of existing environment variables to new prefixes.
    RichEnv -> Prefixes
prefixes :: Prefixes
  }
  deriving stock (RichEnv -> RichEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichEnv -> RichEnv -> Bool
$c/= :: RichEnv -> RichEnv -> Bool
== :: RichEnv -> RichEnv -> Bool
$c== :: RichEnv -> RichEnv -> Bool
Eq, Int -> RichEnv -> ShowS
[RichEnv] -> ShowS
RichEnv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichEnv] -> ShowS
$cshowList :: [RichEnv] -> ShowS
show :: RichEnv -> String
$cshow :: RichEnv -> String
showsPrec :: Int -> RichEnv -> ShowS
$cshowsPrec :: Int -> RichEnv -> ShowS
Show, forall x. Rep RichEnv x -> RichEnv
forall x. RichEnv -> Rep RichEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichEnv x -> RichEnv
$cfrom :: forall x. RichEnv -> Rep RichEnv x
Generic)
  deriving anyclass (Value -> Parser [RichEnv]
Value -> Parser RichEnv
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RichEnv]
$cparseJSONList :: Value -> Parser [RichEnv]
parseJSON :: Value -> Parser RichEnv
$cparseJSON :: Value -> Parser RichEnv
FromJSON, [RichEnv] -> Encoding
[RichEnv] -> Value
RichEnv -> Encoding
RichEnv -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RichEnv] -> Encoding
$ctoEncodingList :: [RichEnv] -> Encoding
toJSONList :: [RichEnv] -> Value
$ctoJSONList :: [RichEnv] -> Value
toEncoding :: RichEnv -> Encoding
$ctoEncoding :: RichEnv -> Encoding
toJSON :: RichEnv -> Value
$ctoJSON :: RichEnv -> Value
ToJSON)

instance Semigroup RichEnv where
  (<>) :: RichEnv -> RichEnv -> RichEnv
  <> :: RichEnv -> RichEnv -> RichEnv
(<>) (RichEnv Values
a Mappings
b Prefixes
c) (RichEnv Values
d Mappings
e Prefixes
f) = Values -> Mappings -> Prefixes -> RichEnv
RichEnv (Values
a forall a. Semigroup a => a -> a -> a
<> Values
d) (Mappings
b forall a. Semigroup a => a -> a -> a
<> Mappings
e) (Prefixes
c forall a. Semigroup a => a -> a -> a
<> Prefixes
f)

instance Monoid RichEnv where
  mempty :: RichEnv
  mempty :: RichEnv
mempty = Values -> Mappings -> Prefixes -> RichEnv
RichEnv forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | Default 'RichEnv' value. With everything empty.
defaultRichEnv :: RichEnv
defaultRichEnv :: RichEnv
defaultRichEnv = forall a. Monoid a => a
mempty