module System.Etc.Internal.Types
( module System.Etc.Internal.Types
, module System.Etc.Internal.Spec.Types
) where
import Protolude
import qualified Data.Aeson as JSON
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Set as Set
import System.Etc.Internal.Spec.Types (ConfigurationError (..))
data ConfigSource
= File {
configIndex :: Int
, filepath :: Text
, value :: JSON.Value
}
| Env {
envVar :: Text
, value :: JSON.Value
}
| Cli {
value :: JSON.Value
}
| Default {
value :: JSON.Value
}
| None
deriving (Show, Eq)
instance Ord ConfigSource where
compare a b =
if a == b then
EQ
else
case (a, b) of
(None, _) ->
LT
(_, None) ->
GT
(Default {}, _) ->
LT
(Cli {}, _) ->
GT
(_, Cli {}) ->
LT
(Env {}, _) ->
GT
(_, Env {}) ->
LT
(File {}, File {}) ->
comparing configIndex a b
(File {}, _) ->
GT
data ConfigValue
= ConfigValue {
configSource :: Set ConfigSource
}
| SubConfig {
configMap :: HashMap Text ConfigValue
}
deriving (Eq, Show)
deepMerge :: ConfigValue -> ConfigValue -> ConfigValue
deepMerge left right =
case (left, right) of
(SubConfig leftm, SubConfig rightm) ->
SubConfig $
HashMap.foldrWithKey
(\key rightv result ->
case HashMap.lookup key result of
Just leftv ->
HashMap.insert key (deepMerge leftv rightv) result
_ ->
HashMap.insert key rightv result)
leftm
rightm
(ConfigValue leftSources, ConfigValue rightSources) ->
ConfigValue $ Set.union leftSources rightSources
_ ->
right
instance Monoid ConfigValue where
mempty = emptySubConfig
mappend = deepMerge
newtype Config
= Config { fromConfig :: ConfigValue }
deriving (Eq, Show, Monoid)
isEmptySubConfig :: ConfigValue -> Bool
isEmptySubConfig val =
case val of
SubConfig hsh ->
HashMap.null hsh
ConfigValue {} ->
False
emptySubConfig :: ConfigValue
emptySubConfig =
SubConfig HashMap.empty
writeInSubConfig :: Text -> ConfigValue -> ConfigValue -> ConfigValue
writeInSubConfig key val subConfig =
case subConfig of
SubConfig hsh ->
SubConfig
$ HashMap.insert key val hsh
_ ->
subConfig
filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a
filterMaybe pfn mvalue =
case mvalue of
Just a
| pfn a ->
Nothing
| otherwise ->
mvalue
Nothing ->
Nothing