{-# LANGUAGE TypeApplications #-}
{-# 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
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]
type KeyMapping = (Key, Key)
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)
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
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
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
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
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
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
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
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
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 = []
}
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
}
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
}
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
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
}
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 ]
}
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