configurator 0.0.0.1 → 0.0.1.1
raw patch · 5 files changed
+131/−35 lines, 5 filesdep ~attoparsec-text
Dependency ranges changed: attoparsec-text
Files
- Data/Configurator.hs +58/−22
- Data/Configurator/Instances.hs +37/−6
- Data/Configurator/Types.hs +4/−0
- Data/Configurator/Types/Internal.hs +30/−5
- configurator.cabal +2/−2
Data/Configurator.hs view
@@ -32,12 +32,16 @@ -- ** Importing files -- $import + -- * Types+ Worth(..) -- * Loading configuration data- autoReload+ , autoReload , autoConfig+ , empty -- * Lookup functions , lookup , lookupDefault+ , require -- * Notification of configuration changes -- $notify , prefix@@ -66,6 +70,7 @@ import Prelude hiding (catch, lookup) import System.Environment (getEnv) import System.IO (hPutStrLn, stderr)+import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (EpochTime, FileOffset) import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime) import qualified Data.Attoparsec.Text as T@@ -75,11 +80,14 @@ import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.IO as L -loadFiles :: [Path] -> IO (H.HashMap Path [Directive])+loadFiles :: [Worth Path] -> IO (H.HashMap (Worth Path) [Directive]) loadFiles = foldM go H.empty where go seen path = do- ds <- loadOne . T.unpack =<< interpolate path H.empty+ let rewrap n = const n <$> path+ wpath = worth path+ path' <- rewrap <$> interpolate wpath H.empty+ ds <- loadOne (T.unpack <$> path') let !seen' = H.insert path ds seen notSeen n = not . isJust . H.lookup n $ seen foldM go seen' . filter notSeen . importsOf $ ds@@ -90,12 +98,12 @@ -- File names have any environment variables expanded prior to the -- first time they are opened, so you can specify a file name such as -- @\"$(HOME)/myapp.cfg\"@.-load :: [FilePath] -> IO Config+load :: [Worth FilePath] -> IO Config load = load' Nothing -load' :: Maybe AutoConfig -> [FilePath] -> IO Config+load' :: Maybe AutoConfig -> [Worth FilePath] -> IO Config load' auto paths0 = do- let paths = map T.pack paths0+ let paths = map (fmap T.pack) paths0 ds <- loadFiles paths m <- newIORef =<< flatten paths ds s <- newIORef H.empty@@ -140,7 +148,7 @@ autoReload :: AutoConfig -- ^ Directions for when to reload and how to handle -- errors.- -> [FilePath]+ -> [Worth FilePath] -- ^ Configuration files to load. -> IO (Config, ThreadId) autoReload AutoConfig{..} _@@ -162,10 +170,10 @@ -- filesystem with timestamp resolution of 1 second or worse. type Meta = (FileOffset, EpochTime) -getMeta :: [FilePath] -> IO [Maybe Meta]+getMeta :: [Worth FilePath] -> IO [Maybe Meta] getMeta paths = forM paths $ \path -> handle (\(_::SomeException) -> return Nothing) . fmap Just $ do- st <- getFileStatus path+ st <- getFileStatus (worth path) return (fileSize st, modificationTime st) -- | Look up a name in the given 'Config'. If a binding exists, and@@ -176,6 +184,16 @@ (join . fmap convert . H.lookup name) <$> readIORef cfgMap -- | Look up a name in the given 'Config'. If a binding exists, and+-- the value can be 'convert'ed to the desired type, return the+-- converted value, otherwise throw a 'KeyError'.+require :: Configured a => Config -> Name -> IO a+require Config{..} name = do+ val <- (join . fmap convert . H.lookup name) <$> readIORef cfgMap+ case val of+ Just v -> return v+ _ -> throwIO . KeyError $ name++-- | Look up a name in the given 'Config'. If a binding exists, and -- the value can be converted to the desired type, return it, -- otherwise return the default value. lookupDefault :: Configured a =>@@ -193,7 +211,7 @@ getMap :: Config -> IO (H.HashMap Name Value) getMap = readIORef . cfgMap -flatten :: [Path] -> H.HashMap Path [Directive] -> IO (H.HashMap Name Value)+flatten :: [Worth Path] -> H.HashMap (Worth Path) [Directive] -> IO (H.HashMap Name Value) flatten roots files = foldM (directive "") H.empty . concat . catMaybes . map (`H.lookup` files) $ roots where@@ -205,7 +223,7 @@ directive pfx m (Group name xs) = foldM (directive pfx') m xs where pfx' = T.concat [pfx, name, "."] directive pfx m (Import path) =- case H.lookup path files of+ case H.lookup (Required path) files of Just ds -> foldM (directive pfx) m ds _ -> return m @@ -230,22 +248,27 @@ throwIO . ParseError "" $ "no such variable " ++ show name Right x -> return (fromString x) -importsOf :: [Directive] -> [Path]-importsOf (Import path : xs) = path : importsOf xs+importsOf :: [Directive] -> [Worth Path]+importsOf (Import path : xs) = Required path : importsOf xs importsOf (Group _ ys : xs) = importsOf ys ++ importsOf xs importsOf (_ : xs) = importsOf xs importsOf _ = [] -loadOne :: FilePath -> IO [Directive]+loadOne :: Worth FilePath -> IO [Directive] loadOne path = do- s <- L.readFile path- p <- evaluate (L.eitherResult $ L.parse topLevel s)- `catch` \(e::ConfigError) ->- throwIO $ case e of- ParseError _ err -> ParseError path err- case p of- Left err -> throwIO (ParseError path err)- Right ds -> return ds+ es <- try . L.readFile . worth $ path+ case es of+ Left (err::SomeException) -> case path of+ Required _ -> throwIO err+ _ -> return []+ Right s -> do+ p <- evaluate (L.eitherResult $ L.parse topLevel s)+ `catch` \(e::ConfigError) ->+ throwIO $ case e of+ ParseError _ err -> ParseError (worth path) err+ case p of+ Left err -> throwIO (ParseError (worth path) err)+ Right ds -> return ds -- | Subscribe for notifications. The given action will be invoked -- when any change occurs to a configuration property matching the@@ -280,6 +303,19 @@ let matching = filter (T.isPrefixOf n . fst) forM_ (matching new) $ \(n',v) -> mapM_ (notify p n' (Just v)) acts forM_ (matching changedOrGone) $ \(n',v) -> mapM_ (notify p n' v) acts++-- | A completely empty configuration.+empty :: Config+empty = unsafePerformIO $ do+ m <- newIORef H.empty+ s <- newIORef H.empty+ return Config {+ cfgAuto = Nothing+ , cfgPaths = []+ , cfgMap = m+ , cfgSubs = s+ }+{-# NOINLINE empty #-} -- $format --
Data/Configurator/Instances.hs view
@@ -5,7 +5,9 @@ import Control.Applicative import Data.Configurator.Types.Internal+import Data.Int (Int8, Int16, Int32, Int64) import Data.Text.Encoding (encodeUtf8)+import Data.Word (Word, Word8, Word16, Word32, Word64) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T@@ -18,10 +20,43 @@ convert (Bool v) = Just v convert _ = Nothing +convertNumber :: (Num a) => Value -> Maybe a+convertNumber (Number v) = Just (fromIntegral v)+convertNumber _ = Nothing+ instance Configured Int where- convert (Number v) = Just v- convert _ = Nothing+ convert = convertNumber +instance Configured Integer where+ convert = convertNumber++instance Configured Int8 where+ convert = convertNumber++instance Configured Int16 where+ convert = convertNumber++instance Configured Int32 where+ convert = convertNumber++instance Configured Int64 where+ convert = convertNumber++instance Configured Word where+ convert = convertNumber++instance Configured Word8 where+ convert = convertNumber++instance Configured Word16 where+ convert = convertNumber++instance Configured Word32 where+ convert = convertNumber++instance Configured Word64 where+ convert = convertNumber+ instance Configured T.Text where convert (String v) = Just v convert _ = Nothing@@ -37,10 +72,6 @@ instance Configured LB.ByteString where convert = fmap (LB.fromChunks . (:[])) . convert--instance (Configured a) => Configured [a] where- convert (List xs) = mapM convert xs- convert _ = Nothing instance (Configured a, Configured b) => Configured (a,b) where convert (List [a,b]) = (,) <$> convert a <*> convert b
Data/Configurator/Types.hs view
@@ -15,6 +15,10 @@ , Name , Value(..) , Configured(..)+ , Worth(..)+ -- * Exceptions+ , ConfigError(..)+ , KeyError(..) -- * Notification of configuration changes , Pattern , ChangeHandler
Data/Configurator/Types/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-} -- | -- Module: Data.Configurator.Types.Internal@@ -15,12 +15,14 @@ Config(..) , Configured(..) , AutoConfig(..)+ , Worth(..) , Name , Value(..) , Binding , Path , Directive(..) , ConfigError(..)+ , KeyError(..) , Interpolate(..) , Pattern(..) , exact@@ -40,15 +42,32 @@ 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+ hash = hash . worth+ -- | Configuration data. data Config = Config { cfgAuto :: Maybe AutoConfig- , cfgPaths :: [Path]+ , cfgPaths :: [Worth Path] -- ^ The files from which the 'Config' was loaded. , cfgMap :: IORef (H.HashMap Name Value) , cfgSubs :: IORef (H.HashMap Pattern [ChangeHandler]) } +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'@@ -111,6 +130,14 @@ 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@@ -129,8 +156,6 @@ instance Show AutoConfig where show c = "AutoConfig {interval = " ++ show (interval c) ++ "}" -instance Exception ConfigError- -- | The name of a 'Config' value. type Name = Text @@ -171,7 +196,7 @@ -- -- * @\\u@/xxxx/@\\u@/xxxx/ - Unicode character (as two -- UTF-16 surrogates)- | Number Int+ | Number Integer -- ^ Integer. | List [Value] -- ^ Heterogeneous list. Represented in a configuration
configurator.cabal view
@@ -1,5 +1,5 @@ name: configurator-version: 0.0.0.1+version: 0.0.1.1 license: BSD3 license-file: LICENSE category: Configuration, Data@@ -55,7 +55,7 @@ Data.Configurator.Types.Internal build-depends:- attoparsec-text >= 0.8.5.0,+ attoparsec-text >= 0.8.5.1, base == 4.*, bytestring, directory,