Commits

Bryan O'Sullivan committed 27165fc

Perform string interpolation at load time.

Comments (0)

Files changed (2)

 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)
 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
 -- | 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'
 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)
         _ -> 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]

Data/Configurator/Types/Internal.hs

     , Path
     , Directive(..)
     , ConfigError(..)
-    , Interp(..)
+    , Interpolate(..)
     ) where
 
 import Control.Exception
     }
 
 -- | 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
 
 -- | 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]
 
 -- | 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)