packages feed

from-env (empty) → 0.1.0.0

raw patch · 6 files changed

+309/−0 lines, 6 filesdep +basedep +casingdep +from-env

Dependencies added: base, casing, from-env, hspec, text

Files

+ README.md view
@@ -0,0 +1,36 @@+# from-env++Haskell package to construct datatypes from environment variables.++In many applications you'll have an `.env` file or set environment variables+some way. These environment variables usually contain configuration data such+as database connection urls, secrets; etc.++Next, you make a configuration data type to hold this variables so your+application can access them. Normally you'd have a bunch of calls to `lookupEnv`+in order to build your data type. This is tedious and error-prone. Thankfully,+in Haskell we can do better!++```haskell+import GHC.Generics+import System.Environment.FromEnv++data Config = Config+    { configDbUrl     :: !String+    , configApiSecret :: !String+    }+    deriving Generic++instance FromEnv Config++main = do+    config <- fromEnv+    -- do something with config+```++And that's it! By deriving `Generic` you can now create an instance of `FromEnv`+for free. Check out the haddocks for more.++## License++MIT
+ from-env.cabal view
@@ -0,0 +1,68 @@+cabal-version:      2.4+name:               from-env+version:            0.1.0.0+synopsis:+  Provides a generic way to construct values from environment variables.++description:+  .+  This package exposes a class `FromEnv` that works with `GHC.Generics` to provide a generic way+  to construct values from environment variables.+  .+  In many applications you'll have a configuration object holding a connection string to your+  database, the url of an S3 bucket, you name it. It can be tedious to have to construct this+  configuration object manually. With this package, you just derive `Generic` and then create an+  instance of `FromEnv` for your configuration type and you're done. Just call `fromEnv` and you got+  your configuration.+  .+  > import System.Environment.FromEnv+  > import GHC.Generics+  > newtype Config = Config { configS3BucketUrl :: String } deriving Generic+  > instance FromEnv Config+  > config <- fromEnv+  .+  The default behaviour is to convert field names like `configS3BucketUrl` into +  environment variables like `CONFIG_S3_BUCKET_URL`, but it can be overriden by providing a+  custom instance of `FromEnv`.++bug-reports:        https://github.com/aloussase/from-env/issues+license:            MIT+author:             Alexander Goussas+maintainer:         goussasalexander@gmail.com+copyright:          Alexander Goussas 2023+category:           Configuration+extra-source-files: README.md++source-repository head+  type:     git+  location: https://github.com/aloussase/from-env.git++library+  exposed-modules:+    System.Environment.FromEnv+    System.Environment.FromEnv.TryParse++  ghc-options:      -Wall++  -- other-modules:+  build-depends:+    , base    ^>=4.16.4.0+    , casing  >=0.1.4     && <0.2+    , text    >=1.2.5     && <1.3++  hs-source-dirs:   src+  default-language: Haskell2010++test-suite from-env-test-suite+  type:               exitcode-stdio-1.0+  ghc-options:        -Wall+  hs-source-dirs:     test+  main-is:            Spec.hs+  other-modules:      System.Environment.FromEnvSpec+  build-depends:+    , base      ^>=4.16.4.0+    , from-env+    , hspec++  build-tool-depends: hspec-discover:hspec-discover+  default-language:   Haskell2010
+ src/System/Environment/FromEnv.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE DerivingStrategies   #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE KindSignatures       #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+module System.Environment.FromEnv+(+  -- * Core class+    FromEnv (..)+  -- * Options+  , defaultEnvOpts+  , FromEnvOptions ( optsFieldLabelModifier )+  -- * Generic parsing class+  , GFromEnv (..)+  -- * Errors+  , FromEnvError (..)+) where++import           Control.Applicative                 (liftA2)+import           Control.Monad.IO.Class              (MonadIO, liftIO)+import           GHC.Generics+import           System.Environment                  (lookupEnv)++import           Text.Casing                         (screamingSnake)++import           System.Environment.FromEnv.TryParse+++-- | Class for things that can be created from environment variables.+class FromEnv a where+  fromEnv :: (MonadIO m) => m (Either FromEnvError a)+  default fromEnv :: (MonadIO m, Generic a, GFromEnv' (Rep a)) => m (Either FromEnvError a)+  fromEnv = gFromEnv defaultEnvOpts++-- | Try to convert a field name into an environment variable name.+type FieldLabelModifier = String -> String++-- | Options to specify how to construct your datatype from environment variables.+-- Options can be set using record update syntax and 'defaultEnvOpts'.+newtype FromEnvOptions = FromEnvOptions+  { optsFieldLabelModifier :: FieldLabelModifier+  -- ^ Function to map from a field name to an environment variable name.+  }++-- | Default 'FromEnvOptions':+--+-- The default options will try to read a field name fieldName from an+-- environment variables FIELD_NAME, as this is the most common naming+-- convention for environment variables.+--+-- If you want different behavior, see 'gFromEnv'.+--+-- @+-- 'FromEnvOptions'+-- { 'optsFieldLabelModifier' = Just . 'Text.Casing.screamingSnake'+-- }+-- @+defaultEnvOpts :: FromEnvOptions+defaultEnvOpts = FromEnvOptions+  { optsFieldLabelModifier =  screamingSnake+  }++class GFromEnv a where+  -- | Try to construct a value from environment variables.+  gFromEnv :: (MonadIO m) => FromEnvOptions -> m (Either FromEnvError a)+  default gFromEnv :: (MonadIO m, Generic a, GFromEnv' (Rep a)) => FromEnvOptions -> m (Either FromEnvError a)+  gFromEnv opts = fmap to <$> gFromEnv' opts++instance (Generic a, GFromEnv' (Rep a)) => GFromEnv a++class GFromEnv' f where+  gFromEnv' :: (MonadIO m) => FromEnvOptions -> m (Either FromEnvError (f a))++instance {-# OVERLAPPING #-} GFromEnv' f => GFromEnv' (M1 i c f) where+  gFromEnv' converter = fmap M1 <$> gFromEnv' converter++instance (GFromEnv' f, GFromEnv' g) => GFromEnv' (f :*: g)  where+  gFromEnv' opts = do+    f' <- gFromEnv' @f opts+    g' <- gFromEnv' @g opts+    return $ liftA2 (:*:) f' g'++instance {-# OVERLAPPING #-} (Selector s, TryParse a) => GFromEnv' (M1 S s (K1 i a)) where+  gFromEnv' opts = do+    let m :: M1 i s f a+        m = undefined+        name = optsFieldLabelModifier opts $ selName m+    envValue <- liftIO $ lookupEnv name+    return $ do+        v <- maybeToEither (UnsetVariable name) envValue+        r <- maybeToEither (FailedToParse name v) (tryParse v)+        return . M1 . K1 $ r++maybeToEither :: b -> Maybe a -> Either b a+maybeToEither _ (Just a) = Right a+maybeToEither b Nothing  = Left b++data FromEnvError+    = UnsetVariable String+    -- ^ A field was unset in the environment+    | FailedToParse String String+    -- ^ Failed to parse a given field from an environment variable+    deriving Eq++instance Show FromEnvError where+    show (UnsetVariable fieldName) =+        "The field " <> fieldName <> " was unset in the environment"+    show (FailedToParse fieldName envValue) =+        "Failed to parse the field " <> fieldName <> " from the value " <> envValue
+ src/System/Environment/FromEnv/TryParse.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+module System.Environment.FromEnv.TryParse+(+    TryParse (..)+)+where++import           Data.Text (Text)+import qualified Data.Text as T+import           Text.Read (readMaybe)++-- | Class for things that may be parsed from strings.+class TryParse a where+  tryParse :: String -> Maybe a++instance TryParse Int where+  tryParse = readMaybe++instance TryParse [Char] where+   tryParse = Just++instance TryParse Char where+   tryParse [c] = Just c+   tryParse _   = Nothing++instance TryParse Text where+  tryParse = Just . T.pack+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/System/Environment/FromEnvSpec.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DeriveAnyClass   #-}+{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE TypeApplications #-}+module System.Environment.FromEnvSpec (main, spec) where++import           Data.Either                (isLeft, isRight)+import           GHC.Generics+import           System.Environment         (getEnvironment, setEnv, unsetEnv)+import           Test.Hspec                 (Spec, after_, describe, hspec, it,+                                             shouldBe, shouldSatisfy)++import           System.Environment.FromEnv++main :: IO ()+main = hspec spec++spec :: Spec+spec = fromEnvSpec >> gFromEnvSpec++fromEnvSpec :: Spec+fromEnvSpec =+  describe "fromEnv" $ after_ clearEnvs $ do+    it "returns Nothing when the necessary environment variables are not set" $ do+      config <- fromEnv @Config+      config `shouldSatisfy` isLeft++    it "returns Nothing when only one environment variable is missing" $ do+      setEnv "CONFIG_DB_URL" "hello"+      config <- fromEnv @Config+      config `shouldBe` Left (UnsetVariable "CONFIG_API_KEY")++    it "returns the configuration object when all necessary variables are set" $ do+      setEnv "CONFIG_DB_URL" "hello"+      setEnv "CONFIG_API_KEY" "world"+      config <- fromEnv+      config `shouldSatisfy` isRight+      unwrapEither config `shouldBe` Config "hello" "world"++gFromEnvSpec :: Spec+gFromEnvSpec =+    describe "gFromEnv" $ after_ clearEnvs $ do+        it "returns the configuration object when using a custom field label modifier" $ do+            setEnv "configDbURL" "hello"+            setEnv "configApiKey" "world"+            config <- gFromEnv (defaultEnvOpts { optsFieldLabelModifier = id })+            config `shouldSatisfy` isRight+            unwrapEither config `shouldBe` Config "hello" "world"++data Config = Config+  { configDbURL  :: !String+  , configApiKey :: !String+  }+  deriving (Eq, Show, Generic, FromEnv)++clearEnvs :: IO ()+clearEnvs = getEnvironment >>= mapM_ unsetEnv . fmap fst++unwrapEither :: Either a b -> b+unwrapEither (Left _)  = error "tried to unwrap left"+unwrapEither (Right b) = b