{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Conferer.Types where import Data.String import Data.Text (Text) import qualified Data.Text as Text import Data.Map (Map) import qualified Data.Map as Map import Control.Exception import Data.Typeable import GHC.Generics -- | Core interface for library provided configuration, basically consists of -- getting a 'Key' and informing returning a maybe signaling the value and -- if it's present in that specific provider data Provider = Provider { getKeyInProvider :: Key -> IO (Maybe Text) } -- | The way to index 'Provider's, basically list of names that will be adapted -- to whatever the provider needs newtype Key = Path { unKey :: [Text] } deriving (Show, Eq, Ord) instance IsString Key where fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s -- | Collapse a key into a textual representation keyName :: Key -> Text keyName = Text.intercalate "." . unKey -- | Core type that the user of this library interact with, in the future it may -- contain more this besides a list of providers data Config = Config { providers :: [Provider] , defaults :: Map Key Text } -- | The type for creating a provider given a 'Config', some providers require a -- certain configuration to be initialized (for example: the redis provider -- needs connection info to connect to the server) type ProviderCreator = Config -> IO Provider keyNotPresentError :: forall a. (Typeable a) => Key -> Proxy a -> FailedToFetchError keyNotPresentError key = throw $ FailedToFetchError key $ typeRep (Proxy :: Proxy a) -- | Default defining instance -- -- Here a 'Nothing' means that the value didn't appear in the config, some -- instances never return a value since they have defaults that can never -- fail class DefaultConfig a where configDef :: a -- | Main typeclass for defining the way to get values from config, hiding the -- 'Text' based nature of the 'Provider's. -- updated using a config, so for example a Warp.Settings can get updated from a config, -- but that doesn't make much sense for something like an 'Int' -- -- You'd normally would never implement this typeclass, if you want to implement -- 'FromConfig' you should implement that directly, and if you want to use -- 'DefaultConfig' and 'FromConfig' to implement 'FromConfig' you should let -- the default 'Generics' based implementation do it's thing class FromConfig a where updateFromConfig :: Key -> Config -> a -> IO a default updateFromConfig :: (Generic a, Typeable a, FromConfigG (Rep a)) => Key -> Config -> a -> IO a updateFromConfig k c a = to <$> updateFromConfigG k c (from a) fetchFromConfig :: Key -> Config -> IO (Maybe a) default fetchFromConfig :: (Generic a, FromConfigG (Rep a)) => Key -> Config -> IO (Maybe a) fetchFromConfig k c = fmap to <$> fetchFromConfigG k c -- | Purely 'Generics' machinery, ignore... class FromConfigG f where updateFromConfigG :: Key -> Config -> f a -> IO (f a) fetchFromConfigG :: Key -> Config -> IO (Maybe (f a)) data ConfigParsingError = ConfigParsingError Key Text TypeRep deriving (Typeable, Eq) instance Show ConfigParsingError where show (ConfigParsingError key value typeRep) = concat [ "Couldn't parse value '" , Text.unpack value , "' from key '" , Text.unpack (keyName key) , "' as " , show typeRep ] instance Exception ConfigParsingError data FailedToFetchError = FailedToFetchError Key TypeRep deriving (Typeable, Eq) instance Show FailedToFetchError where show (FailedToFetchError key typeRep) = concat [ "Couldn't get a " , show typeRep , " from key '" , Text.unpack (keyName key) , "'" ] instance Exception FailedToFetchError