envy 1.5.1.0 → 2.0.0.0

raw patch · 5 files changed

+158/−48 lines, 5 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README.md +48/−18
• envy.cabal +3/−3
• src/System/Envy.hs +41/−19
• tests/Main.hs +65/−7

@@ -1,4 +1,4 @@-Copyright (c) 2015, David Johnson+Copyright (c) 2015-2020, David Johnson  All rights reserved. 

@@ -101,7 +101,7 @@ -- for dealing with connection pool initialization. `env` is equivalent to (.:) in `aeson` -- and `envMaybe` is equivalent to (.:?), except here the lookups are impure. instance FromEnv ConnectInfo where-  fromEnv =+  fromEnv _ =     ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost" 		<*> env "PG_PORT" 		<*> env "PG_USER"@@ -130,6 +130,27 @@    -- unsetEnvironment (toEnv :: EnvList ConnectInfo)  -- remove when done ``` +Our parser might also make use a set of an optional default values provided by the user, +for dealing with errors when reading from the environment++```haskell+instance FromEnv ConnectInfo where+  fromEnv Nothing = +    ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost"+		<*> env "PG_PORT"+		<*> env "PG_USER"+		<*> env "PG_PASS"+		<*> env "PG_DB"+        +  fromEnv (Just def) = +    ConnectInfo <$> envMaybe "PG_HOST" .!= (pgHost def)+		<*> envMaybe "PG_PORT" .!= (pgPort def)+		<*> env "PG_USER" .!= (pgUser def)+		<*> env "PG_PASS" .!= (pgPass def) +		<*> env "PG_DB" .!= (pgDB def)+```++ *Note*: As of base 4.7 `setEnv` and `getEnv` throw an `IOException` if a `=` is present in an environment. `envy` catches these synchronous exceptions and delivers them purely to the end user. @@ -144,6 +165,7 @@  import System.Envy import GHC.Generics+import System.Environment.Blank  -- This record corresponds to our environment, where the field names become the variable names, and the values the environment variable value data PGConfig = PGConfig {@@ -151,16 +173,29 @@   , pgPort :: Int    -- "PG_PORT"   } deriving (Generic, Show) --- Default configuration will be used for fields that could not be retrieved from the environment-instance DefConfig PGConfig where-  defConfig = PGConfig "localhost" 5432- instance FromEnv PGConfig -- Generically creates instance for retrieving environment variables (PG_HOST, PG_PORT)  main :: IO ()+main = do+  _ <- setEnv "PG_HOST" "valueFromEnv" True+  _ <- setEnv "PG_PORT"  "66354651" True+  print =<< do decodeEnv :: IO (Either String PGConfig)+ -- > PGConfig { pgHost = "valueFromEnv", pgPort = 66354651 }+```++If the variables are not found in the environment, the parser will currently fail with an error about the first missing field.++The user can decide to provide a default value, whose fields will be used by the generic instance, if retrieving them from the environment fails.++```haskell+defConfig :: PGConfig+defConfig = PGConfig "localhost" 5432++main :: IO () main =-  print =<< decodeEnv :: IO (Either String PGConfig)+  _ <- setEnv "PG_HOST" "customURL" True+  print =<< decodeWithDefaults defConfig :: IO (Either String PGConfig)  -- > PGConfig { pgHost = "customURL", pgPort = 5432 } ``` @@ -183,14 +218,15 @@  -- All fields will be converted to uppercase instance FromEnv PGConfig where-  fromEnv = fromEnvCustom Option {+  fromEnv = gFromEnvCustom Option {                     dropPrefixCount = 7-                  , customPrefix = "PG"+                  , customPrefix = "CUSTOM" 		  }  main :: IO () main =-  print =<< decodeEnv :: IO (Either String PGConfig)+  _ <- setEnv "CUSTOM_HOST" "customUrl" True+  print =<< do decodeEnv :: IO (Either String PGConfig)  -- PGConfig { pgHost = "customUrl", pgPort = 5432 } ``` @@ -208,18 +244,12 @@   , connectPort :: Int    -- "PG_PORT"   } deriving (Generic, Show) --- Default PGConfig-instance DefConfig PGConfig where-  defConfig = PGConfig "localhost" 5432- -- All fields will be converted to uppercase getPGEnv :: IO (Either String PGConfig)-getPGEnv = runEnv $ gFromEnvCustom Option {-                    dropPrefixCount = 7-                  , customPrefix = "PG"-		  }+getPGEnv = runEnv $ gFromEnvCustom defOption+                                   (Just (PGConfig "localhost" 5432))  main :: IO () main = print =<< getPGEnv- -- PGConfig { pgHost = "customUrl", pgPort = 5432 }+ -- PGConfig { pgHost = "localhost", pgPort = 5432 } ```

@@ -1,11 +1,11 @@ name:                envy-version:             1.5.1.0+version:             2.0.0.0 synopsis:            An environmentally friendly way to deal with environment variables license:             BSD3 license-file:        LICENSE-author:              David Johnson, Tim Adams, Eric Mertens+author:              David Johnson, Tim Adams, Eric Mertens, Nicolas Rolland maintainer:          djohnson.m@gmail.com-copyright:           David Johnson (c) 2015+copyright:           David Johnson (c) 2015-2020 category:            System build-type:          Simple cabal-version:       >=1.10

@@ -9,6 +9,8 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE KindSignatures             #-} ------------------------------------------------------------------------------ -- | -- Module      : System.Envy@@ -48,10 +50,12 @@          FromEnv (..)        , ToEnv   (..)        , Var     (..)-       , EnvList+       , EnvList (..)+       , EnvVar  (..)        , Parser  (..)         -- * Functions        , decodeEnv+       , decodeWithDefaults        , decode        , showEnv        , setEnvironment@@ -66,6 +70,7 @@          -- * Generics        , DefConfig (..)        , Option (..)+       , defOption        , runEnv        , gFromEnvCustom        ) where@@ -78,7 +83,7 @@ import           Data.Time import           GHC.Generics import           Data.Typeable-import           System.Environment+import           System.Environment.Blank import           Text.Read (readMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -123,7 +128,7 @@     => String   -- ^ Key to look up.     -> Parser a -- ^ Return a value of this type or throw an error. env key = do-  result <- liftIO (lookupEnv key)+  result <- liftIO (getEnv key)   case result of     Nothing -> throwError $ "Variable not found for: " ++ key     Just dv ->@@ -139,7 +144,7 @@          => String           -- ^ Key to look up.          -> Parser (Maybe a) -- ^ Return `Nothing` if variable isn't set. envMaybe key = do-  val <- liftIO (lookupEnv key)+  val <- liftIO (getEnv key)   return $ case val of    Nothing -> Nothing    Just x -> fromVar x@@ -163,25 +168,25 @@ ------------------------------------------------------------------------------ -- | `FromEnv` Typeclass w/ Generic default implementation class FromEnv a where-  fromEnv :: Parser a-  default fromEnv :: (DefConfig a, Generic a, GFromEnv (Rep a)) => Parser a-  fromEnv = gFromEnvCustom defOption+  fromEnv :: Maybe a -> Parser a+  default fromEnv :: (Generic a, GFromEnv (Rep a)) => Maybe a -> Parser a+  fromEnv oa = gFromEnvCustom defOption oa  ------------------------------------------------------------------------------ -- | Meant for specifying a custom `Option` for environment retrieval -- -- > instance FromEnv PGConfig where -- >   fromEnv = gFromEnvCustom Option { dropPrefixCount = 8, customPrefix = "PG" }----gFromEnvCustom :: forall a. (DefConfig a, Generic a, GFromEnv (Rep a))+gFromEnvCustom :: forall a. (Generic a, GFromEnv (Rep a))                => Option+               -> Maybe a                -> Parser a-gFromEnvCustom opts = to <$> gFromEnv (from (defConfig :: a)) opts+gFromEnvCustom opts oa = to <$> gFromEnv opts (from <$> oa)  ------------------------------------------------------------------------------ -- | `Generic` FromEnv class GFromEnv f where-  gFromEnv :: f a -> Option -> Parser (f a)+  gFromEnv :: Option -> Maybe (f a) ->  Parser (f a)  ------------------------------------------------------------------------------ -- | Type class for objects which have a default configuration.@@ -202,24 +207,34 @@ ------------------------------------------------------------------------------ -- | Products instance (GFromEnv a, GFromEnv b) => GFromEnv (a :*: b) where-  gFromEnv (a :*: b) opts = liftA2 (:*:) (gFromEnv a opts) (gFromEnv b opts)+  gFromEnv opts ox = let (oa, ob) = case ox of+                                             (Just (a :*: b)) -> (Just a, Just b)+                                             _ -> (Nothing, Nothing) in+                            liftA2 (:*:) (gFromEnv opts oa) (gFromEnv opts ob)  ------------------------------------------------------------------------------ -- | Don't absorb meta data instance GFromEnv a => GFromEnv (C1 i a) where-  gFromEnv (M1 x) opts = M1 <$> gFromEnv x opts+  gFromEnv  opts (Just (M1 x))= M1 <$> gFromEnv opts (Just x)+  gFromEnv  opts            _ = M1 <$> gFromEnv opts Nothing  ------------------------------------------------------------------------------ -- | Don't absorb meta data instance GFromEnv a => GFromEnv (D1 i a) where-  gFromEnv (M1 x) opts = M1 <$> gFromEnv x opts+  gFromEnv opts (Just (M1 x)) = M1 <$> gFromEnv opts (Just x)+  gFromEnv opts             _ = M1 <$> gFromEnv opts Nothing  ------------------------------------------------------------------------------ -- | Construct a `Parser` from a `selName` and `DefConfig` record field instance (Selector s, Var a) => GFromEnv (S1 s (K1 i a)) where-  gFromEnv m@(M1 (K1 def)) opts =-      M1 . K1 <$> envMaybe (toEnvName opts $ selName m) .!= def-    where+  gFromEnv opts ox =+    let p = case ox of+               Just (M1 (K1 def)) -> envMaybe envName .!= def+               _                  -> env envName in+    M1 . K1 <$> p+     where+      envName = toEnvName opts $ selName (SelectorProxy :: SelectorProxy s Proxy ())+       toEnvName :: Option -> String -> String       toEnvName Option{..} xs =         let name = snake (drop dropPrefixCount xs)@@ -241,6 +256,8 @@       snake :: String -> String       snake = map toUpper . snakeCase +data SelectorProxy (s :: Meta) (f :: * -> *) a = SelectorProxy+ ------------------------------------------------------------------------------ -- | Type class for objects which can be converted to a set of -- environment variable settings.@@ -296,7 +313,7 @@ ------------------------------------------------------------------------------ -- | Environment retrieval with failure info decodeEnv :: FromEnv a => IO (Either String a)-decodeEnv = evalParser fromEnv+decodeEnv = evalParser (fromEnv Nothing)  ------------------------------------------------------------------------------ -- | Environment retrieval (with no failure info)@@ -307,6 +324,11 @@     eitherToMaybe (Right x) = Just x  ------------------------------------------------------------------------------+-- | Environment retrieval with default values provided+decodeWithDefaults :: FromEnv a => a -> IO a+decodeWithDefaults def = (\(Right x) -> x) <$> evalParser (fromEnv (Just def))++------------------------------------------------------------------------------ -- | Catch an IO exception and return it in an Either. wrapIOException :: IO a -> IO (Either String a) wrapIOException action = try action >>= \case@@ -317,7 +339,7 @@ -- | Set environment via a ToEnv constrained type setEnvironment :: EnvList a -> IO (Either String ()) setEnvironment (EnvList envVars) = wrapIOException $ mapM_ set envVars-  where set var = setEnv (variableName var) (variableValue var)+  where set var = setEnv (variableName var) (variableValue var) True  ------------------------------------------------------------------------------ -- | Set environment directly using a value of class ToEnv

@@ -1,30 +1,56 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE RecordWildCards            #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE DeriveGeneric              #-} ------------------------------------------------------------------------------ module Main ( main ) where ------------------------------------------------------------------------------ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as BL8 import           Data.Int+import           Data.List (isInfixOf) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import           Data.Time import           Data.Word+import           GHC.Generics import           System.Envy import           Test.Hspec import           Test.QuickCheck import           Test.QuickCheck.Instances () import           Test.QuickCheck.Monadic+++ ------------------------------------------------------------------------------+data UserInfo = UserInfo {+      userName :: String+    , userAge :: Int+  } deriving (Show, Eq, Generic)+++-- | Generic instance+instance FromEnv UserInfo++instance Arbitrary UserInfo where+  arbitrary = UserInfo <$> arbitrary <*> arbitrary++------------------------------------------------------------------------------ data ConnectInfo = ConnectInfo {       pgHost :: String     , pgPort :: Word16     , pgUser :: String     , pgPass :: String     , pgDB   :: String-  } deriving (Show, Eq)+  } deriving (Show, Eq, Generic) ++instance DefConfig ConnectInfo where+  defConfig = ConnectInfo "localhost" 5432 "user" "pass" "db"++-- | Generic instance with default values+instance FromEnv ConnectInfo+ instance Arbitrary ConnectInfo where     arbitrary = ConnectInfo <$> nonulls                             <*> arbitrary@@ -52,11 +78,11 @@ -- | FromEnv Instances, supports popular aeson combinators *and* IO -- for dealing with connection pools instance FromEnv PGConfig where-  fromEnv = PGConfig <$> (ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost"-                                      <*> env "PG_PORT"-                                      <*> env "PG_USER"-                                      <*> env "PG_PASS"-                                      <*> env "PG_DB")+  fromEnv _ = PGConfig <$> (ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost"+                                        <*> env "PG_PORT"+                                        <*> env "PG_USER"+                                        <*> env "PG_PASS"+                                        <*> env "PG_DB")  ------------------------------------------------------------------------------ -- | To Environment Instances@@ -70,6 +96,7 @@                                , "PG_DB"   .= pgDB                                ] + ------------------------------------------------------------------------------ -- | Start tests main :: IO ()@@ -107,10 +134,41 @@      \(x :: T.Text) -> Just x == fromVar (toVar x)     it "() Var isomorphism" $ property $      \(x :: ()) -> Just x == fromVar (toVar x)-  describe "Can set to and from environment" $+  describe "Can set to and from environment" $ do     it "Isomorphism through setEnvironment['] and decodeEnv" $ property $       \(pgConf::PGConfig) -> monadicIO $ do         res <- run $ do                  _ <- setEnvironment' pgConf                  decodeEnv         assert $ res == Right pgConf+    it "Storing and retrieving var" $ property $+      \(x::String) -> monadicIO $ do+        res <- run $ do+                 _ <- setEnvironment $ makeEnv [ "HSPECENVY_" .= toVar x]+                 runEnv $ env  "HSPECENVY_"+        assert $ if isInfixOf "\NUL" x then True else res == Right x+  describe "Can use generic FromEnv" $+    it "Isomorphism through setEnvironment and decodeEnv" $ property $+      \(ci::ConnectInfo) -> monadicIO $ do+        res <- run $ do+                 let ConnectInfo{..} = ci+                 _ <- setEnvironment $+                          makeEnv [ "PG_HOST" .= pgHost+                                  , "PG_PORT" .= pgPort+                                  , "PG_USER" .= pgUser+                                  , "PG_PASS" .= pgPass+                                  , "PG_DB"   .= pgDB+                                  ]+                 decodeWithDefaults (defConfig :: ConnectInfo)+        assert $ res == ci+  describe "Can use generic FromEnvNoDefault" $+    it "Isomorphism through setEnvironment and decodeEnv" $ property $+      \(u::UserInfo) -> monadicIO $ do+        res <- run $ do+                 let UserInfo{..} = u+                 _ <- setEnvironment $+                          makeEnv [ "USER_NAME" .= (userName ++ "")+                                  , "USER_AGE" .= userAge+                                  ]+                 decodeEnv+        assert $  if isInfixOf "\NUL" (userName u) then True else res == Right u