Skip to content

Commit

Permalink
Perform string interpolation at load time.
Browse files Browse the repository at this point in the history
  • Loading branch information
bos committed May 31, 2011
1 parent e2a0184 commit 82e3da6
Show file tree
Hide file tree
Showing 2 changed files with 52 additions and 20 deletions.
31 changes: 18 additions & 13 deletions Data/Configurator.hs
Expand Up @@ -34,7 +34,6 @@ import Data.Configurator.Instances ()
import Data.Configurator.Parser (interp, topLevel)
import Data.Configurator.Types.Internal
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (foldl')
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Monoid (mconcat)
import Data.Text.Lazy.Builder (fromString, fromText, toLazyText)
Expand Down Expand Up @@ -65,7 +64,7 @@ load :: [FilePath] -> IO Config
load paths0 = do
let paths = map T.pack paths0
ds <- loadFiles paths
m <- newIORef $ flatten paths ds
m <- newIORef =<< flatten paths ds
return Config {
cfgPaths = paths
, cfgMap = m
Expand All @@ -74,7 +73,8 @@ load paths0 = do
-- | Forcibly reload a 'Config'. Throws an exception on error, such as
-- if files no longer exist or contain errors.
reload :: Config -> IO ()
reload Config{..} = writeIORef cfgMap . flatten cfgPaths =<< loadFiles cfgPaths
reload Config{..} =
writeIORef cfgMap =<< flatten cfgPaths =<< loadFiles cfgPaths

-- | Defaults for automatic 'Config' reloading when using
-- 'autoReload'. The 'interval' is one second, while the 'onError'
Expand Down Expand Up @@ -132,36 +132,41 @@ display Config{..} = print =<< readIORef cfgMap
getMap :: Config -> IO (H.HashMap Name Value)
getMap = readIORef . cfgMap

flatten :: [Path] -> H.HashMap Path [Directive] -> H.HashMap Name Value
flatten roots files = foldl' (directive "") H.empty .
flatten :: [Path] -> H.HashMap Path [Directive] -> IO (H.HashMap Name Value)
flatten roots files = foldM (directive "") H.empty .
concat . catMaybes . map (`H.lookup` files) $ roots
where
directive prefix m (Bind name value) = H.insert (T.append prefix name) value m
directive prefix m (Group name xs) = foldl' (directive prefix') m xs
where prefix' = T.concat [prefix, name, "."]
directive prefix m (Bind name (String value)) = do
v <- interpolate value m
return $! H.insert (T.append prefix name) (String v) m
directive prefix m (Bind name value) =
return $! H.insert (T.append prefix name) value m
directive prefix m (Group name xs) = foldM (directive prefix') m xs
where prefix' = T.concat [prefix, name, "."]
directive prefix m (Import path) =
case H.lookup path files of
Just ds -> foldl' (directive prefix) m ds
_ -> m
Just ds -> foldM (directive prefix) m ds
_ -> return m

interpolate :: T.Text -> H.HashMap Name Value -> IO T.Text
interpolate s env
| "$(" `T.isInfixOf` s =
case T.parseOnly interp s of
Left _ -> undefined
Left err -> throwIO $ ParseError "" err
Right xs -> (L.toStrict . toLazyText . mconcat) <$> mapM interpret xs
| otherwise = return s
where
interpret (Literal x) = return (fromText x)
interpret (Interp name) =
interpret (Interpolate name) =
case H.lookup name env of
Just (String x) -> return (fromText x)
Just (Number n) -> return (decimal n)
Just _ -> error "type error"
_ -> do
e <- try . getEnv . T.unpack $ name
case e of
Left (_::SomeException) -> error "no such variable"
Left (_::SomeException) ->
throwIO . ParseError "" $ "no such variable " ++ show name
Right x -> return (fromString x)

importsOf :: [Directive] -> [Path]
Expand Down
41 changes: 34 additions & 7 deletions Data/Configurator/Types/Internal.hs
Expand Up @@ -21,7 +21,7 @@ module Data.Configurator.Types.Internal
, Path
, Directive(..)
, ConfigError(..)
, Interp(..)
, Interpolate(..)
) where

import Control.Exception
Expand All @@ -40,8 +40,11 @@ data Config = Config {
}

-- | This class represents types that can be automatically and safely
-- converted from a 'Value'. If conversion fails, 'Nothing' is
-- returned.
-- 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

Expand Down Expand Up @@ -74,20 +77,44 @@ type Path = Text
-- | A name-value binding.
type Binding = (Name,Value)

-- | A directive in a config file.
-- | 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 Int
-- ^ Integer.
| List [Value]
-- ^ Heterogeneous list.
deriving (Eq, Show, Typeable, Data)

-- | An interpolation directive.
data Interp = Literal Text
| Interp Text
deriving (Eq, Show)
data Interpolate = Literal Text
| Interpolate Text
deriving (Eq, Show)

0 comments on commit 82e3da6

Please sign in to comment.