configurator 0.2.0.2 → 0.3.0.0
raw patch · 10 files changed
+171/−38 lines, 10 filesdep +HUnitdep +configuratordep +filepathdep ~basedep ~textPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, configurator, filepath, test-framework, test-framework-hunit
Dependency ranges changed: base, text
API changes (from Hackage documentation)
- Data.Configurator.Types: class Configured a
+ Data.Configurator.Types: class Configured a where convertList (List xs) = mapM convert xs convertList _ = Nothing
Files
- Data/Configurator.hs +16/−6
- Data/Configurator/Instances.hs +5/−2
- Data/Configurator/Types.hs +1/−1
- Data/Configurator/Types/Internal.hs +7/−0
- configurator.cabal +23/−4
- tests/Setup.hs +0/−2
- tests/Test.hs +56/−23
- tests/resources/import.cfg +4/−0
- tests/resources/interp.cfg +20/−0
- tests/resources/pathological.cfg +39/−0
Data/Configurator.hs view
@@ -63,11 +63,12 @@ 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 @@ 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 @@ 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 @@ 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)
Data/Configurator/Instances.hs view
@@ -91,8 +91,11 @@ convert (String v) = Just v convert _ = Nothing -instance Configured [Char] where- convert = fmap T.unpack . convert+instance Configured Char where+ convert (String txt) | T.length txt == 1 = Just $ T.head txt+ convert _ = Nothing++ convertList = fmap T.unpack . convert instance Configured L.Text where convert = fmap L.fromStrict . convert
Data/Configurator/Types.hs view
@@ -14,7 +14,7 @@ , Config , Name , Value(..)- , Configured(..)+ , Configured, convert , Worth(..) -- * Exceptions , ConfigError(..)
Data/Configurator/Types/Internal.hs view
@@ -131,6 +131,13 @@ class Configured a where convert :: Value -> Maybe a + convertList :: Value -> Maybe [a]+ convertList (List xs) = mapM convert xs+ convertList _ = Nothing++instance Configured a => Configured [a] where+ convert = convertList+ -- | An error occurred while processing a configuration file. data ConfigError = ParseError FilePath String deriving (Show, Typeable)
configurator.cabal view
@@ -1,13 +1,14 @@ name: configurator-version: 0.2.0.2+version: 0.3.0.0 license: BSD3 license-file: LICENSE category: Configuration, Data copyright: Copyright 2011 MailRank, Inc.+ Copyright 2011-2014 Bryan O'Sullivan author: Bryan O'Sullivan <bos@serpentine.com> maintainer: Bryan O'Sullivan <bos@serpentine.com> stability: experimental-tested-with: GHC == 7.0.3+tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8 synopsis: Configuration management cabal-version: >= 1.8 homepage: http://github.com/bos/configurator@@ -38,11 +39,13 @@ extra-source-files: README.markdown- tests/*.hs +data-files: tests/resources/*.cfg+ flag developer description: operate in developer mode default: False+ manual: True library exposed-modules:@@ -62,7 +65,7 @@ hashable, text >= 0.11.1.0, unix-compat,- unordered-containers + unordered-containers if flag(developer) ghc-options: -Werror@@ -77,3 +80,19 @@ source-repository head type: mercurial location: http://bitbucket.org/bos/configurator++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Test.hs+ hs-source-dirs: tests+ build-depends:+ HUnit,+ base,+ bytestring,+ configurator,+ directory,+ filepath,+ test-framework,+ test-framework-hunit,+ text+ ghc-options: -Wall -fno-warn-unused-do-bind
− tests/Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
tests/Test.hs view
@@ -18,32 +18,36 @@ import Data.Word import System.Directory import System.Environment+import System.FilePath import System.IO-import Test.HUnit+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test) main :: IO ()-main = runTestTT tests >> return ()+main = defaultMain tests -tests :: Test-tests = TestList [- "load" ~: loadTest,- "types" ~: typesTest,- "interp" ~: interpTest,- "import" ~: importTest,- "reload" ~: reloadTest+tests :: [Test]+tests =+ [ testCase "load" loadTest+ , testCase "types" typesTest+ , testCase "interp" interpTest+ , testCase "scoped-interp" scopedInterpTest+ , testCase "import" importTest+ , testCase "reload" reloadTest ] -withLoad :: [Worth FilePath] -> (Config -> IO ()) -> IO ()-withLoad files t = do- mb <- try $ load files+withLoad :: FilePath -> (Config -> IO ()) -> IO ()+withLoad name t = do+ mb <- try $ load (testFile name) case mb of Left (err :: SomeException) -> assertFailure (show err) Right cfg -> t cfg -withReload :: [Worth FilePath] -> ([Maybe FilePath] -> Config -> IO ()) -> IO ()-withReload files t = do+withReload :: FilePath -> ([Maybe FilePath] -> Config -> IO ()) -> IO ()+withReload name t = do tmp <- getTemporaryDirectory- temps <- forM files $ \f -> do+ temps <- forM (testFile name) $ \f -> do exists <- doesFileExist (worth f) if exists then do@@ -59,6 +63,9 @@ Left (err :: SomeException) -> assertFailure (show err) Right (cfg, tid) -> t (map snd temps) cfg >> killThread tid +testFile :: FilePath -> [Worth FilePath]+testFile name = [Required $ "tests" </> "resources" </> name]+ takeMVarTimeout :: Int -> MVar a -> IO (Maybe a) takeMVarTimeout millis v = do w <- newEmptyMVar@@ -72,7 +79,8 @@ takeMVar w loadTest :: Assertion-loadTest = withLoad [Required "resources/pathological.cfg"] $ \cfg -> do+loadTest =+ withLoad "pathological.cfg" $ \cfg -> do aa <- lookup cfg "aa" assertEqual "int property" aa $ (Just 1 :: Maybe Int) @@ -98,7 +106,8 @@ assertEqual "deep bool" deep (Just False :: Maybe Bool) typesTest :: Assertion-typesTest = withLoad [Required "resources/pathological.cfg"] $ \ cfg -> do+typesTest =+ withLoad "pathological.cfg" $ \cfg -> do asInt <- lookup cfg "aa" :: IO (Maybe Int) assertEqual "int" asInt (Just 1) @@ -133,26 +142,51 @@ assertEqual "word64" asWord64 (Just 1) asTextBad <- lookup cfg "aa" :: IO (Maybe Text)- assertEqual "word64" asTextBad Nothing+ assertEqual "bad text" asTextBad Nothing asTextGood <- lookup cfg "ab" :: IO (Maybe Text)- assertEqual "word64" asTextGood (Just "foo")+ assertEqual "good text" asTextGood (Just "foo") + asStringGood <- lookup cfg "ab" :: IO (Maybe String)+ assertEqual "string" asStringGood (Just "foo")++ asInts <- lookup cfg "xs" :: IO (Maybe [Int])+ assertEqual "ints" asInts (Just [1,2,3])++ asChar <- lookup cfg "c" :: IO (Maybe Char)+ assertEqual "char" asChar (Just 'x')+ interpTest :: Assertion-interpTest = withLoad [Required "resources/pathological.cfg"] $ \ cfg -> do+interpTest =+ withLoad "pathological.cfg" $ \cfg -> do home <- getEnv "HOME" cfgHome <- lookup cfg "ba" assertEqual "home interp" (Just home) cfgHome +scopedInterpTest :: Assertion+scopedInterpTest = withLoad "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 = withLoad [Required "resources/import.cfg"] $ \ cfg -> do+importTest =+ withLoad "import.cfg" $ \cfg -> do aa <- lookup cfg "x.aa" :: IO (Maybe Int) assertEqual "simple" aa (Just 1) acx <- lookup cfg "x.ac.x" :: IO (Maybe Int) assertEqual "nested" acx (Just 1) reloadTest :: Assertion-reloadTest = withReload [Required "resources/pathological.cfg"] $ \[Just f] cfg -> do+reloadTest =+ withReload "pathological.cfg" $ \[Just f] cfg -> do aa <- lookup cfg "aa" assertEqual "simple property 1" aa $ Just (1 :: Int) @@ -165,4 +199,3 @@ assertEqual "notify happened" r1 (Just ()) r2 <- takeMVarTimeout 2000 wongly assertEqual "notify not happened" r2 Nothing-
+ tests/resources/import.cfg view
@@ -0,0 +1,4 @@+x {+ import "pathological.cfg"+}+
+ tests/resources/interp.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"+ }+ }+}
+ tests/resources/pathological.cfg view
@@ -0,0 +1,39 @@+# Comment++aa # Comment+= # Comment+ 1 # Comment++ab =+"foo"+++ac {+ # fnord+ x=1++ y=true++ #blorg+}++ad = false+ae = 1+af+=+[+2+#foo+,+#bar+3+#baz+]#quux++ag { q-e { i_u9 { a=false}}}++ba = "$(HOME)"++xs = [1,2,3]++c = "x"