yam-config 0.3.1 → 0.3.2

raw patch · 3 files changed

+87/−8 lines, 3 filesdep +data-defaultdep +randomdep +vault

Dependencies added: data-default, random, vault

Files

• src/Yam/Config.hs +17/−6
• src/Yam/Config/Vault.hs +64/−0
• yam-config.cabal +6/−2

@@ -4,6 +4,7 @@   , defaultConfig   ) where +import           Control.Exception       (catch, throw) import           Data.Aeson import           Data.Foldable           (foldl') import qualified Data.HashMap.Strict     as H@@ -14,10 +15,15 @@ import           Data.Yaml import           System.Environment +type Required = Bool+ class Config c where   fetch   :: Text -> c -> Either String c   merge   :: [c] -> c   from    ::  (String, String)  -> c+  merge'  :: [IO c] -> IO c+  merge' c' = merge <$> sequence c'+  fromFile :: FilePath -> Required -> IO c   fromEnv :: [(String, String)] -> c   fromEnv = merge . fmap from   fromCommandLine :: [String]   -> c@@ -25,7 +31,7 @@     where       select (k, '=':vs) = (k,vs)       select v           = v-  {-# MINIMAL fetch,merge,from #-}+  {-# MINIMAL fetch,merge,from,fromFile #-}  keys :: Text -> Text -> [Text] keys sep = dropWhile T.null . splitOn sep@@ -34,7 +40,7 @@ defaultConfig = do   args <- getArgs   envs <- getEnvironment-  return $ merge $ [fromCommandLine args, fromEnv envs]+  return $ merge [fromCommandLine args, fromEnv envs]  instance Config Value where   fetch key = go key (keys "." key)@@ -44,11 +50,16 @@         Nothing -> Left $ "Key " <> T.unpack k' <> " Not Found"         Just v  -> go k' ks v       go k' _              _  = Left $ "Key " <> T.unpack k' <> " Not Match"-  merge = foldl' merge' Null+  merge = foldl' merge2 Null     where-      merge' Null    a             = a-      merge' (Object a) (Object b) = Object (H.unionWith merge' a b)-      merge' a       _             = a+      merge2 Null    a             = a+      merge2 (Object a) (Object b) = Object (H.unionWith merge2 a b)+      merge2 a       _             = a+  fromFile f required = (decodeFileEither f >>= either throw return) `catch` go required+    where+      go :: Required -> ParseException -> IO Value+      go False (InvalidYaml (Just (YamlException _))) = return Null+      go _     e                                      = throw e   from (k,v) = case Data.Yaml.decode $ cs v of     Nothing -> Null     Just a  -> go' (keys "_" $ T.toLower $ T.pack k) a

@@ -0,0 +1,64 @@+module Yam.Config.Vault where++import           Yam.Config++import           Data.Default+import           Data.Maybe      (fromMaybe)+import           Data.Monoid+import           Data.Text       (Text, justifyRight, pack)+import           Data.Vault.Lazy+import           Data.Word+import           Numeric         (showHex)+import           System.Random++newtype Box a = Box (Maybe (Key a), Vault)++instance Config (Box a) where+  fetch _ = Right+  merge = foldl1 $ \(Box (k, v)) (Box (_, v2)) -> Box (k, v `union` v2)+  fromFile _ _ = error "Unsupported"+  from _ = error "Unsupported"++instance (Monad m) => HasValue m (Box v) v where+  parse (Box (Just k, v)) = return $ case Data.Vault.Lazy.lookup k v of+    Just  a -> Right a+    Nothing -> Left  "Value Not Found"+  parse _ = return $ Left "Key Not Exists"++instance Default (Box a) where+  def = Box (Nothing, empty)++newBox :: Key a -> Vault -> Box a+newBox k vault = Box (Just k, vault)++emptyBox :: IO (Box a)+emptyBox = do+  k <- newKey+  return $ Box (Just k, empty)++toBox :: Box a -> Box b -> Box a+toBox (Box (k, _)) (Box (_, v)) = Box (k,v)++extracBox :: Box a -> Maybe a+extracBox (Box (Just k, v)) = Data.Vault.Lazy.lookup k v+extracBox _                 = Nothing++extracBoxOrDefault :: a -> Box a -> a+extracBoxOrDefault d b = fromMaybe d $ extracBox b++randomString :: IO Text+randomString = do+  c <- randomIO :: IO Word64+  return $ justifyRight 16 '0' $ pack $ showHex c ""++addFirstVault :: (Monoid a, Eq a) => a -> a -> Key a -> Vault -> Vault+addFirstVault prefix sep k v = insert k (go prefix sep (extracBox $ newBox k v)) v+  where+    go p s (Just n) = if n == mempty then p else p <> s <> n+    go p _ _        = p++addLastVault :: (Monoid a, Eq a) => a -> a -> Key a -> Vault -> Vault+addLastVault prefix sep k v = insert k (go prefix sep (extracBox $ newBox k v)) v+  where+    go p s (Just n) = if n == mempty then p else n <> s <> p+    go p _ _        = p

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2978e60c94262fbb73adec86c8ec4866a254254ca9ea4efe720c6adbd9835cc9+-- hash: 07e61434203150694307355b1fbe2416b9fc6dd94222ad72f329a68d1e444767  name:           yam-config-version:        0.3.1+version:        0.3.2 synopsis:       Yam Configuation description:    Configuation Loader Module for yam category:       Project@@ -25,6 +25,7 @@ library   exposed-modules:       Yam.Config+      Yam.Config.Vault   other-modules:       Paths_yam_config   hs-source-dirs:@@ -34,8 +35,11 @@   build-depends:       aeson     , base >=4.7 && <5+    , data-default+    , random     , string-conversions     , text     , unordered-containers+    , vault     , yaml   default-language: Haskell2010