{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-} -- | -- Module: Data.Configurator.Types.Internal -- Copyright: (c) 2011 MailRank, Inc. -- License: BSD3 -- Maintainer: Bryan O'Sullivan <bos@serpentine.com> -- Stability: experimental -- Portability: portable -- -- Types for working with configuration files. module Data.Configurator.Types.Internal ( BaseConfig(..) , Config(..) , Configured(..) , AutoConfig(..) , Worth(..) , Name , Value(..) , Binding , Path , Directive(..) , ConfigError(..) , KeyError(..) , Interpolate(..) , Pattern(..) , exact , prefix , ChangeHandler ) where import Control.Exception import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.IORef (IORef) import Data.List (isSuffixOf) import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) import Prelude hiding (lookup) import qualified Data.HashMap.Lazy as H data Worth a = Required { worth :: a } | Optional { worth :: a } deriving (Show, Typeable) instance IsString (Worth FilePath) where fromString = Required instance (Eq a) => Eq (Worth a) where a == b = worth a == worth b instance (Hashable a) => Hashable (Worth a) where hashWithSalt salt v = hashWithSalt salt (worth v) -- | Global configuration data. This is the top-level config from which -- 'Config' values are derived by choosing a root location. data BaseConfig = BaseConfig { cfgAuto :: Maybe AutoConfig , cfgPaths :: IORef [(Name, Worth Path)] -- ^ The files from which the 'Config' was loaded. , cfgMap :: IORef (H.HashMap Name Value) , cfgSubs :: IORef (H.HashMap Pattern [ChangeHandler]) } -- | Configuration data. data Config = Config { root :: Text, baseCfg :: BaseConfig } instance Functor Worth where fmap f (Required a) = Required (f a) fmap f (Optional a) = Optional (f a) -- | An action to be invoked if a configuration property is changed. -- -- If this action is invoked and throws an exception, the 'onError' -- function will be called. type ChangeHandler = Name -- ^ Name of the changed property. -> Maybe Value -- ^ Its new value, or 'Nothing' if it has -- vanished. -> IO () -- | A pattern specifying the name of a property that has changed. -- -- This type is an instance of the 'IsString' class. If you use the -- @OverloadedStrings@ language extension and want to write a -- 'prefix'-matching pattern as a literal string, do so by suffixing -- it with \"@.*@\", for example as follows: -- -- > "foo.*" -- -- If a pattern written as a literal string does not end with -- \"@.*@\", it is assumed to be 'exact'. data Pattern = Exact Name -- ^ An exact match. | Prefix Name -- ^ A prefix match. Given @'Prefix' \"foo\"@, this will -- match @\"foo.bar\"@, but not @\"foo\"@ or -- @\"foobar\"@. deriving (Eq, Show, Typeable, Data) -- | A pattern that must match exactly. exact :: Text -> Pattern exact = Exact -- | A pattern that matches on a prefix of a property name. Given -- @\"foo\"@, this will match @\"foo.bar\"@, but not @\"foo\"@ or -- @\"foobar\"@. prefix :: Text -> Pattern prefix p = Prefix (p `T.snoc` '.') instance IsString Pattern where fromString s | ".*" `isSuffixOf` s = Prefix . T.init . T.pack $ s | otherwise = Exact (T.pack s) instance Hashable Pattern where hashWithSalt salt (Exact n) = hashWithSalt salt n hashWithSalt salt (Prefix n) = hashWithSalt salt n -- | This class represents types that can be automatically and safely -- converted /from/ a 'Value' /to/ a destination type. If conversion -- fails because the types are not compatible, 'Nothing' is returned. -- -- For an example of compatibility, a 'Value' of 'Bool' 'True' cannot -- be 'convert'ed to an 'Int'. class Configured a where convert :: Value -> Maybe a -- | An error occurred while processing a configuration file. data ConfigError = ParseError FilePath String deriving (Show, Typeable) instance Exception ConfigError -- | An error occurred while lookup up the given 'Name'. data KeyError = KeyError Name deriving (Show, Typeable) instance Exception KeyError -- | Directions for automatically reloading 'Config' data. data AutoConfig = AutoConfig { interval :: Int -- ^ Interval (in seconds) at which to check for updates to config -- files. The smallest allowed interval is one second. , onError :: SomeException -> IO () -- ^ Action invoked when an attempt to reload a 'Config' or notify -- a 'ChangeHandler' causes an exception to be thrown. -- -- If this action rethrows its exception or throws a new -- exception, the modification checking thread will be killed. -- You may want your application to treat that as a fatal error, -- as its configuration may no longer be consistent. } deriving (Typeable) instance Show AutoConfig where show c = "AutoConfig {interval = " ++ show (interval c) ++ "}" -- | The name of a 'Config' value. type Name = Text -- | A packed 'FilePath'. type Path = Text -- | A name-value binding. type Binding = (Name,Value) -- | A directive in a configuration file. data Directive = Import Path | Bind Name Value | Group Name [Directive] deriving (Eq, Show, Typeable, Data) -- | A value in a 'Config'. data Value = Bool Bool -- ^ A Boolean. Represented in a configuration file as @on@ -- or @off@, @true@ or @false@ (case sensitive). | String Text -- ^ A Unicode string. Represented in a configuration file -- as text surrounded by double quotes. -- -- Escape sequences: -- -- * @\\n@ - newline -- -- * @\\r@ - carriage return -- -- * @\\t@ - horizontal tab -- -- * @\\\\@ - backslash -- -- * @\\\"@ - quotes -- -- * @\\u@/xxxx/ - Unicode character, encoded as four -- hexadecimal digits -- -- * @\\u@/xxxx/@\\u@/xxxx/ - Unicode character (as two -- UTF-16 surrogates) | Number Rational -- ^ Integer. | List [Value] -- ^ Heterogeneous list. Represented in a configuration -- file as an opening square bracket \"@[@\", followed by a -- comma-separated series of values, ending with a closing -- square bracket \"@]@\". deriving (Eq, Show, Typeable, Data) -- | An interpolation directive. data Interpolate = Literal Text | Interpolate Text deriving (Eq, Show)