conferer (empty) → 0.1.0.0

raw patch · 22 files changed

+677/−0 lines, 22 filesdep +basedep +bytestringdep +conferer

Dependencies added: base, bytestring, conferer, containers, directory, hspec, text

Files

• LICENSE +30/−0
• conferer.cabal +73/−0
• src/Conferer.hs +33/−0
• src/Conferer/Core.hs +45/−0
• src/Conferer/FetchFromConfig/Basics.hs +49/−0
• src/Conferer/Provider/CLIArgs.hs +29/−0
• src/Conferer/Provider/Env.hs +32/−0
• src/Conferer/Provider/Files.hs +20/−0
• src/Conferer/Provider/Mapping.hs +21/−0
• src/Conferer/Provider/Namespaced.hs +15/−0
• src/Conferer/Provider/Null.hs +11/−0
• src/Conferer/Provider/Simple.hs +18/−0
• src/Conferer/Types.hs +33/−0
• test/Conferer/FetchFromConfig/BasicsSpec.hs +56/−0
• test/Conferer/Provider/ArgsSpec.hs +38/−0
• test/Conferer/Provider/EnvSpec.hs +41/−0
• test/Conferer/Provider/MappingSpec.hs +43/−0
• test/Conferer/Provider/NamespacedSpec.hs +21/−0
• test/Conferer/Provider/NullSpec.hs +13/−0
• test/Conferer/Provider/SimpleSpec.hs +22/−0
• test/ConfererSpec.hs +33/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,30 @@+Copyright Lucas David Traverso (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Lucas David Traverso nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,73 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: eea931123405e74a86b3e1283519e3369618e126404652c3818e55ad1071dad5++name:           conferer+version:        0.1.0.0+synopsis:       Configuration management library ++description:    Library to abstract the parsing of many haskell config values from different config sources+category:       Configuration+homepage:       https://github.com/ludat/conferer#readme+author:         Lucas David Traverso+maintainer:     lucas6246@gmail.com+copyright:      MIT+license:        BSD3+license-file:   LICENSE+build-type:     Simple++library+  exposed-modules:+      Conferer+      Conferer.Core+      Conferer.FetchFromConfig.Basics+      Conferer.Provider.CLIArgs+      Conferer.Provider.Env+      Conferer.Provider.Files+      Conferer.Provider.Mapping+      Conferer.Provider.Namespaced+      Conferer.Provider.Null+      Conferer.Provider.Simple+      Conferer.Types+  other-modules:+      Paths_conferer+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  build-depends:+      base >=4.3 && <5+    , bytestring >=0.10 && <0.11+    , containers >=0.5 && <0.7+    , directory >=1.2 && <2.0+    , text >=1.1 && <1.3+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Conferer.FetchFromConfig.BasicsSpec+      Conferer.Provider.ArgsSpec+      Conferer.Provider.EnvSpec+      Conferer.Provider.MappingSpec+      Conferer.Provider.NamespacedSpec+      Conferer.Provider.NullSpec+      Conferer.Provider.SimpleSpec+      ConfererSpec+      Paths_conferer+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  build-depends:+      base >=4.3 && <5+    , bytestring >=0.10 && <0.11+    , conferer+    , containers >=0.5 && <0.7+    , directory >=1.2 && <2.0+    , hspec+    , text >=1.1 && <1.3+  default-language: Haskell2010

@@ -0,0 +1,33 @@+module Conferer+  ( module Conferer.Core+  , module Conferer.Provider.Env+  , module Conferer.Provider.Simple+  , module Conferer.Provider.Namespaced+  , module Conferer.Provider.Mapping+  , module Conferer.Provider.CLIArgs+  , module Conferer.Provider.Null+  , defaultConfig+  , Key(..)+  , (&)+  ) where++import           Data.Text (Text)+import           Data.Function ((&))++import           Conferer.Core+import           Conferer.Types+import           Conferer.Provider.Env+import           Conferer.Provider.Simple+import           Conferer.Provider.Namespaced+import           Conferer.Provider.Mapping+import           Conferer.Provider.CLIArgs+import           Conferer.Provider.Null++++defaultConfig :: Text -> IO Config+defaultConfig appName = do+  pure emptyConfig+  >>= addProvider (mkCLIArgsProvider)+  >>= addProvider (mkEnvProvider appName)+

@@ -0,0 +1,45 @@+module Conferer.Core where++import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Either (either)++import           Conferer.Types++unsafeGetKey :: Key -> Config -> IO Text+unsafeGetKey k config =+  either (error . Text.unpack) id <$> getKey k config++getFromConfig :: FetchFromConfig a => Key -> Config -> IO a+getFromConfig k config =+  either (error . Text.unpack) id <$> fetch k config++getKey :: Key -> Config -> IO (Either Text Text)+getKey k config =+  go $ providers config+  where+    go [] = return $ Left ("Key '" `Text.append` keyName k `Text.append` "' was not found")+    go (provider:providers) = do+      res <- getKeyInProvider provider k+      case res of+        Just t -> return $ Right t+        Nothing -> go providers++(/.) :: Key -> Key -> Key+parent /. child = Path (unKey parent ++ unKey child)++emptyConfig :: Config+emptyConfig = Config []++mkStandaloneProvider :: ProviderCreator -> IO Provider+mkStandaloneProvider mkProvider =+  mkProvider emptyConfig+++addProvider :: ProviderCreator -> Config -> IO Config+addProvider mkProvider config = do+  newProvider <- mkProvider config+  return $+    Config+    { providers = providers config ++ [ newProvider ]+    }

@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleInstances #-}+module Conferer.FetchFromConfig.Basics where++import           Conferer.Types+import           Conferer.Core (getKey)+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import           Data.ByteString (ByteString)++import           Data.String (IsString, fromString)++import           Text.Read (readMaybe)++instance FetchFromConfig Int where+  fetch = fetchFromConfigByRead++instance FetchFromConfig Float where+  fetch = fetchFromConfigByRead++fetchFromConfigByRead :: Read a => Key -> Config -> IO (Either Text a)+fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)++instance FetchFromConfig ByteString where+  fetch = fetchFromConfigWith (Just . Text.encodeUtf8)++instance FetchFromConfig String where+  fetch = fetchFromConfigWith (Just . Text.unpack)++instance FetchFromConfig Text where+  fetch = fetchFromConfigWith (Just)++instance FetchFromConfig Bool where+    fetch = fetchFromConfigWith parseBool+        where+          parseBool text =+            case Text.toLower text of+              "false" -> Just False+              "true" -> Just True+              _ -> Nothing++fromValueWith :: (Text -> Maybe a) -> Key -> Text -> Either Text a+fromValueWith parseValue key valueAsText = case parseValue valueAsText of+    Just value -> Right value+    Nothing -> Left ("Key " `Text.append` keyName key `Text.append` " could not be parsed correctly")++fetchFromConfigWith :: (Text -> Maybe a) -> Key -> Config -> IO (Either Text a)+fetchFromConfigWith parseValue key config =+  (fromValueWith parseValue key =<<) <$> getKey key config

@@ -0,0 +1,29 @@+module Conferer.Provider.CLIArgs where++import           Data.Text (Text)+import qualified Data.Text as Text+import           Data.Maybe (mapMaybe)+import           Data.String (fromString)+import           System.Environment (getArgs)++import Conferer.Types+import Conferer.Provider.Simple+++mkCLIArgsProvider' :: [String] -> ProviderCreator+mkCLIArgsProvider' args = \config -> do+  let configMap = parseArgsIntoKeyValue args+  mkMapProvider configMap config++mkCLIArgsProvider :: ProviderCreator+mkCLIArgsProvider = \config -> do+  args <- getArgs+  mkCLIArgsProvider' args config++parseArgsIntoKeyValue :: [String] -> [(Key, Text)]+parseArgsIntoKeyValue =+  fmap (\(k, s) -> (fromString $ Text.unpack k, s)) .+  fmap (\s -> fmap (Text.drop 1) $ Text.breakOn "=" s).+  mapMaybe (Text.stripPrefix "--") .+  takeWhile (/= "--") .+  fmap Text.pack

@@ -0,0 +1,32 @@+module Conferer.Provider.Env where++import           Data.Text (Text)+import qualified Data.Text as Text+import qualified System.Environment as System++import           Conferer.Types+++type LookupEnvFunc = (String -> IO (Maybe String))+++keyToEnvVar :: Prefix -> Key -> Text+keyToEnvVar prefix (Path keys) =+  Text.toUpper+  $ Text.intercalate "_"+  $ filter (/= mempty)+  $ prefix : keys+++mkEnvProvider :: Prefix -> ProviderCreator+mkEnvProvider prefix =+  mkEnvProvider' System.lookupEnv prefix++mkEnvProvider' :: LookupEnvFunc -> Prefix -> ProviderCreator+mkEnvProvider' lookupEnv prefix = \_config ->+  return $+  Provider+  { getKeyInProvider = \k -> do+      let envVarName = Text.unpack $ keyToEnvVar prefix k+      fmap Text.pack <$> lookupEnv envVarName+  }

@@ -0,0 +1,20 @@+module Conferer.Provider.Files where++import qualified Data.Text as Text++import           Conferer.Types+import           Conferer.FetchFromConfig.Basics ()++fromRight :: a -> Either e a -> a+fromRight a (Left _) = a+fromRight _ (Right a) = a++getFilePathFromEnv :: Config -> String -> IO FilePath+getFilePathFromEnv config extension = do+  env <- fromRight "dev" <$> fetch "env" config+  return $ mconcat+    [ "config/"+    , Text.unpack env+    , "."+    , extension+    ]

@@ -0,0 +1,21 @@+module Conferer.Provider.Mapping where++import           Data.Map (Map)+import qualified Data.Map as Map++import           Conferer.Types++mkMappingProvider' :: (Key -> Maybe Key) -> ProviderCreator -> ProviderCreator+mkMappingProvider' mapper providerCreator config = do+  configProvider <- providerCreator config++  return $ Provider+    { getKeyInProvider = \k -> do+        case mapper k of+          Just newKey -> getKeyInProvider configProvider newKey+          Nothing -> return Nothing+    }++mkMappingProvider :: Map Key Key -> ProviderCreator -> ProviderCreator+mkMappingProvider configMap configProvider =+  mkMappingProvider' (`Map.lookup` configMap) configProvider

@@ -0,0 +1,15 @@+module Conferer.Provider.Namespaced where++import           Data.List (stripPrefix)++import           Conferer.Types++mkNamespacedProvider :: Key -> ProviderCreator -> ProviderCreator+mkNamespacedProvider (Path key) configCreator = \config -> do+  configProvider <- configCreator config+  return $ Provider+    { getKeyInProvider = \(Path k) -> do+        case stripPrefix key k of+          Just newKey -> getKeyInProvider configProvider (Path newKey)+          Nothing -> return Nothing+    }

@@ -0,0 +1,11 @@+module Conferer.Provider.Null where++import           Conferer.Types++mkNullProvider :: ProviderCreator+mkNullProvider _config =+  return $ Provider+  { getKeyInProvider =+      \_k -> do+        return Nothing+  }

@@ -0,0 +1,18 @@+module Conferer.Provider.Simple where++import           Data.Map (Map)+import qualified Data.Map as Map+import           Data.Text (Text)++import           Conferer.Types++mkMapProvider' :: Map Key Text -> ProviderCreator+mkMapProvider' configMap _config =+  return $ Provider+    { getKeyInProvider =+      \k -> do+        return $ Map.lookup k configMap+    }++mkMapProvider :: [(Key, Text)] -> ProviderCreator+mkMapProvider = mkMapProvider' . Map.fromList

@@ -0,0 +1,33 @@+module Conferer.Types where+++import           Data.String+import           Data.Text (Text)+import qualified Data.Text as Text++data Provider =+  Provider+  { getKeyInProvider :: Key -> IO (Maybe Text)+  }++newtype Key+  = Path { unKey :: [Text] }+  deriving (Show, Eq, Ord)++keyName :: Key -> Text+keyName = Text.intercalate "." . unKey++data Config =+  Config+  { providers :: [Provider]+  }++type ProviderCreator = Config -> IO Provider++class FetchFromConfig a where+  fetch :: Key -> Config -> IO (Either Text a)++instance IsString Key where+  fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s++type Prefix = Text

@@ -0,0 +1,56 @@+module Conferer.FetchFromConfig.BasicsSpec where++import           Test.Hspec+import           Conferer.Types+import           Data.Text+import           Conferer+import           Conferer.FetchFromConfig.Basics ()++configWith :: [(Key, Text)] -> IO Config+configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)++spec :: Spec+spec = do+  describe "fetching an Int from config" $ do+    it "getting a value that can't be parsed as an int returns an error message" $ do+      config <- configWith [ ("anInt", "50A") ]+      fetchedValue <- fetch "anInt" config+      fetchedValue `shouldBe` (Left "Key anInt could not be parsed correctly" :: Either Text Int)+    it "getting a value that can be parsed correctly returns the int" $ do+      config <- configWith [ ("anInt", "50") ]+      fetchedValue <- fetch "anInt" config+      fetchedValue `shouldBe` (Right 50 :: Either Text Int)++  describe "fetching a Bool from config" $ do+    it "getting a value that can't be parsed as a bool returns an error message" $ do+      config <- configWith [ ("aBool", "nope") ]+      fetchedValue <- fetch "aBool" config+      fetchedValue `shouldBe` (Left "Key aBool could not be parsed correctly" :: Either Text Bool)+    it "getting a value that can be parsed as a bool returns the bool" $ do+      config <- configWith [ ("aBool", "True"), ("anotherBool", "False") ]+      fetchedValue <- fetch "aBool" config+      fetchedValue `shouldBe` (Right True :: Either Text Bool)+      anotherFetchedValue <- fetch "anotherBool" config+      anotherFetchedValue `shouldBe` (Right False :: Either Text Bool)+    it "the parsing of the bool value is case insensitive" $ do+      config <- configWith [ ("aBool", "TRUE"), ("anotherBool", "fAlSe") ]+      fetchedValue <- fetch "aBool" config+      fetchedValue `shouldBe` (Right True :: Either Text Bool)+      anotherFetchedValue <- fetch "anotherBool" config+      anotherFetchedValue `shouldBe` (Right False :: Either Text Bool)++  describe "fetching a String from config" $ do+    it "getting a value returns the value as a string" $ do+      config <- configWith [ ("aString", "Bleh") ]+      fetchedValue <- fetch "aString" config+      fetchedValue `shouldBe` (Right "Bleh" :: Either Text String)++  describe "fetching a Float from config" $ do+    it "if the value can be parsed as float, it returns that float" $ do+      config <- configWith [ ("aFloat", "9.5") ]+      fetchedValue <- fetch "aFloat" config+      fetchedValue `shouldBe` (Right 9.5 :: Either Text Float)+    it "if the value cannot be parsed as float, it fails" $ do+      config <- configWith [ ("aFloat", "ASD") ]+      fetchedValue <- fetch "aFloat" config+      fetchedValue `shouldBe` (Left "Key aFloat could not be parsed correctly" :: Either Text Float)

@@ -0,0 +1,38 @@+module Conferer.Provider.ArgsSpec where++import           Test.Hspec++import           Conferer++spec :: Spec+spec = do+  describe "with a mapping provider" $ do+    let mkConf args =+          emptyConfig+          & addProvider+          (mkCLIArgsProvider' args)++    it "gets a parameters with it's value if it starts with the right prefix" $ do+      c <- mkConf []+      res <- getKey "some.key" c+      res `shouldBe` Left "Key 'some.key' was not found"++    it "with a value that begins with the right prefix it uses it" $ do+      c <- mkConf ["--some.key=value"]+      res <- getKey "some.key" c+      res `shouldBe` Right "value"++    it "with a reapeated value it uses the last one" $ do+      c <- mkConf ["--some.key=value", "--some.key=different value"]+      res <- getKey "some.key" c+      res `shouldBe` Right "different value"++    it "ignores values that don't start with the right prefix" $ do+      c <- mkConf ["some.key=value", "-some.key=value", "-Xsome.key=value", "some.key"]+      res <- getKey "some.key" c+      res `shouldBe` Left "Key 'some.key' was not found"++    it "after encountering a -- it stops parsing parameters" $ do+      c <- mkConf ["--", "--some.key=value"]+      res <- getKey "some.key" c+      res `shouldBe` Left "Key 'some.key' was not found"

@@ -0,0 +1,41 @@+module Conferer.Provider.EnvSpec where++import           Test.Hspec+import qualified Data.Map as Map++import Conferer++fakeLookupEnv :: [(String, String)] -> LookupEnvFunc+fakeLookupEnv fakeEnv = \envName ->+  return $ Map.lookup envName $ Map.fromList fakeEnv++spec :: Spec+spec = do+  describe "with an env config" $ do+    let+      mkEnvConfig =+        emptyConfig+        & addProvider+        (mkEnvProvider'+         (fakeLookupEnv+          [ ("TMUX","/tmp/tmux-1000/default,2822,0")+          , ("TMUX_PANE","%1")+          , ("TMUX_PLUGIN_MANAGER_PATH","/home/user/.tmux/plugins/")+          ])+         "TMUX"+        )+    it "getting an existent key returns unwraps top level value (wihtout \+       \children)" $ do+      c <- mkEnvConfig+      res <- getKey "." c+      res `shouldBe` Right "/tmp/tmux-1000/default,2822,0"++    it "getting an existent key for a child gets that value" $ do+      c <- mkEnvConfig+      res <- getKey "pane" c+      res `shouldBe` Right "%1"++    it "keys should always be consistent as to how the words are separated" $ do+      c <- mkEnvConfig+      res <- getKey "pane" c+      res `shouldBe` Right "%1"

@@ -0,0 +1,43 @@+module Conferer.Provider.MappingSpec where++import           Test.Hspec+import qualified Data.Map as Map+import           Data.Function ((&))++import           Conferer++spec :: Spec+spec = do+  describe "with a mapping provider" $ do+    it "getting an existent key in the original map but that's not mapped in the \+       \wrapper doesn't exist" $ do+      c <- emptyConfig+           & addProvider (mkMappingProvider Map.empty+                          $ mkMapProvider [("some.key", "some value")])+      res <- getKey "some.key" c+      res `shouldBe` Left "Key 'some.key' was not found"++    it "getting a non existent key isn't there" $ do+      c <- emptyConfig+           & addProvider (mkMappingProvider (Map.fromList [("k", "key")])+                          $ mkMapProvider [("key", "75")])++      res <- getKey "xxxx" c+      res `shouldBe` Left "Key 'xxxx' was not found"++    it "getting an existent key that's mapped but doesn't exist on the \+       \inner provider isn't there" $ do+      c <- emptyConfig+           & addProvider (mkMappingProvider (Map.fromList [("another.key", "some.key")])+                          $ mkMapProvider [])++      res <- getKey "another.key" c+      res `shouldBe` Left "Key 'another.key' was not found"++    it "getting an existent key that's mapped properly gets it and exists on \+       \the inner provider gets it" $ do+      c <- emptyConfig+           & addProvider (mkMappingProvider (Map.fromList [("another.key", "some.key")])+                          $ mkMapProvider [("some.key", "some value")])+      res <- getKey "another.key" c+      res `shouldBe` Right "some value"

@@ -0,0 +1,21 @@+module Conferer.Provider.NamespacedSpec where++import Test.Hspec++import Conferer++spec :: Spec+spec = do+  describe "namespaced config" $ do+    it "return nothing if the key doesn't match" $ do+      c <- emptyConfig+           & addProvider (mkNamespacedProvider "postgres"+                          $ mkMapProvider [("url", "some url")])+      res <- getKey "url" c+      res `shouldBe` Left "Key 'url' was not found"+    it "returns the wrapped value" $ do+      c <- emptyConfig+           & addProvider (mkNamespacedProvider "postgres"+                          $ mkMapProvider [("url", "some url")])+      res <- getKey "postgres.url" c+      res `shouldBe` Right "some url"

@@ -0,0 +1,13 @@+module Conferer.Provider.NullSpec where++import           Test.Hspec++import           Conferer++spec :: Spec+spec = do+  it "always fails to get a key" $ do+    c <- emptyConfig+         & addProvider mkNullProvider+    res <- getKey "some.key" c+    res `shouldBe` Left "Key 'some.key' was not found"

@@ -0,0 +1,22 @@+module Conferer.Provider.SimpleSpec where++import Test.Hspec++import Conferer++spec :: Spec+spec = do+  describe "json provider" $ do+    let creator =+          emptyConfig+          & addProvider (mkMapProvider [ ("postgres.url", "some url")])++    it "getting a non existent key returns an empty config" $ do+      c <- creator+      res <- getKey "some.key" c+      res `shouldBe` Left "Key 'some.key' was not found"++    it "getting an existent key returns unwraps the original map" $ do+      c <- creator+      res <- getKey "postgres.url" c+      res `shouldBe` Right "some url"

@@ -0,0 +1,33 @@+module ConfererSpec where++import Test.Hspec+import Conferer++spec :: Spec+spec = do+  describe "keys" $ do+    it "parsing keys does the right thing" $ do+      "some.key" `shouldBe` Path ["some", "key"]+    it "an empty string is the empty list" $ do+      "" `shouldBe` Path []++  describe "with a config with a nested value" $ do+    let mkConfig =+          pure emptyConfig+          >>= addProvider (mkMapProvider [ ("postgres.url", "some url")])+          >>= addProvider (mkMapProvider [ ("postgres.url", "different url") , ("server.port", "4000")])++    it "getting a non existent key returns an empty config" $ do+      c <- mkConfig+      res <- getKey "aaa" c+      res `shouldBe` Left "Key 'aaa' was not found"++    it "getting an existent key returns unwraps the original map" $ do+      c <- mkConfig+      res <- getKey "postgres.url" c+      res `shouldBe` Right "some url"+    it "getting an existent key returns in the bottom maps gets it" $ do+      c <- mkConfig+      res <- getKey "server.port" c+      res `shouldBe` Right "4000"+

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}