load-env-0.2.1.0/doctest/0000755000000000000000000000000013470561770013222 5ustar0000000000000000load-env-0.2.1.0/src/0000755000000000000000000000000013500204517012327 5ustar0000000000000000load-env-0.2.1.0/src/LoadEnv/0000755000000000000000000000000013470561770013674 5ustar0000000000000000load-env-0.2.1.0/test/0000755000000000000000000000000013500205070012512 5ustar0000000000000000load-env-0.2.1.0/test/LoadEnv/0000755000000000000000000000000013470561770014064 5ustar0000000000000000load-env-0.2.1.0/src/LoadEnv.hs0000644000000000000000000000623613500204517014222 0ustar0000000000000000-- | -- -- This is effectively a port of dotenv, whose README explains it best: -- -- > Storing configuration in the environment is one of the tenets of a -- > twelve-factor app. Anything that is likely to change between deployment -- > environments–such as resource handles for databases or credentials for -- > external services–should be extracted from the code into environment -- > variables. -- > -- > But it is not always practical to set environment variables on development -- > machines or continuous integration servers where multiple projects are run. -- > dotenv loads variables from a .env file into ENV when the environment is -- > bootstrapped. -- -- -- -- This library exposes functions for doing just that. -- module LoadEnv ( loadEnv , loadEnvFrom , loadEnvFromAbsolute ) where import Control.Monad (unless, (<=<)) import Data.Bool (bool) import Data.Foldable (for_, traverse_) import Data.List (inits) import Data.Maybe (isJust) import LoadEnv.Parse import System.Directory (doesFileExist, findFile, getCurrentDirectory, makeAbsolute) import System.Environment (lookupEnv, setEnv) import System.FilePath (isRelative, joinPath, splitDirectories) import Text.Parsec.String (parseFromFile) -- | @'loadEnvFrom' \".env\"@ loadEnv :: IO () loadEnv = loadEnvFrom ".env" -- | Parse the given file and set variables in the process's environment -- -- Variables can be declared in the following form: -- -- > FOO=bar -- > FOO="bar" -- > FOO='bar' -- -- Declarations may optionally be preceded by @\"export \"@, which will be -- ignored. Trailing whitespace is ignored. Quotes inside quoted values or -- spaces in unquoted values must be escaped with a backlash. Invalid lines are -- silently ignored. -- -- __NOTE__: If the file-name is relative, the directory tree will be traversed -- up to @\/@ looking for the file in each parent. Use @'loadEnvFromAbsolute'@ -- to avoid this. -- loadEnvFrom :: FilePath -> IO () loadEnvFrom name = do mFile <- if isRelative name then flip findFile name . takeDirectories =<< getCurrentDirectory else bool Nothing (Just name) <$> doesFileExist name for_ mFile $ \file -> do result <- parseFromFile parseEnvironment file either print (traverse_ $ uncurry defaultEnv) result defaultEnv :: String -> String -> IO () defaultEnv k v = do exists <- isJust <$> lookupEnv k unless exists $ setEnv k v -- | @'loadEnvFrom'@, but don't traverse up the directory tree loadEnvFromAbsolute :: FilePath -> IO () loadEnvFromAbsolute = loadEnvFrom <=< makeAbsolute -- | Get all directory names of a directory -- -- Includes itself as the first element of the output. -- -- >>> takeDirectories "/foo/bar/baz" -- ["/foo/bar/baz","/foo/bar","/foo","/"] -- -- Leading path-separator is meaningful, and determines if the root directory is -- included or not. -- -- >>> takeDirectories "foo/bar/baz" -- ["foo/bar/baz","foo/bar","foo"] -- -- Trailing path-separator is not meaningful. -- -- >>> takeDirectories "/foo/bar/baz/" -- ["/foo/bar/baz","/foo/bar","/foo","/"] -- takeDirectories :: FilePath -> [FilePath] takeDirectories = map joinPath . reverse . drop 1 . inits . splitDirectories load-env-0.2.1.0/src/LoadEnv/Parse.hs0000644000000000000000000000421513470561770015304 0ustar0000000000000000module LoadEnv.Parse ( Environment , Variable , parseEnvironment , parseVariable ) where import Control.Monad (void) import Data.Maybe (catMaybes) import Text.Parsec import Text.Parsec.String type Environment = [Variable] type Variable = (String, String) parseEnvironment :: Parser Environment parseEnvironment = catMaybes <$> many parseLine parseLine :: Parser (Maybe Variable) parseLine = possibly parseVariable possibly :: Parser a -> Parser (Maybe a) possibly p = try (Just <$> p) <|> ignored where ignored = Nothing <$ manyTill anyToken newline parseVariable :: Parser Variable parseVariable = do optional $ between spaces spaces $ string "export" i <- identifier v <- char '=' *> value void $ many $ oneOf " \t" void newline pure (i, v) -- Environment variable names used by the utilities in the Shell and Utilities -- volume of POSIX.1-2017 consist solely of uppercase letters, digits, -- and the ( '_' ) from the characters defined in Portable -- Character Set and do not begin with a digit. Other characters may be -- permitted by an implementation; applications shall tolerate the presence -- of such names. Uppercase and lowercase letters shall retain their unique -- identities and shall not be folded together. The name space of environment -- variable names containing lowercase letters is reserved for applications. -- Applications can define any environment variables with names from this name -- space without modifying the behavior of the standard utilities. -- -- -- identifier :: Parser String identifier = do x <- upper <|> lower <|> underscore ys <- many $ upper <|> lower <|> digit <|> underscore pure (x:ys) where underscore = char '_' value :: Parser String value = quotedValue <|> unquotedValue <|> pure "" quotedValue :: Parser String quotedValue = do q <- oneOf "'\"" manyTill (try (escaped q) <|> anyToken) (char q) unquotedValue :: Parser String unquotedValue = many1 $ try (escaped ' ') <|> noneOf "\"' \n" escaped :: Char -> Parser Char escaped c = c <$ string ("\\" ++ [c]) load-env-0.2.1.0/test/Spec.hs0000644000000000000000000000005413470561770013761 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} load-env-0.2.1.0/test/LoadEnv/ParseSpec.hs0000644000000000000000000001054113470561770016306 0ustar0000000000000000module LoadEnv.ParseSpec ( spec ) where import LoadEnv.Parse import Test.Hspec import Text.Parsec (parse) spec :: Spec spec = do describe "parseEnvironment" $ do it "parses variable declarations among comments and blank lines" $ do let env = unlines [ "# An environment file" , "FOO=bar" , "BAZ=\"bat\"" , "BAT=\"multi-" , "pass" , "\"" , "" , "# vim ft:sh:" ] parse parseEnvironment "" env `shouldBe` Right [ ("FOO", "bar") , ("BAZ", "bat") , ("BAT", "multi-\npass\n") ] it "parses an empty file into an empty list of variables" $ do parse parseEnvironment "" "" `shouldBe` Right [] describe "parseVariable" $ do it "reads unquoted variables" $ parse parseVariable "" "FOO=bar\n" `shouldBe` Right ("FOO", "bar") it "reads quoted variables" $ do parse parseVariable "" "FOO=\"bar\"\n" `shouldBe` Right ("FOO", "bar") parse parseVariable "" "FOO='bar'\n" `shouldBe` Right ("FOO", "bar") it "allows newlines in quoted variables" $ do parse parseVariable "" "FOO=\"foo\nbar\"\n" `shouldBe` Right ("FOO", "foo\nbar") it "handles empty values" $ parse parseVariable "" "FOO=\n" `shouldBe` Right ("FOO", "") it "handles empty quoted values" $ do parse parseVariable "" "FOO=\"\"\n" `shouldBe` Right ("FOO", "") parse parseVariable "" "FOO=''\n" `shouldBe` Right ("FOO", "") it "handles underscored variables" $ parse parseVariable "" "FOO_BAR=baz\n" `shouldBe` Right ("FOO_BAR", "baz") it "treats leading spaces as invalid" $ parse parseVariable "" " FOO=bar\n" `shouldContainError` "unexpected \"F\"" it "treats spaces around equals as invalid" $ parse parseVariable "" "FOO = bar\n" `shouldContainError` "unexpected \" \"" it "treats unquoted spaces as invalid" $ parse parseVariable "" "FOO=bar baz\n" `shouldContainError` "unexpected \"b\"" it "treats unbalanced quotes as invalid" $ do parse parseVariable "" "FOO=\"bar\n" `shouldContainError` "unexpected end of input" parse parseVariable "" "FOO='bar\n" `shouldContainError` "unexpected end of input" parse parseVariable "" "FOO=bar\"\n" `shouldContainError` "unexpected \"\\\"\"" parse parseVariable "" "FOO=bar'\n" `shouldContainError` "unexpected \"\'\"" it "handles escaped quotes" $ do parse parseVariable "" "FOO=\"bar\\\"baz\"\n" `shouldBe` Right ("FOO", "bar\"baz") parse parseVariable "" "FOO='bar\\'baz'\n" `shouldBe` Right ("FOO", "bar'baz") it "handles escaped spaces" $ parse parseVariable "" "FOO=bar\\ baz\n" `shouldBe` Right ("FOO", "bar baz") it "discards any lines using `export'" $ parse parseVariable "" "export FOO=bar\n" `shouldBe` Right ("FOO", "bar") it "requires valid environment variable identifies" $ do parse parseVariable "" "S3_KEY=abc123\n" `shouldBe` Right ("S3_KEY", "abc123") parse parseVariable "" "_S3_KEY=abc123\n" `shouldBe` Right ("_S3_KEY", "abc123") parse parseVariable "" "S3_key=abc123\n" `shouldBe` Right ("S3_key", "abc123") parse parseVariable "" "s3_key=abc123\n" `shouldBe` Right ("s3_key", "abc123") parse parseVariable "" "S3~KEY=abc123\n" `shouldContainError` "unexpected \"~\"" parse parseVariable "" "S3-KEY=abc123\n" `shouldContainError` "unexpected \"-\"" parse parseVariable "" "3_KEY=abc123\n" `shouldContainError` "unexpected \"3\"" shouldContainError :: Show a => Either a b -> String -> Expectation v `shouldContainError` msg = either (\e -> show e `shouldContain` msg) (\_ -> expectationFailure "Expected no parse") v load-env-0.2.1.0/test/LoadEnvSpec.hs0000644000000000000000000000476513500205070015225 0ustar0000000000000000module LoadEnvSpec ( spec ) where import Control.Monad (when) import LoadEnv import System.Directory import System.Environment import System.IO.Temp import Test.Hspec spec :: Spec spec = after_ cleanup $ do describe "loadEnv" $ do it "loads environment variables from ./.env if present" $ do writeFile envFile $ unlines [ "FOO=\"bar\"" , "BAZ=\"bat\"" ] loadEnvFrom envFile mbar <- lookupEnv "FOO" mbat <- lookupEnv "BAZ" mbar `shouldBe` Just "bar" mbat `shouldBe` Just "bat" it "does not override pre-existing variables" $ do writeFile envFile $ unlines ["FOO=bar"] setEnv "FOO" "baz" loadEnvFrom envFile mbar <- lookupEnv "FOO" mbar `shouldBe` Just "baz" it "does not fail if the file is not present" $ do loadEnvFrom "i-do-not-exist" return () describe "loadEnvFrom" $ do it "traverses up the directory tree" $ do inTempDirectory $ do writeFile ".env.test" "FOO=\"bar\"\n" inNewDirectory "foo/bar/baz" $ do loadEnvFrom ".env.test" lookupEnv "FOO" `shouldReturn` Just "bar" it "loads only the nearest file" $ do inTempDirectory $ do writeFile ".env.test" "FOO=\"bar\"\n" inNewDirectory "foo/bar" $ do writeFile ".env.test" "BAR=\"baz\"\n" inNewDirectory "baz/bat" $ do loadEnvFrom ".env.test" lookupEnv "BAR" `shouldReturn` Just "baz" lookupEnv "FOO" `shouldReturn` Nothing describe "loadEnvFromAbsolute" $ do it "does not traverse up the directory tree" $ do inTempDirectory $ do writeFile ".env.test" "FOO=\"bar\"\n" inNewDirectory "foo/bar/baz" $ do loadEnvFromAbsolute ".env.test" lookupEnv "FOO" `shouldReturn` Nothing inTempDirectory :: IO a -> IO a inTempDirectory f = withSystemTempDirectory "" $ \tmp -> withCurrentDirectory tmp f inNewDirectory :: FilePath -> IO a -> IO a inNewDirectory path f = do createDirectoryIfMissing True path withCurrentDirectory path f cleanup :: IO () cleanup = do unsetEnv "FOO" unsetEnv "BAR" e <- doesFileExist envFile when e $ removeFile envFile envFile :: FilePath envFile = "/tmp/load-env-test-file" load-env-0.2.1.0/doctest/Main.hs0000644000000000000000000000013613470561770014442 0ustar0000000000000000module Main (main) where import Test.DocTest main :: IO () main = doctest ["-isrc", "src/"] load-env-0.2.1.0/LICENSE0000644000000000000000000000276013470561770012567 0ustar0000000000000000Copyright (c) 2017, Pat Brisbin 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 Pat Brisbin 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. load-env-0.2.1.0/Setup.hs0000644000000000000000000000005613470561770013212 0ustar0000000000000000import Distribution.Simple main = defaultMain load-env-0.2.1.0/load-env.cabal0000644000000000000000000000351213500204750014231 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- -- hash: cb9cf61d4827d4897e0bb920005dafac784c77c15cae85f88bb288ea97ef2613 name: load-env version: 0.2.1.0 synopsis: Load environment variables from a file. description: Parse a .env file and load any declared variables into the current process's environment. This allows for a .env file to specify development-friendly defaults for configuration values normally set in the deployment environment. category: Configuration homepage: https://github.com/pbrisbin/load-env#readme bug-reports: https://github.com/pbrisbin/load-env/issues author: Pat Brisbin maintainer: Pat Brisbin license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md CHANGELOG.md source-repository head type: git location: https://github.com/pbrisbin/load-env library exposed-modules: LoadEnv LoadEnv.Parse other-modules: Paths_load_env hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.8.0 && <5 , directory , filepath , parsec default-language: Haskell2010 test-suite doctest type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Paths_load_env hs-source-dirs: doctest ghc-options: -Wall build-depends: base >=4.8.0 && <5 , doctest default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: LoadEnv.ParseSpec LoadEnvSpec Paths_load_env hs-source-dirs: test ghc-options: -Wall build-depends: base >=4.8.0 && <5 , directory , hspec , load-env , parsec , temporary default-language: Haskell2010 load-env-0.2.1.0/README.md0000644000000000000000000000226313470561770013037 0ustar0000000000000000# load-env [![Build Status](https://circleci.com/gh/pbrisbin/load-env/tree/master.png)](https://circleci.com/gh/pbrisbin/load-env) This is effectively a port of [dotenv][], whose README explains it best: > Storing configuration in the environment is one of the tenets of a > twelve-factor app. Anything that is likely to change between deployment > environments–such as resource handles for databases or credentials for > external services–should be extracted from the code into environment > variables. > > But it is not always practical to set environment variables on development > machines or continuous integration servers where multiple projects are run. > dotenv loads variables from a .env file into ENV when the environment is > bootstrapped. [dotenv]: https://github.com/bkeepers/dotenv This library exposes functions for doing just that. ## Usage ```haskell import LoadEnv import System.Environment (lookupEnv) main :: IO () main = do loadEnv print =<< lookupEnv "FOO" ``` ```console % cat .env FOO=bar % runhaskell main.hs Just "bar" ``` ## Development & Test ``` stack setup stack build --pedantic --test ``` --- [CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) load-env-0.2.1.0/CHANGELOG.md0000644000000000000000000000376013500205705013357 0ustar0000000000000000## [*Unreleased*](https://github.com/pbrisbin/load-env/compare/v0.2.1.0...master) None ## [v0.2.1.0](https://github.com/pbrisbin/load-env/compare/v0.2.0.2...v0.2.1.0) - Don't override values already set in the environment Given a hypothetical program `load-env`, which uses one of our `loadEnv` functions on `stdin`: Previously, ``` FOO=bar load-env <