diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -envy +envy =================== ![Hackage](https://img.shields.io/hackage/v/envy.svg) ![Hackage Dependencies](https://img.shields.io/hackage-deps/v/envy.svg) @@ -13,22 +13,22 @@ import Data.Text (pack) import Text.Read (readMaybe) -data PGConfig = PGConfig { +data ConnectInfo = ConnectInfo { pgPort :: Int pgURL :: Text } deriving (Show, Eq) -getPGPort :: IO PGConfig +getPGPort :: IO ConnectInfo getPGPort = do portResult <- lookupEnv "PG_PORT" urlResult <- lookupEnv "PG_URL" case (portResult, urlResult) of (Just port, Just url) -> case readMaybe port :: Maybe Int of - Nothing -> error "PG_PORT isn't a number" - Just portNum -> return $ PGConfig portNum (pack url) - (Nothing, _) -> error "Couldn't find PG_PORT" - (_, Nothing) -> error "Couldn't find PG_URL" + Nothing -> error "PG_PORT isn't a number" + Just portNum -> return $ ConnectInfo portNum (pack url) + (Nothing, _) -> error "Couldn't find PG_PORT" + (_, Nothing) -> error "Couldn't find PG_URL" -- Pretty gross right... ``` @@ -69,7 +69,7 @@ toVar :: a -> String fromVar :: String -> Maybe a ``` -With instances for most primitive types supported (`Word8` - `Word64`, `Int`, `Integer`, `String`, `Text`, etc.) the `Var` class is easily deriveable. The `FromEnv` typeclass provides a parser type that is an instance of `MonadError String` and `MonadIO`. This allows for connection pool initialization inside of our environment parser and custom error handling. The `ToEnv` class allows us to create an environment configuration given any `a`. See below for an example. +With instances for most concrete and primitive types supported (`Word8` - `Word64`, `Int`, `Integer`, `String`, `Text`, etc.) the `Var` class is easily deriveable. The `FromEnv` typeclass provides a parser type that is an instance of `MonadError String` and `MonadIO`. This allows for connection pool initialization inside of our environment parser and custom error handling. The `ToEnv` class allows us to create an environment configuration given any `a`. See below for an example. ```haskell {-# LANGUAGE ScopedTypeVariables #-} @@ -97,43 +97,99 @@ } deriving (Show) ------------------------------------------------------------------------------ --- | Posgtres config -data PGConfig = PGConfig { - pgConnectInfo :: ConnectInfo -- ^ Connnection Info - } deriving Show - ------------------------------------------------------------------------------- -- | FromEnv instances support popular aeson combinators *and* IO --- for dealing with connection pools. `env` is equivalent to (.:) in `aeson` +-- 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 PGConfig where - fromEnv = PGConfig <$> (ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost" - <*> env "PG_PORT" - <*> env "PG_USER" - <*> env "PG_PASS" - <*> env "PG_DB") +instance FromEnv ConnectInfo where + fromEnv = + ConnectInfo <$> envMaybe "PG_HOST" .!= "localhost" + <*> env "PG_PORT" + <*> env "PG_USER" + <*> env "PG_PASS" + <*> env "PG_DB") ------------------------------------------------------------------------------ -- | To Environment Instances -- (.=) is a smart constructor for producing types of `EnvVar` (which ensures -- that Strings are set properly in an environment so they can be parsed properly -instance ToEnv PGConfig where - toEnv PGConfig {..} = makeEnv +instance ToEnv ConnectInfo where + toEnv ConnectInfo {..} = makeEnv [ "PG_HOST" .= pgHost , "PG_PORT" .= pgPort , "PG_USER" .= pgUser , "PG_PASS" .= pgPass - , "PG_DB" .= pgDB + , "PG_DB" .= pgDB ] ------------------------------------------------------------------------------ -- | Example main :: IO () main = do - setEnvironment (toEnv :: EnvList PGConfig) - print =<< do decodeEnv :: IO (Either String PGConfig) - -- unsetEnvironment (toEnv :: EnvList PGConfig) -- remove when done + setEnvironment (toEnv :: EnvList ConnectInfo) + print =<< do decodeEnv :: IO (Either String ConnectInfo) + -- unsetEnvironment (toEnv :: EnvList ConnectInfo) -- remove when done ``` *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. + +Generics +=================== + +As of version `1.0`, all `FromEnv` instance boilerplate can be completely removed thanks to `GHC.Generics`! Below is an example. + +```haskell +{-# LANGUAGE DeriveGeneric #-} +module Main where + +import System.Envy +import GHC.Generics + +-- This record corresponds to our environment, where the field names become the variable names, and the values the environment variable value +data PGConfig = PGConfig { + pgHost :: String -- "PG_HOST" + , pgHost :: 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 = + print =<< decodeEnv :: IO (Either String PGConfig) + -- > PGConfig { pgHost = "customURL", pgPort = 5432 } +``` + +Suppose you'd like to customize the field name (i.e. add your own prefix, or drop the existing record prefix). This too is possible. See below. + +```haskell +{-# LANGUAGE DeriveGeneric #-} +module Main where + +import System.Envy +import GHC.Generics + +data PGConfig = PGConfig { + connectHost :: String -- "PG_HOST" + , connectPort :: Int -- "PG_PORT" + } deriving (Generic, Show) + +instance DefConfig PGConfig where + defConfig = PGConfig "localhost" 5432 + +-- All fields will be converted to uppercase +instance FromEnv PGConfig where + fromEnv = fromEnvCustom Option { + dropPrefixCount = 7 + , customPrefix = "PG" + } + +main :: IO () +main = + print =<< decodeEnv :: IO (Either String PGConfig) + -- PGConfig { pgHost = "customUrl", pgPort = 5432 } +``` diff --git a/envy.cabal b/envy.cabal --- a/envy.cabal +++ b/envy.cabal @@ -1,5 +1,5 @@ name: envy -version: 0.3.1.2 +version: 1.0.0.0 synopsis: An environmentally friendly way to deal with environment variables license: BSD3 license-file: LICENSE @@ -10,10 +10,11 @@ build-type: Simple cabal-version: >=1.10 description: - For package use information see the + For package use information see the extra-source-files: README.md + examples/Test.hs library exposed-modules: System.Envy @@ -35,7 +36,7 @@ main-is: Main.hs build-depends: base >= 4.7 && < 5 , bytestring == 0.10.* - , envy == 0.3.* + , envy == 1.0.* , hspec == 2.2.* , mtl == 2.2.* , quickcheck-instances == 0.3.* diff --git a/examples/Test.hs b/examples/Test.hs new file mode 100644 --- /dev/null +++ b/examples/Test.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DeriveGeneric #-} +module Main where + +import System.Envy +import GHC.Generics + +data PGConfig = PGConfig { + connectHost :: String -- "PG_HOST" + , connectPort :: Int -- "PG_PORT" + } deriving (Generic, Show) + +instance DefConfig PGConfig where + defConfig = PGConfig "localhost" 5432 + +instance FromEnv PGConfig where + fromEnv = fromEnvCustom (Option 7 "PG") + -- Generically creates instance for retrieving environment variables (PG_HOST, PG_PORT) + +main :: IO () +main = + print =<< decodeEnv :: IO (Either String PGConfig) + -- PGConfig { pgHost = "foobah", pgPort = 5432 } diff --git a/src/System/Envy.hs b/src/System/Envy.hs --- a/src/System/Envy.hs +++ b/src/System/Envy.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} ------------------------------------------------------------------------------ -- | -- Module : System.Envy @@ -10,8 +14,33 @@ -- Maintainer : djohnson.m@ngmail.com -- Stability : experimental -- Portability : POSIX --- ------------------------------------------------------------------------------- +-- +-- > {-# LANGUAGE DeriveGeneric #-} +-- > +-- > module Main ( main ) where +-- > +-- > import System.Envy +-- > import GHC.Generics +-- > +-- > data PGConfig = PGConfig { +-- > pgHost :: String -- "PG_HOST" +-- > , pgPort :: Int -- "PG_PORT" +-- > } deriving (Generic, Show) +-- > +-- > -- Default instance used if environment variable doesn't exist +-- > instance DefConfig PGConfig where +-- > defConfig = PGConfig "localhost" 5432 +-- > +-- > instance FromEnv PGConfig +-- > -- Generically produces the following body (no implementation needed if using Generics): +-- > -- fromEnv = PGConfig <$> envMaybe "PG_HOST" .!= "localhost" +-- > -- <*> envMaybe "PG_PORT" .!= 5432 +-- > +-- > main :: IO () +-- > main = +-- > print =<< do decodeEnv :: IO (Either String PGConfig) +-- > -- PGConfig { pgHost = "custom-pg-url", pgPort = 5432 } +-- module System.Envy ( -- * Classes FromEnv (..) @@ -25,18 +54,23 @@ , setEnvironment , setEnvironment' , unsetEnvironment - , makeEnv + , makeEnv , env , envMaybe , (.=) , (.!=) + -- * Generics + , DefConfig (..) + , Option (..) ) where ------------------------------------------------------------------------------ import Control.Applicative import Control.Monad.Except import Control.Exception import Data.Maybe +import Data.Char import Data.Time +import GHC.Generics import Data.Typeable import System.Environment import Text.Read (readMaybe) @@ -48,22 +82,23 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as BL8 ------------------------------------------------------------------------------ --- | Parser +-- | Parser Monad for environment variable retrieval newtype Parser a = Parser { runParser :: ExceptT String IO a } deriving ( Functor, Monad, Applicative, MonadError String , MonadIO, Alternative, MonadPlus ) + ------------------------------------------------------------------------------ --- | Variable type, smart constructor for handling Env. Variables +-- | Variable type, smart constructor for handling environment variables data EnvVar = EnvVar { getEnvVar :: (String, String) } deriving (Show, Eq) ------------------------------------------------------------------------------ --- | Execute Parser +-- | Executes `Parser` evalParser :: FromEnv a => Parser a -> IO (Either String a) evalParser = runExceptT . runParser ------------------------------------------------------------------------------ --- | Infix environment variable getter +-- | Environment variable getter getE :: forall a . (Typeable a, Var a) => String @@ -79,14 +114,14 @@ Just x -> return x ------------------------------------------------------------------------------ --- | Environment variable getter +-- | Environment variable getter env :: forall a. (Typeable a, Var a) => String -> Parser a env = getE ------------------------------------------------------------------------------ --- | Infix environment variable getter +-- | Environment variable getter returning `Maybe` getEMaybe :: forall a . (Typeable a, Var a) => String @@ -98,7 +133,7 @@ Just x -> fromVar x ------------------------------------------------------------------------------ --- | Maybe parser +-- | Environment variable getter returning `Maybe` envMaybe :: forall a. (Typeable a, Var a) => String -> Parser (Maybe a) @@ -109,123 +144,132 @@ (.!=) :: forall a. (Typeable a, Var a) => Parser (Maybe a) -> a - -> Parser a + -> Parser a (.!=) p x = fmap (fromMaybe x) p ------------------------------------------------------------------------------ --- | Infix environment variable setter --- this is a smart constructor for producing types of `EnvVar` +-- | Infix environment variable setter +-- Smart constructor for producing types of `EnvVar` (.=) :: Var a => String -> a - -> EnvVar + -> EnvVar (.=) x y = EnvVar (x, toVar y) ------------------------------------------------------------------------------ --- | FromEnv Typeclass +-- | `FromEnv` Typeclass w/ Generic default implementation class FromEnv a where fromEnv :: Parser a + fromEnvCustom :: (DefConfig a, Generic a, GFromEnv (Rep a)) => Option -> Parser a + fromEnvCustom opts = to <$> gFromEnv (from (defConfig :: a)) opts + default fromEnv :: (DefConfig a, Generic a, GFromEnv (Rep a)) => Parser a + fromEnv = fromEnvCustom defOption ------------------------------------------------------------------------------ --- | ToEnv Typeclass -class Show a => ToEnv a where - toEnv :: a -> EnvList a +-- | `Generic` FromEnv +class GFromEnv f where + gFromEnv :: f a -> Option -> Parser (f a) ------------------------------------------------------------------------------ --- | EnvList type w/ phanton -data EnvList a = EnvList [EnvVar] deriving (Show) +-- | Default Config +class DefConfig a where defConfig :: a ------------------------------------------------------------------------------ --- | smart constructor, Environment creation helper -makeEnv :: ToEnv a => [EnvVar] -> EnvList a -makeEnv = EnvList +-- | For customizing environment variable generation +data Option = Option { + dropPrefixCount :: Int -- ^ Applied first + , customPrefix :: String -- ^ Converted toUpper + } deriving Show ------------------------------------------------------------------------------ --- | Class for converting to / from an environment variable -class Var a where - toVar :: a -> String - fromVar :: String -> Maybe a - -instance Var Text where - toVar = T.unpack - fromVar = Just . T.pack - -instance Var TL.Text where - toVar = TL.unpack - fromVar = Just . TL.pack - -instance Var BL8.ByteString where - toVar = BL8.unpack - fromVar = Just . BL8.pack - -instance Var B8.ByteString where - toVar = B8.unpack - fromVar = Just . B8.pack - -instance Var Int where - toVar = show - fromVar = readMaybe - -instance Var Int8 where - toVar = show - fromVar = readMaybe - -instance Var Int16 where - toVar = show - fromVar = readMaybe +-- | Default `Option` for field modification +defOption :: Option +defOption = Option 0 mempty -instance Var Int32 where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | Products +instance (GFromEnv a, GFromEnv b) => GFromEnv (a :*: b) where + gFromEnv (a :*: b) opts = liftA2 (:*:) (gFromEnv a opts) (gFromEnv b opts) -instance Var Int64 where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | Don't absorb meta data +instance GFromEnv a => GFromEnv (C1 i a) where gFromEnv (M1 x) opts = M1 <$> gFromEnv x opts -instance Var Integer where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | Don't absorb meta data +instance GFromEnv a => GFromEnv (D1 i a) where gFromEnv (M1 x) opts = M1 <$> gFromEnv x opts -instance Var UTCTime where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | Construct a `Parser` from a `selName` and `DefConfig` record field +instance (Selector s, Typeable a, Var a) => GFromEnv (S1 s (K1 i a)) where + gFromEnv m@(M1 (K1 def)) opts = + M1 . K1 <$> envMaybe (toEnvName opts $ selName m) .!= def + where + toEnvName :: Option -> String -> String + toEnvName Option{..} xs = + let name = snake (drop dropPrefixCount xs) + in if customPrefix == mempty + then name + else map toUpper customPrefix ++ "_" ++ name -instance Var Day where - toVar = show - fromVar = readMaybe + applyFirst :: (Char -> Char) -> String -> String + applyFirst _ [] = [] + applyFirst f [x] = [f x] + applyFirst f (x:xs) = f x: xs -instance Var Word8 where - toVar = show - fromVar = readMaybe + snakeCase :: String -> String + snakeCase = u . applyFirst toLower + where u [] = [] + u (x:xs) | isUpper x = '_' : toLower x : snakeCase xs + | otherwise = x : u xs -instance Var Bool where - toVar = show - fromVar = readMaybe + snake :: String -> String + snake = map toUpper . snakeCase -instance Var Double where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | ToEnv Typeclass +class ToEnv a where toEnv :: a -> EnvList a -instance Var Word16 where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | EnvList type w/ phanton +data EnvList a = EnvList [EnvVar] deriving (Show) -instance Var Word32 where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | smart constructor, Environment creation helper +makeEnv :: ToEnv a => [EnvVar] -> EnvList a +makeEnv = EnvList -instance Var Word64 where - toVar = show - fromVar = readMaybe +------------------------------------------------------------------------------ +-- | Class for converting to / from an environment variable +class Var a where + toVar :: a -> String + fromVar :: String -> Maybe a -instance Var String where - toVar = id - fromVar = Just +------------------------------------------------------------------------------ +instance Var Text where toVar = T.unpack; fromVar = Just . T.pack +instance Var TL.Text where toVar = TL.unpack; fromVar = Just . TL.pack +instance Var BL8.ByteString where toVar = BL8.unpack; fromVar = Just . BL8.pack +instance Var B8.ByteString where toVar = B8.unpack; fromVar = Just . B8.pack +instance Var Int where toVar = show; fromVar = readMaybe +instance Var Int8 where toVar = show; fromVar = readMaybe +instance Var Int16 where toVar = show; fromVar = readMaybe +instance Var Int32 where toVar = show; fromVar = readMaybe +instance Var Int64 where toVar = show; fromVar = readMaybe +instance Var Integer where toVar = show; fromVar = readMaybe +instance Var UTCTime where toVar = show; fromVar = readMaybe +instance Var Day where toVar = show; fromVar = readMaybe +instance Var Word8 where toVar = show; fromVar = readMaybe +instance Var Bool where toVar = show; fromVar = readMaybe +instance Var Double where toVar = show; fromVar = readMaybe +instance Var Word16 where toVar = show; fromVar = readMaybe +instance Var Word32 where toVar = show; fromVar = readMaybe +instance Var Word64 where toVar = show; fromVar = readMaybe +instance Var String where toVar = id; fromVar = Just ------------------------------------------------------------------------------ -- | Environment retrieval with failure info decodeEnv :: FromEnv a => IO (Either String a) -decodeEnv = evalParser fromEnv +decodeEnv = evalParser fromEnv ------------------------------------------------------------------------------ -- | Environment retrieval (with no failure info) @@ -250,8 +294,8 @@ setEnvironment' = setEnvironment . toEnv ------------------------------------------------------------------------------ --- | Unset Environment from a ToEnv constrained type -unsetEnvironment :: EnvList a -> IO (Either String ()) +-- | Unset Environment from a `ToEnv` constrained type +unsetEnvironment :: ToEnv a => EnvList a -> IO (Either String ()) unsetEnvironment (EnvList xs) = do result <- try $ mapM_ (unsetEnv . fst . getEnvVar) xs return $ case result of @@ -259,6 +303,6 @@ Right () -> Right () ------------------------------------------------------------------------------ --- | Env helper +-- | Display all environment variables, for convenience showEnv :: IO () showEnv = mapM_ print =<< getEnvironment