Permalink
Browse files

Merge

  • Loading branch information...
2 parents 18cf331 + 55c8d28 commit c2610e86a81517e8975a921665e8c43818905c1a @bos committed Jul 2, 2014
Showing with 56 additions and 12 deletions.
  1. +16 −6 Data/Configurator.hs
  2. +20 −6 tests/Test.hs
  3. +20 −0 tests/resources/interp.cfg
View
@@ -63,11 +63,12 @@ module Data.Configurator
import Control.Applicative ((<$>))
import Control.Concurrent (ThreadId, forkIO, threadDelay)
import Control.Exception (SomeException, evaluate, handle, throwIO, try)
-import Control.Monad (foldM, forM, forM_, join, when)
+import Control.Monad (foldM, forM, forM_, join, when, msum)
import Data.Configurator.Instances ()
import Data.Configurator.Parser (interp, topLevel)
import Data.Configurator.Types.Internal
import Data.IORef (atomicModifyIORef, newIORef, readIORef)
+import Data.List (tails)
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid (mconcat)
import Data.Ratio (denominator, numerator)
@@ -94,7 +95,7 @@ loadFiles = foldM go H.empty
go seen path = do
let rewrap n = const n <$> path
wpath = worth path
- path' <- rewrap <$> interpolate wpath H.empty
+ 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
@@ -270,7 +271,7 @@ flatten roots files = foldM doPath H.empty roots
Just ds -> foldM (directive pfx (worth f)) m ds
directive pfx _ m (Bind name (String value)) = do
- v <- interpolate value m
+ v <- interpolate pfx value m
return $! H.insert (T.append pfx name) (String v) m
directive pfx _ m (Bind name value) =
return $! H.insert (T.append pfx name) value m
@@ -282,17 +283,26 @@ flatten roots files = foldM doPath H.empty roots
Just ds -> foldM (directive pfx f') m ds
_ -> return m
-interpolate :: T.Text -> H.HashMap Name Value -> IO T.Text
-interpolate s env
+interpolate :: T.Text -> T.Text -> H.HashMap Name Value -> IO T.Text
+interpolate pfx s env
| "$" `T.isInfixOf` s =
case T.parseOnly interp s of
Left err -> throwIO $ ParseError "" err
Right xs -> (L.toStrict . toLazyText . mconcat) <$> mapM interpret xs
| otherwise = return s
where
+ lookupEnv name = msum $ map (flip H.lookup env) fullnames
+ where fullnames = map (T.intercalate ".") -- ["a.b.c.x","a.b.x","a.x","x"]
+ . map (reverse . (name:)) -- [["a","b","c","x"],["a","b","x"],["a","x"],["x"]]
+ . tails -- [["c","b","a"],["b","a"],["a"],[]]
+ . reverse -- ["c","b","a"]
+ . filter (not . T.null) -- ["a","b","c"]
+ . T.split (=='.') -- ["a","b","c",""]
+ $ pfx -- "a.b.c."
+
interpret (Literal x) = return (fromText x)
interpret (Interpolate name) =
- case H.lookup name env of
+ case lookupEnv name of
Just (String x) -> return (fromText x)
Just (Number r)
| denominator r == 1 -> return (decimal $ numerator r)
View
@@ -26,12 +26,13 @@ main :: IO ()
main = runTestTT tests >> return ()
tests :: Test
-tests = TestList [
- "load" ~: loadTest,
- "types" ~: typesTest,
- "interp" ~: interpTest,
- "import" ~: importTest,
- "reload" ~: reloadTest
+tests = TestList
+ [ "load" ~: loadTest
+ , "types" ~: typesTest
+ , "interp" ~: interpTest
+ , "scoped-interp" ~: scopedInterpTest
+ , "import" ~: importTest
+ , "reload" ~: reloadTest
]
withLoad :: [Worth FilePath] -> (Config -> IO ()) -> IO ()
@@ -160,6 +161,19 @@ interpTest = do
cfgHome <- lookup cfg "ba"
assertEqual "home interp" (Just home) cfgHome
+scopedInterpTest :: Assertion
+scopedInterpTest = withLoad [Required "resources/interp.cfg"] $ \ cfg -> do
+ home <- getEnv "HOME"
+
+ lookup cfg "myprogram.exec"
+ >>= assertEqual "myprogram.exec" (Just $ home++"/services/myprogram/myprogram")
+
+ lookup cfg "myprogram.stdout"
+ >>= assertEqual "myprogram.stdout" (Just $ home++"/services/myprogram/stdout")
+
+ lookup cfg "top.layer1.layer2.dir"
+ >>= assertEqual "nested scope" (Just $ home++"/top/layer1/layer2")
+
importTest :: Assertion
importTest = do
fp <- getDataFileName "tests/resources/import.cfg"
View
@@ -0,0 +1,20 @@
+services = "$(HOME)/services"
+root = "can be overwritten by inner block."
+myprogram {
+ name = "myprogram"
+ root = "$(services)/$(name)"
+ exec = "$(root)/$(name)"
+ stdout = "$(root)/stdout"
+ stderr = "$(root)/stderr"
+ delay = 1
+}
+dir = "$(HOME)"
+top {
+ dir = "$(dir)/top"
+ layer1 {
+ dir = "$(dir)/layer1"
+ layer2 {
+ dir = "$(dir)/layer2"
+ }
+ }
+}

0 comments on commit c2610e8

Please sign in to comment.