{-# LANGUAGE TypeApplications #-}
-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: unstable
-- Portability: portable
--
-- Internal module providing Config functionality
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Conferer.Config.Internal where

import Control.Monad (foldM, forM, msum)
import Data.Dynamic
import Data.List (sort, nub, union)
import Data.Text (Text)
import Data.Maybe (isJust)
import qualified Data.Map as Map

import Conferer.Key
import Conferer.Source.Internal
import Conferer.Config.Internal.Types

-- | This function runs lookups on the 'Config', first in 'Source's in order and
--   then on the 'Dynamic' based defaults.
getKey :: Key -> Config -> IO KeyLookupResult
getKey :: Key -> Config -> IO KeyLookupResult
getKey Key
key Config
config = do
  let possibleKeys :: [MappedKey]
possibleKeys = [KeyMapping] -> Key -> [MappedKey]
getKeysFromMappings (Config -> [KeyMapping]
configKeyMappings Config
config) Key
key
  [IO (Maybe (Key, Text))] -> IO (Maybe (Key, Text))
forall a. [IO (Maybe a)] -> IO (Maybe a)
untilJust ((MappedKey -> IO (Maybe (Key, Text)))
-> [MappedKey] -> [IO (Maybe (Key, Text))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MappedKey{[KeyMapping]
Key
mappedKey :: MappedKey -> Key
mappingsChain :: MappedKey -> [KeyMapping]
mappedKey :: Key
mappingsChain :: [KeyMapping]
..} -> Key -> Config -> IO (Maybe (Key, Text))
getRawKeyInSources Key
mappedKey Config
config) [MappedKey]
possibleKeys)
    IO (Maybe (Key, Text))
-> (Maybe (Key, Text) -> IO KeyLookupResult) -> IO KeyLookupResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Key
k, Text
textResult) ->
          KeyLookupResult -> IO KeyLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyLookupResult -> IO KeyLookupResult)
-> KeyLookupResult -> IO KeyLookupResult
forall a b. (a -> b) -> a -> b
$ Key -> Text -> KeyLookupResult
FoundInSources Key
k Text
textResult
        Maybe (Key, Text)
Nothing ->
          case [Maybe (Key, [Dynamic])] -> Maybe (Key, [Dynamic])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (Key, [Dynamic])] -> Maybe (Key, [Dynamic]))
-> [Maybe (Key, [Dynamic])] -> Maybe (Key, [Dynamic])
forall a b. (a -> b) -> a -> b
$ (MappedKey -> Maybe (Key, [Dynamic]))
-> [MappedKey] -> [Maybe (Key, [Dynamic])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MappedKey{[KeyMapping]
Key
mappedKey :: Key
mappingsChain :: [KeyMapping]
mappedKey :: MappedKey -> Key
mappingsChain :: MappedKey -> [KeyMapping]
..} -> ([Dynamic] -> (Key, [Dynamic]))
-> Maybe [Dynamic] -> Maybe (Key, [Dynamic])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
mappedKey,) (Maybe [Dynamic] -> Maybe (Key, [Dynamic]))
-> Maybe [Dynamic] -> Maybe (Key, [Dynamic])
forall a b. (a -> b) -> a -> b
$ (Key -> Config -> Maybe [Dynamic]
getKeyFromDefaults Key
mappedKey Config
config)) [MappedKey]
possibleKeys of
            Just (Key
k, [Dynamic]
dynResult) -> KeyLookupResult -> IO KeyLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyLookupResult -> IO KeyLookupResult)
-> KeyLookupResult -> IO KeyLookupResult
forall a b. (a -> b) -> a -> b
$ Key -> [Dynamic] -> KeyLookupResult
FoundInDefaults Key
k [Dynamic]
dynResult
            Maybe (Key, [Dynamic])
Nothing -> KeyLookupResult -> IO KeyLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyLookupResult -> IO KeyLookupResult)
-> KeyLookupResult -> IO KeyLookupResult
forall a b. (a -> b) -> a -> b
$ [Key] -> KeyLookupResult
MissingKey [Key
key]

-- | Alias for a mapping from one key to another used for transforming keys
type KeyMapping = (Key, Key)

-- | A key that has been transformed using one or many 'KeyMapping's, so that
--   that process can be reversed.
data MappedKey = MappedKey
  { MappedKey -> [KeyMapping]
mappingsChain :: [KeyMapping]
  , MappedKey -> Key
mappedKey :: Key
  } deriving (Int -> MappedKey -> ShowS
[MappedKey] -> ShowS
MappedKey -> String
(Int -> MappedKey -> ShowS)
-> (MappedKey -> String)
-> ([MappedKey] -> ShowS)
-> Show MappedKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MappedKey] -> ShowS
$cshowList :: [MappedKey] -> ShowS
show :: MappedKey -> String
$cshow :: MappedKey -> String
showsPrec :: Int -> MappedKey -> ShowS
$cshowsPrec :: Int -> MappedKey -> ShowS
Show, MappedKey -> MappedKey -> Bool
(MappedKey -> MappedKey -> Bool)
-> (MappedKey -> MappedKey -> Bool) -> Eq MappedKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MappedKey -> MappedKey -> Bool
$c/= :: MappedKey -> MappedKey -> Bool
== :: MappedKey -> MappedKey -> Bool
$c== :: MappedKey -> MappedKey -> Bool
Eq)


-- | This function lists all available keys under some key, that could be fetched
--   successfully.
listSubkeys :: Key -> Config -> IO [Key]
listSubkeys :: Key -> Config -> IO [Key]
listSubkeys Key
originalKey Config{[KeyMapping]
[Source]
Map Key [Dynamic]
configDefaults :: Config -> Map Key [Dynamic]
configSources :: Config -> [Source]
configKeyMappings :: [KeyMapping]
configDefaults :: Map Key [Dynamic]
configSources :: [Source]
configKeyMappings :: Config -> [KeyMapping]
..} = do
  let mappedKeys :: [MappedKey]
mappedKeys = [KeyMapping] -> Key -> [MappedKey]
getKeysFromMappings [KeyMapping]
configKeyMappings Key
originalKey
  [[MappedKey]]
subkeysFromSources <- [MappedKey] -> (MappedKey -> IO [MappedKey]) -> IO [[MappedKey]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [MappedKey]
mappedKeys ((MappedKey -> IO [MappedKey]) -> IO [[MappedKey]])
-> (MappedKey -> IO [MappedKey]) -> IO [[MappedKey]]
forall a b. (a -> b) -> a -> b
$ \MappedKey{[KeyMapping]
Key
mappedKey :: Key
mappingsChain :: [KeyMapping]
mappedKey :: MappedKey -> Key
mappingsChain :: MappedKey -> [KeyMapping]
..} -> do
    [Key]
subkeysFromSources <- Key -> [Source] -> IO [Key]
listRawSubkeysInSources Key
mappedKey [Source]
configSources
    let subkeysFromDefaults :: [Key]
subkeysFromDefaults =
          (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Key
mappedKey Key -> Key -> Bool
`isKeyPrefixOf`) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ Map Key [Dynamic] -> [Key]
forall k a. Map k a -> [k]
Map.keys Map Key [Dynamic]
configDefaults
    [MappedKey] -> IO [MappedKey]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MappedKey] -> IO [MappedKey]) -> [MappedKey] -> IO [MappedKey]
forall a b. (a -> b) -> a -> b
$ (Key -> MappedKey) -> [Key] -> [MappedKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([KeyMapping] -> Key -> MappedKey
MappedKey [KeyMapping]
mappingsChain) ([Key] -> [MappedKey]) -> [Key] -> [MappedKey]
forall a b. (a -> b) -> a -> b
$ [Key]
subkeysFromSources [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ [Key]
subkeysFromDefaults
  let subkeys :: [MappedKey]
subkeys = [[MappedKey]] -> [MappedKey]
forall a. Monoid a => [a] -> a
mconcat [[MappedKey]]
subkeysFromSources
  [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Key] -> IO [Key]) -> [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ [Key] -> [Key]
forall a. Ord a => [a] -> [a]
sort ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ [Key] -> [Key]
forall a. Eq a => [a] -> [a]
nub ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ (MappedKey -> Key) -> [MappedKey] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MappedKey -> Key
undoMappings [MappedKey]
subkeys

-- | This function lists subkeys in some 'Source's and combines the results
listRawSubkeysInSources :: Key -> [Source] -> IO [Key]
listRawSubkeysInSources :: Key -> [Source] -> IO [Key]
listRawSubkeysInSources Key
mappedKey [Source]
configSources = Key -> [Key] -> [Source] -> IO [Key]
go Key
mappedKey [] [Source]
configSources
  where
    go :: Key -> [Key] -> [Source] -> IO [Key]
    go :: Key -> [Key] -> [Source] -> IO [Key]
go Key
_ [Key]
result [] = [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return [Key]
result
    go Key
k [Key]
result (Source
source:[Source]
otherSources) = do
      [Key]
subkeys <- Source -> Key -> IO [Key]
forall s. IsSource s => s -> Key -> IO [Key]
getSubkeysInSource Source
source Key
k
      Key -> [Key] -> [Source] -> IO [Key]
go Key
k ([Key]
result [Key] -> [Key] -> [Key]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Key]
subkeys) [Source]
otherSources

-- | This function reverses the mappings in a 'MappedKey' to retrieve the
--   original key.
--
--   Assumes that mappings were really used, otherwise it ignores bad values
undoMappings :: MappedKey -> Key
undoMappings :: MappedKey -> Key
undoMappings MappedKey{[KeyMapping]
Key
mappedKey :: Key
mappingsChain :: [KeyMapping]
mappedKey :: MappedKey -> Key
mappingsChain :: MappedKey -> [KeyMapping]
..} =
  [KeyMapping] -> Key -> Key
go ([KeyMapping] -> [KeyMapping]
forall a. [a] -> [a]
reverse [KeyMapping]
mappingsChain) Key
mappedKey
  where
    go :: [KeyMapping] -> Key -> Key
go [] Key
key = Key
key
    go ((Key
src, Key
dest):[KeyMapping]
others) Key
key =
      case Key -> Key -> Maybe Key
stripKeyPrefix Key
dest Key
key of
        Just Key
k -> [KeyMapping] -> Key -> Key
go [KeyMapping]
others (Key
src Key -> Key -> Key
/. Key
k)
        Maybe Key
Nothing -> [KeyMapping] -> Key -> Key
go [KeyMapping]
others Key
key

-- | This utility function run a list of IO actions and returns the
--   first that return a 'Just', if no one does, returns 'Nothing'
untilJust :: [IO (Maybe a)] -> IO (Maybe a)
untilJust :: [IO (Maybe a)] -> IO (Maybe a)
untilJust [IO (Maybe a)]
actions = [IO (Maybe a)] -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
go [IO (Maybe a)]
actions
  where
    go :: [m (Maybe a)] -> m (Maybe a)
go [] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    go (m (Maybe a)
action:[m (Maybe a)]
rest) = do
      m (Maybe a)
action
        m (Maybe a) -> (Maybe a -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just a
res -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
res
          Maybe a
Nothing -> [m (Maybe a)] -> m (Maybe a)
go [m (Maybe a)]
rest

-- | This function tries to apply a list of mappings to a key meaning
-- replace the prefix with the new value from the mapping, if the mapping
-- isn't a prefix that mapping is ignored
--
-- This function always terminates even in presence of recursive mappings,
-- since it removes the mapping after it was first used, and that causes that
-- eventually the function will run out of keymappings and terminate.
getKeysFromMappings :: [KeyMapping] -> Key -> [MappedKey]
getKeysFromMappings :: [KeyMapping] -> Key -> [MappedKey]
getKeysFromMappings [KeyMapping]
originalKeyMappings Key
originalKey =
  MappedKey -> [KeyMapping] -> [MappedKey]
go ([KeyMapping] -> Key -> MappedKey
MappedKey [] Key
originalKey) [KeyMapping]
originalKeyMappings
  where
    go :: MappedKey -> [KeyMapping] -> [MappedKey]
    go :: MappedKey -> [KeyMapping] -> [MappedKey]
go MappedKey
k [] = [MappedKey
k]
    go MappedKey
currKey [KeyMapping]
keyMappings =
      [MappedKey] -> [MappedKey]
forall a. Eq a => [a] -> [a]
nub ([MappedKey] -> [MappedKey]) -> [MappedKey] -> [MappedKey]
forall a b. (a -> b) -> a -> b
$
        MappedKey
currKey MappedKey -> [MappedKey] -> [MappedKey]
forall a. a -> [a] -> [a]
:
        [[MappedKey]] -> [MappedKey]
forall a. Monoid a => [a] -> a
mconcat (
        (([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey])
-> [([KeyMapping], MappedKey, [KeyMapping])] -> [[MappedKey]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey]
generateDerivedKeys ([([KeyMapping], MappedKey, [KeyMapping])] -> [[MappedKey]])
-> [([KeyMapping], MappedKey, [KeyMapping])] -> [[MappedKey]]
forall a b. (a -> b) -> a -> b
$
        (KeyMapping -> Maybe MappedKey)
-> [KeyMapping] -> [([KeyMapping], MappedKey, [KeyMapping])]
forall a b. (a -> Maybe b) -> [a] -> [([a], b, [a])]
findAndSplitList KeyMapping -> Maybe MappedKey
tryMappingKey
        [KeyMapping]
keyMappings)
      where
        tryMappingKey :: (Key, Key) -> Maybe MappedKey
        tryMappingKey :: KeyMapping -> Maybe MappedKey
tryMappingKey (Key
source, Key
dest) =
          case Key -> Key -> Maybe Key
stripKeyPrefix Key
source (MappedKey -> Key
mappedKey MappedKey
currKey) of
            Just Key
aKey ->
              MappedKey -> Maybe MappedKey
forall a. a -> Maybe a
Just (MappedKey -> Maybe MappedKey) -> MappedKey -> Maybe MappedKey
forall a b. (a -> b) -> a -> b
$ [KeyMapping] -> Key -> MappedKey
MappedKey (MappedKey -> [KeyMapping]
mappingsChain MappedKey
currKey [KeyMapping] -> [KeyMapping] -> [KeyMapping]
forall a. [a] -> [a] -> [a]
++ [(Key
source, Key
dest)]) (Key
dest Key -> Key -> Key
/. Key
aKey)
            Maybe Key
Nothing -> Maybe MappedKey
forall a. Maybe a
Nothing
        generateDerivedKeys :: ([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey]
        generateDerivedKeys :: ([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey]
generateDerivedKeys ([KeyMapping]
prevMappings, MappedKey
aKey, [KeyMapping]
nextMappings) =
          MappedKey -> [KeyMapping] -> [MappedKey]
go MappedKey
aKey ([KeyMapping] -> [MappedKey]) -> [KeyMapping] -> [MappedKey]
forall a b. (a -> b) -> a -> b
$ [KeyMapping]
prevMappings [KeyMapping] -> [KeyMapping] -> [KeyMapping]
forall a. [a] -> [a] -> [a]
++ [KeyMapping]
nextMappings

-- | This utility function splits a list based on a @cond@ function and returns a tuple
--   of previous value, next values and the mapped found value.
findAndSplitList :: forall a b. (a -> Maybe b) -> [a] -> [([a], b, [a])]
findAndSplitList :: (a -> Maybe b) -> [a] -> [([a], b, [a])]
findAndSplitList a -> Maybe b
cond [a]
list = [a] -> [a] -> [([a], b, [a])]
go [] [a]
list
  where
    go :: [a] -> [a] -> [([a], b, [a])]
    go :: [a] -> [a] -> [([a], b, [a])]
go [a]
_ [] = []
    go [a]
prevElems (a
curElem:[a]
nextElems) =
      case a -> Maybe b
cond a
curElem of
        Just b
res ->
          ([a]
prevElems, b
res, [a]
nextElems) ([a], b, [a]) -> [([a], b, [a])] -> [([a], b, [a])]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [([a], b, [a])]
go (a
curElema -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
prevElems) [a]
nextElems
        Maybe b
Nothing ->
          [a] -> [a] -> [([a], b, [a])]
go (a
curElema -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
prevElems) [a]
nextElems

-- | This function gets a value from 'Source's but ignores mappings and defaults
getRawKeyInSources :: Key -> Config -> IO (Maybe (Key, Text))
getRawKeyInSources :: Key -> Config -> IO (Maybe (Key, Text))
getRawKeyInSources Key
k Config{[KeyMapping]
[Source]
Map Key [Dynamic]
configKeyMappings :: [KeyMapping]
configDefaults :: Map Key [Dynamic]
configSources :: [Source]
configDefaults :: Config -> Map Key [Dynamic]
configSources :: Config -> [Source]
configKeyMappings :: Config -> [KeyMapping]
..} =
  [Source] -> IO (Maybe (Key, Text))
forall s. IsSource s => [s] -> IO (Maybe (Key, Text))
go [Source]
configSources
  where
    go :: [s] -> IO (Maybe (Key, Text))
go [] = Maybe (Key, Text) -> IO (Maybe (Key, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key, Text)
forall a. Maybe a
Nothing
    go (s
source:[s]
otherSources) = do
      Maybe Text
res <- s -> Key -> IO (Maybe Text)
forall s. IsSource s => s -> Key -> IO (Maybe Text)
getKeyInSource s
source Key
k
      case Maybe Text
res of
        Just Text
t -> Maybe (Key, Text) -> IO (Maybe (Key, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Key, Text) -> IO (Maybe (Key, Text)))
-> Maybe (Key, Text) -> IO (Maybe (Key, Text))
forall a b. (a -> b) -> a -> b
$ (Key, Text) -> Maybe (Key, Text)
forall a. a -> Maybe a
Just (Key
k, Text
t)
        Maybe Text
Nothing -> [s] -> IO (Maybe (Key, Text))
go [s]
otherSources

-- | This function gets values from the defaults
getKeyFromDefaults :: Key -> Config -> Maybe [Dynamic]
getKeyFromDefaults :: Key -> Config -> Maybe [Dynamic]
getKeyFromDefaults Key
key Config{[KeyMapping]
[Source]
Map Key [Dynamic]
configKeyMappings :: [KeyMapping]
configDefaults :: Map Key [Dynamic]
configSources :: [Source]
configDefaults :: Config -> Map Key [Dynamic]
configSources :: Config -> [Source]
configKeyMappings :: Config -> [KeyMapping]
..} =
  let
    possibleKeys :: [Key]
possibleKeys = (MappedKey -> Key) -> [MappedKey] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MappedKey -> Key
mappedKey ([MappedKey] -> [Key]) -> [MappedKey] -> [Key]
forall a b. (a -> b) -> a -> b
$ [KeyMapping] -> Key -> [MappedKey]
getKeysFromMappings [KeyMapping]
configKeyMappings Key
key
  in [Maybe [Dynamic]] -> Maybe [Dynamic]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe [Dynamic]] -> Maybe [Dynamic])
-> [Maybe [Dynamic]] -> Maybe [Dynamic]
forall a b. (a -> b) -> a -> b
$ (Key -> Maybe [Dynamic]) -> [Key] -> [Maybe [Dynamic]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Key
k -> Key -> Map Key [Dynamic] -> Maybe [Dynamic]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
k Map Key [Dynamic]
configDefaults) [Key]
possibleKeys

-- | The empty configuration, this 'Config' is used as the base for
--   most config creating functions.
emptyConfig :: Config
emptyConfig :: Config
emptyConfig = Config :: [Source] -> Map Key [Dynamic] -> [KeyMapping] -> Config
Config
  { configSources :: [Source]
configSources = []
  , configDefaults :: Map Key [Dynamic]
configDefaults = Map Key [Dynamic]
forall k a. Map k a
Map.empty
  , configKeyMappings :: [KeyMapping]
configKeyMappings = []
  }

-- | This function adds some key mappings to a 'Config'
addKeyMappings :: [KeyMapping] -> Config -> Config
addKeyMappings :: [KeyMapping] -> Config -> Config
addKeyMappings [KeyMapping]
keyMappings Config
config =
  Config
config
  { configKeyMappings :: [KeyMapping]
configKeyMappings = Config -> [KeyMapping]
configKeyMappings Config
config [KeyMapping] -> [KeyMapping] -> [KeyMapping]
forall a. [a] -> [a] -> [a]
++ [KeyMapping]
keyMappings
  }

-- | This function adds defaults to a 'Config'
addDefaults :: [(Key, Dynamic)] -> Config -> Config
addDefaults :: [(Key, Dynamic)] -> Config -> Config
addDefaults [(Key, Dynamic)]
configMap Config
config =
  let
    constructedMap :: Map Key [Dynamic]
constructedMap =
      ([Dynamic] -> [Dynamic] -> [Dynamic])
-> [(Key, [Dynamic])] -> Map Key [Dynamic]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Dynamic] -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a] -> [a]
(++)
      ([(Key, [Dynamic])] -> Map Key [Dynamic])
-> ([(Key, Dynamic)] -> [(Key, [Dynamic])])
-> [(Key, Dynamic)]
-> Map Key [Dynamic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Dynamic) -> (Key, [Dynamic]))
-> [(Key, Dynamic)] -> [(Key, [Dynamic])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Key
k,Dynamic
v) -> (Key
k, [Dynamic
v]))
      ([(Key, Dynamic)] -> Map Key [Dynamic])
-> [(Key, Dynamic)] -> Map Key [Dynamic]
forall a b. (a -> b) -> a -> b
$ [(Key, Dynamic)]
configMap
  in Config
config
  { configDefaults :: Map Key [Dynamic]
configDefaults =
    ([Dynamic] -> [Dynamic] -> [Dynamic])
-> Map Key [Dynamic] -> Map Key [Dynamic] -> Map Key [Dynamic]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [Dynamic] -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a] -> [a]
(++) Map Key [Dynamic]
constructedMap
      (Map Key [Dynamic] -> Map Key [Dynamic])
-> Map Key [Dynamic] -> Map Key [Dynamic]
forall a b. (a -> b) -> a -> b
$ Config -> Map Key [Dynamic]
configDefaults Config
config
  }

-- | This function removes a default from a 'Config', this is the
-- oposite of 'addDefault', it deletes the first element of
-- matching type in a certain 'Key'.
removeDefault :: forall t. Typeable t => Key -> Config -> Config
removeDefault :: Key -> Config -> Config
removeDefault Key
key Config
config =
  Config
config
  { configDefaults :: Map Key [Dynamic]
configDefaults =
      ([Dynamic] -> Maybe [Dynamic])
-> Key -> Map Key [Dynamic] -> Map Key [Dynamic]
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update [Dynamic] -> Maybe [Dynamic]
removeFirstDynamic Key
key (Map Key [Dynamic] -> Map Key [Dynamic])
-> Map Key [Dynamic] -> Map Key [Dynamic]
forall a b. (a -> b) -> a -> b
$ Config -> Map Key [Dynamic]
configDefaults Config
config
  }
  where
    removeFirst :: (a -> Bool) -> [a] -> [a]
    removeFirst :: (a -> Bool) -> [a] -> [a]
removeFirst a -> Bool
_ [] = []
    removeFirst a -> Bool
condition (a
x:[a]
xs) =
      if a -> Bool
condition a
x
        then [a]
xs
        else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
removeFirst a -> Bool
condition [a]
xs

    removeFirstDynamic :: [Dynamic] -> Maybe [Dynamic]
    removeFirstDynamic :: [Dynamic] -> Maybe [Dynamic]
removeFirstDynamic [Dynamic]
dynamics =
      let result :: [Dynamic]
result = (Dynamic -> Bool) -> [Dynamic] -> [Dynamic]
forall a. (a -> Bool) -> [a] -> [a]
removeFirst (Maybe t -> Bool
forall a. Maybe a -> Bool
isJust (Maybe t -> Bool) -> (Dynamic -> Maybe t) -> Dynamic -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typeable t => Dynamic -> Maybe t
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic @t) [Dynamic]
dynamics
      in if [Dynamic] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dynamic]
result
          then Maybe [Dynamic]
forall a. Maybe a
Nothing 
          else [Dynamic] -> Maybe [Dynamic]
forall a. a -> Maybe a
Just [Dynamic]
result

-- | This function adds one default of a custom type to a 'Config'
--
--   Note that unlike 'addDefaults' this function does the toDyn so
--   no need to do it on the user's side
addDefault :: (Typeable a) => Key -> a -> Config -> Config
addDefault :: Key -> a -> Config -> Config
addDefault Key
key a
value Config
config =
  Config
config
  { configDefaults :: Map Key [Dynamic]
configDefaults = ([Dynamic] -> [Dynamic] -> [Dynamic])
-> Key -> [Dynamic] -> Map Key [Dynamic] -> Map Key [Dynamic]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Dynamic] -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a] -> [a]
(++) Key
key [a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
value] (Map Key [Dynamic] -> Map Key [Dynamic])
-> Map Key [Dynamic] -> Map Key [Dynamic]
forall a b. (a -> b) -> a -> b
$ Config -> Map Key [Dynamic]
configDefaults Config
config
  }

-- | Instantiate a 'Source' using an 'SourceCreator' and a 'Config' and add
--   to the config
addSource :: SourceCreator -> Config -> IO Config
addSource :: SourceCreator -> Config -> IO Config
addSource SourceCreator
mkSource Config
config = do
  Source
newSource <- SourceCreator
mkSource Config
config
  Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$
    Config
config
    { configSources :: [Source]
configSources = Config -> [Source]
configSources Config
config [Source] -> [Source] -> [Source]
forall a. [a] -> [a] -> [a]
++ [ Source
newSource ]
    }

-- | Instantiate several 'Source's using a 'SourceCreator's and a 'Config' and add
--   them to the config in the order defined by the list
addSources :: [SourceCreator] -> Config -> IO Config
addSources :: [SourceCreator] -> Config -> IO Config
addSources [SourceCreator]
sources Config
config = (Config -> SourceCreator -> IO Config)
-> Config -> [SourceCreator] -> IO Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((SourceCreator -> Config -> IO Config)
-> Config -> SourceCreator -> IO Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourceCreator -> Config -> IO Config
addSource) Config
config [SourceCreator]
sources

-- orElse :: IO KeyLookupResult -> IO KeyLookupResult -> IO KeyLookupResult
-- orElse getKey1 getKey2 = do
--   result1 <- getKey1
--   case result1 of
--     MissingKey _ -> getKey2
--     FoundInSources _ _ -> return result1
--     FoundInDefaults _ _ -> do
--       result2 <- getKey2
--       case result2 of
--         MissingKey _ -> return result1
--         FoundInSources _ _ -> return result2
--         FoundInDefaults _ _ -> return result1