yam-config (empty) → 0.3.0

raw patch · 4 files changed

+126/−0 lines, 4 filesdep +aesondep +basedep +string-conversionssetup-changed

Dependencies added: aeson, base, string-conversions, text, unordered-containers, yaml

Files

• README.md +1/−0
• Setup.hs +2/−0
• src/Yam/Config.hs +82/−0
• yam-config.cabal +41/−0

@@ -0,0 +1,1 @@+# yam-config

@@ -0,0 +1,2 @@+import           Distribution.Simple+main = defaultMain

@@ -0,0 +1,82 @@+module Yam.Config(+    Config(..)+  , HasValue(..)+  , defaultConfig+  ) where++import           Data.Aeson+import           Data.Foldable           (foldl')+import qualified Data.HashMap.Strict     as H+import           Data.Monoid             ((<>))+import           Data.String.Conversions (cs)+import           Data.Text               (Text, splitOn)+import qualified Data.Text               as T+import           Data.Yaml+import           System.Environment++class Config c where+  fetch   :: Text -> c -> Either String c+  merge   :: [c] -> c+  from    ::  (String, String)  -> c+  fromEnv :: [(String, String)] -> c+  fromEnv = merge . fmap from+  fromCommandLine :: [String]   -> c+  fromCommandLine = merge . fmap (from . select . break (=='='))+    where+      select (k, '=':vs) = (k,vs)+      select v           = v+  {-# MINIMAL fetch,merge,from #-}++keys :: Text -> Text -> [Text]+keys sep = dropWhile T.null . splitOn sep++defaultConfig :: Config c => IO c+defaultConfig = do+  args <- getArgs+  envs <- getEnvironment+  return $ merge $ [fromCommandLine args, fromEnv envs]++instance Config Value where+  fetch key = go key (keys "." key)+    where+      go _  []             c  = Right c+      go k' (k:ks) (Object c) = case H.lookup k c of+        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+    where+      merge' Null    a             = a+      merge' (Object a) (Object b) = Object (H.unionWith merge' a b)+      merge' a       _             = a+  from (k,v) = case Data.Yaml.decode $ cs v of+    Nothing -> Null+    Just a  -> go' (keys "_" $ T.toLower $ T.pack k) a+    where+      go' []      v' = v'+      go' (k':ks) v' = Object $ H.insert k' (go' ks v') H.empty++class (Monad m, Config c) => HasValue m c v where+  parse :: c -> m (Either String v)+  getValue :: Text -> c -> m (Either String v)+  getValue k c = case fetch k c of+    Left  e -> return $ Left e+    Right v -> parse v+  getValueOrDef :: v -> Text -> c -> m v+  getValueOrDef v k c = do+    v' <- getValue k c+    case v' of+      Left  _ -> return v+      Right w -> return w+  requireValue :: Text -> c -> m v+  requireValue k c = do+    v' <- getValue k c+    case v' of+      Left  e -> fail e+      Right v -> return v+  {-# MINIMAL parse #-}++instance (Monad m, FromJSON v) => HasValue m Value v where+  parse c = return $ case fromJSON c of+    Success a -> Right a+    Error   e -> Left  e

@@ -0,0 +1,41 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1317aedb85a26cf3517a174461424b08991c72fd6574b9c18ed184e30392ad60++name:           yam-config+version:        0.3.0+synopsis:       Yam Configuation+description:    Configuation Loader Module for yam+category:       Project+homepage:       https://github.com/leptonyu/yam#readme+bug-reports:    https://github.com/leptonyu/yam/issues+maintainer:     Daniel YU <leptonyu@gmail.com>+license:        MIT+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/leptonyu/yam++library+  exposed-modules:+      Yam.Config+  other-modules:+      Paths_yam_config+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DuplicateRecordFields DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans+  build-depends:+      aeson+    , base >=4.7 && <5+    , string-conversions+    , text+    , unordered-containers+    , yaml+  default-language: Haskell2010