{-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleContexts #-} module Conferer.Core where import Data.Text (Text) import qualified Data.Text as Text import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Typeable (Typeable, Proxy(..), typeRep) import Control.Exception (try, throw, throwIO, evaluate) import Conferer.Provider.Simple import Conferer.Types -- | Most Basic function to interact directly with a 'Config'. It always returns -- 'Text' in the case of success and implements the logic to traverse -- providers inside the 'Config'. getKey :: Key -> Config -> IO (Maybe Text) getKey k config = go $ providers config ++ [mkPureMapProvider (defaults config)] where go [] = return Nothing go (provider:providers) = do res <- getKeyInProvider provider k case res of Just t -> return $ Just t Nothing -> go providers -- | Fetch a value from a config under some specific key that's parsed using the 'FromConfig' -- instance, and as a default it uses the value from 'DefaultConfig'. -- -- Notes: -- - This function may throw an exception if parsing fails for any subkey getFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO a getFromConfig key config = getFromConfigWithDefault key config configDef -- | Same as 'getFromConfig' using the root key -- -- Notes: -- - This function may throw an exception if parsing fails for any subkey getFromRootConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Config -> IO a getFromRootConfig config = getFromConfig "" config -- | Same as 'getFromConfig' but with a user defined default (instead of 'DefaultConfig' instance) -- -- Useful for fetching primitive types getFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO a getFromConfigWithDefault key config configDefault = safeGetFromConfigWithDefault key config configDefault >>= \case Just value -> do evaluate value Nothing -> throwIO $ FailedToFetchError key (typeRep (Proxy :: Proxy a)) -- | Fetch a value from a config key that's parsed using the FromConfig instance. -- -- Note: This function does not use default so the value must be fully defined by the config only, -- meaning using this function for many records will always result in 'Nothing' (if the record contains -- a value that can never be retrieved like a function) safeGetFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO (Maybe a) safeGetFromConfig key config = safeGetFromConfigWithDefault key config configDef -- | Same as 'safeGetFromConfig' but with a user defined default safeGetFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO (Maybe a) safeGetFromConfigWithDefault key config configDefault = do totalValue <- evaluate =<< fetchFromConfig key config case totalValue of Just value -> do Just <$> evaluate value Nothing -> do result :: Either FailedToFetchError a <- try . (evaluate =<<) . updateFromConfig key config $ configDefault case result of Right a -> Just <$> evaluate a Left e -> return Nothing -- | Create a new 'Key' by concatenating two existing keys. (/.) :: Key -> Key -> Key parent /. child = Path (unKey parent ++ unKey child) -- | The empty configuration, this 'Config' is used as the base for -- most config creating functions. emptyConfig :: Config emptyConfig = Config [] Map.empty withDefaults :: [(Key, Text)] -> Config -> Config withDefaults configMap config = config { defaults = Map.fromList configMap } -- | Instantiate a 'ProviderCreator' using the 'emptyConfig' mkStandaloneProvider :: ProviderCreator -> IO Provider mkStandaloneProvider mkProvider = mkProvider emptyConfig -- | Instantiate a 'Provider' using an 'ProviderCretor' and a 'Config' and add -- to the config addProvider :: ProviderCreator -> Config -> IO Config addProvider mkProvider config = do newProvider <- mkProvider config return $ config { providers = providers config ++ [ newProvider ] } -- | Same as 'getKey' but it throws if the 'Key' isn't found unsafeGetKey :: Key -> Config -> IO Text unsafeGetKey key config = fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy Text))) <$> getKey key config