diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +## Dotenv 0.3.1.0 + +* Made interface more polymorphic so the functions works in any instance of + `MonadIO`, not only `IO`. This should reduce amount of lifting in some + cases. + +* Added `onMissingFile` helper to deal with possibly missing files. + +* Parser was rewritten to take full advantage of Megaparsec. + `hspec-megaparsec` is now used for testing of the parser. + +* Dropped support for GHC 7.4. + ## Dotenv 0.3.0.3 * Allow optparse-applicative 0.13 @@ -20,7 +33,7 @@ * Added function `parseFile` to read dotenv file without modifying the environment. Thanks to Daisuke Fujimura (Github: fujimura) for making this contribution. - + ## Dotenv 0.1.0.0 * First public release. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -10,6 +10,8 @@ import Configuration.Dotenv (loadFile) +import Control.Monad.IO.Class(MonadIO(..)) + import System.Process (system) import System.Exit (exitWith) @@ -41,8 +43,8 @@ <> short 'o' <> help "Specify this flag to override existing variables" ) -dotEnv :: Options -> IO () -dotEnv opts = do +dotEnv :: MonadIO m => Options -> m () +dotEnv opts = liftIO $ do mapM_ (loadFile (overload opts)) (files opts) - code <- system $ program opts + code <- system (program opts) exitWith code diff --git a/dotenv.cabal b/dotenv.cabal --- a/dotenv.cabal +++ b/dotenv.cabal @@ -1,5 +1,5 @@ name: dotenv -version: 0.3.0.3 +version: 0.3.1.0 synopsis: Loads environment variables from dotenv files homepage: https://github.com/stackbuilders/dotenv-hs description: @@ -44,17 +44,27 @@ cabal-version: >=1.10 bug-reports: https://github.com/stackbuilders/dotenv-hs/issues +flag dev + description: Turn on development settings. + manual: True + default: False + executable dotenv main-is: Main.hs - build-depends: base >=4.5 && <5.0 + build-depends: base >=4.6 && <5.0 , base-compat >= 0.4 - , dotenv >= 0.3.0.2 + , dotenv >= 0.3.1.0 , optparse-applicative >=0.11 && < 0.14 , megaparsec >= 5.0 && < 6.0 , process , text + , transformers >=0.4 && < 0.6 hs-source-dirs: app + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall default-language: Haskell2010 library @@ -62,14 +72,20 @@ , Configuration.Dotenv.Parse , Configuration.Dotenv.Text - build-depends: base >=4.5 && <5.0 + build-depends: base >=4.6 && <5.0 , base-compat >= 0.4 , megaparsec >= 5.0 && < 6.0 , text + , transformers >=0.4 && < 0.6 + , exceptions >= 0.8 && < 0.9 hs-source-dirs: src - default-language: Haskell2010 ghc-options: -Wall + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 test-suite dotenv-test type: exitcode-stdio-1.0 @@ -82,15 +98,21 @@ , Configuration.Dotenv.Text , Configuration.Dotenv.Parse - build-depends: base >=4.5 && <5.0 + build-depends: base >=4.6 && <5.0 , base-compat >= 0.4 - , dotenv >= 0.3.0.2 + , dotenv >= 0.3.1.0 , megaparsec >= 5.0 && < 6.0 , hspec , text + , transformers >=0.4 && < 0.6 + , exceptions >= 0.8 && < 0.9 + , hspec-megaparsec >= 0.2 && < 0.4 + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall default-language: Haskell2010 - ghc-options: -Wall source-repository head type: git diff --git a/spec/Configuration/Dotenv/ParseSpec.hs b/spec/Configuration/Dotenv/ParseSpec.hs --- a/spec/Configuration/Dotenv/ParseSpec.hs +++ b/spec/Configuration/Dotenv/ParseSpec.hs @@ -3,9 +3,8 @@ module Configuration.Dotenv.ParseSpec (main, spec) where import Configuration.Dotenv.Parse (configParser) - -import Test.Hspec (it, describe, shouldBe, Spec, hspec) - +import Test.Hspec (it, describe, Spec, hspec) +import Test.Hspec.Megaparsec (shouldParse, shouldFailOn) import Text.Megaparsec (ParseError, Dec, parse) main :: IO () @@ -14,81 +13,76 @@ spec :: Spec spec = describe "parse" $ do it "parses unquoted values" $ - parseConfig "FOO=bar" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO=bar" `shouldParse` [("FOO", "bar")] it "parses values with spaces around equal signs" $ do - parseConfig "FOO =bar" `shouldBe` Right [("FOO", "bar")] - parseConfig "FOO= bar" `shouldBe` Right [("FOO", "bar")] - parseConfig "FOO =\t bar" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO =bar" `shouldParse` [("FOO", "bar")] + parseConfig "FOO= bar" `shouldParse` [("FOO", "bar")] + parseConfig "FOO =\t bar" `shouldParse` [("FOO", "bar")] it "parses double-quoted values" $ - parseConfig "FOO=\"bar\"" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO=\"bar\"" `shouldParse` [("FOO", "bar")] it "parses single-quoted values" $ - parseConfig "FOO='bar'" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO='bar'" `shouldParse` [("FOO", "bar")] it "parses escaped double quotes" $ - parseConfig "FOO=\"escaped\\\"bar\"" `shouldBe` - Right [("FOO", "escaped\"bar")] + parseConfig "FOO=\"escaped\\\"bar\"" + `shouldParse` [("FOO", "escaped\"bar")] it "supports CRLF line breaks" $ - parseConfig "FOO=bar\r\nbaz=fbb" `shouldBe` - Right [("FOO", "bar"), ("baz", "fbb")] + parseConfig "FOO=bar\r\nbaz=fbb" + `shouldParse` [("FOO", "bar"), ("baz", "fbb")] it "parses empty values" $ - parseConfig "FOO=" `shouldBe` Right [("FOO", "")] + parseConfig "FOO=" `shouldParse` [("FOO", "")] it "does not parse if line format is incorrect" $ do - isLeft (parseConfig "lol$wut") `shouldBe` True - isLeft (parseConfig "KEY=\nVALUE") `shouldBe` True - isLeft (parseConfig "KEY\n=VALUE") `shouldBe` True + parseConfig `shouldFailOn` "lol$wut" + parseConfig `shouldFailOn` "KEY=\nVALUE" + parseConfig `shouldFailOn` "KEY\n=VALUE" it "expands newlines in quoted strings" $ - parseConfig "FOO=\"bar\nbaz\"" `shouldBe` Right [("FOO", "bar\nbaz")] + parseConfig "FOO=\"bar\nbaz\"" `shouldParse` [("FOO", "bar\nbaz")] it "does not parse variables with hyphens in the name" $ - isLeft (parseConfig "FOO-BAR=foobar") `shouldBe` True + parseConfig `shouldFailOn` "FOO-BAR=foobar" it "parses variables with \"_\" in the name" $ - parseConfig "FOO_BAR=foobar" `shouldBe` Right [("FOO_BAR", "foobar")] + parseConfig "FOO_BAR=foobar" `shouldParse` [("FOO_BAR", "foobar")] it "parses variables with digits after the first character" $ - parseConfig "FOO_BAR_12=foobar" `shouldBe` Right [("FOO_BAR_12", "foobar")] + parseConfig "FOO_BAR_12=foobar" `shouldParse` [("FOO_BAR_12", "foobar")] it "allows vertical spaces after a quoted variable" $ - parseConfig "foo='bar' " `shouldBe` Right [("foo", "bar")] + parseConfig "foo='bar' " `shouldParse` [("foo", "bar")] it "does not parse variable names beginning with a digit" $ - isLeft (parse configParser "null" "45FOO_BAR=foobar") `shouldBe` True + parseConfig `shouldFailOn` "45FOO_BAR=foobar" it "strips unquoted values" $ - parseConfig "foo=bar " `shouldBe` Right [("foo", "bar")] + parseConfig "foo=bar " `shouldParse` [("foo", "bar")] it "ignores empty lines" $ - parseConfig "\n \t \nfoo=bar\n \nfizz=buzz" `shouldBe` - Right [("foo", "bar"), ("fizz", "buzz")] + parseConfig "\n \t \nfoo=bar\n \nfizz=buzz" + `shouldParse` [("foo", "bar"), ("fizz", "buzz")] it "ignores inline comments after unquoted arguments" $ - parseConfig "FOO=bar # this is foo" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO=bar # this is foo" `shouldParse` [("FOO", "bar")] it "ignores inline comments after quoted arguments" $ - parseConfig "FOO=\"bar\" # this is foo" `shouldBe` Right [("FOO", "bar")] + parseConfig "FOO=\"bar\" # this is foo" `shouldParse` [("FOO", "bar")] it "allows \"#\" in quoted values" $ - parseConfig "foo=\"bar#baz\" # comment" `shouldBe` - Right [("foo", "bar#baz")] + parseConfig "foo=\"bar#baz\" # comment" + `shouldParse` [("foo", "bar#baz")] it "ignores comment lines" $ - parseConfig "\n\t \n\n # HERE GOES FOO \nfoo=bar" `shouldBe` - Right [("foo", "bar")] + parseConfig "\n\t \n\n # HERE GOES FOO \nfoo=bar" + `shouldParse` [("foo", "bar")] it "doesn't allow more configuration options after a quoted value" $ - isLeft (parse configParser "null" "foo='bar'baz='buz'") `shouldBe` True - - -isLeft :: Either a b -> Bool -isLeft ( Left _ ) = True -isLeft _ = False + parseConfig `shouldFailOn` "foo='bar'baz='buz'" parseConfig :: String -> Either (ParseError Char Dec) [(String, String)] -parseConfig = parse configParser "(unknown)" +parseConfig = parse configParser "" diff --git a/spec/Configuration/Dotenv/TextSpec.hs b/spec/Configuration/Dotenv/TextSpec.hs --- a/spec/Configuration/Dotenv/TextSpec.hs +++ b/spec/Configuration/Dotenv/TextSpec.hs @@ -1,12 +1,20 @@ +{-# LANGUAGE CPP #-} + module Configuration.Dotenv.TextSpec (main, spec) where import Configuration.Dotenv.Text (parseFile) import Test.Hspec -import System.Environment.Compat (lookupEnv, unsetEnv) import Control.Monad (liftM) +import System.Environment (lookupEnv) import qualified Data.Text as T + +#if MIN_VERSION_base(4,7,0) +import System.Environment (unsetEnv) +#else +import System.Environment.Compat (unsetEnv) +#endif {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} diff --git a/spec/Configuration/DotenvSpec.hs b/spec/Configuration/DotenvSpec.hs --- a/spec/Configuration/DotenvSpec.hs +++ b/spec/Configuration/DotenvSpec.hs @@ -1,12 +1,24 @@ +{-# LANGUAGE CPP #-} + module Configuration.DotenvSpec (main, spec) where -import Configuration.Dotenv (load, loadFile, parseFile) +import Configuration.Dotenv (load, loadFile, parseFile, onMissingFile) import Test.Hspec -import System.Environment.Compat (lookupEnv, setEnv, unsetEnv) +import System.Environment (lookupEnv) import Control.Monad (liftM) +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$)) +#endif + +#if MIN_VERSION_base(4,7,0) +import System.Environment (setEnv, unsetEnv) +#else +import System.Environment.Compat (setEnv, unsetEnv) +#endif + {-# ANN module "HLint: ignore Reduce duplication" #-} main :: IO () @@ -70,3 +82,13 @@ it "recognizes unicode characters" $ liftM (!! 1) (parseFile "spec/fixtures/.dotenv") `shouldReturn` ("UNICODE_TEST", "Manabí") + + describe "onMissingFile" $ after_ (unsetEnv "DOTENV") $ do + context "when target file is present" $ + it "loading works as usual" $ do + onMissingFile (loadFile True "spec/fixtures/.dotenv") (return ()) + lookupEnv "DOTENV" `shouldReturn` Just "true" + context "when target file is missing" $ + it "executes supplied handler instead" $ + onMissingFile (True <$ loadFile True "spec/fixtures/foo") (return False) + `shouldReturn` False diff --git a/src/Configuration/Dotenv.hs b/src/Configuration/Dotenv.hs --- a/src/Configuration/Dotenv.hs +++ b/src/Configuration/Dotenv.hs @@ -9,50 +9,78 @@ -- -- This module contains common functions to load and read dotenv files. -module Configuration.Dotenv (load, loadFile, parseFile) where +{-# LANGUAGE CPP #-} -import System.Environment.Compat (lookupEnv, setEnv) +module Configuration.Dotenv + ( load + , loadFile + , parseFile + , onMissingFile ) + where import Configuration.Dotenv.Parse (configParser) - +import Control.Monad.Catch +import Control.Monad.IO.Class (MonadIO(..)) +import System.Environment (lookupEnv) +import System.IO.Error (isDoesNotExistError) import Text.Megaparsec (parse) +#if MIN_VERSION_base(4,7,0) +import System.Environment (setEnv) +#else +import System.Environment.Compat (setEnv) +#endif + -- | Loads the given list of options into the environment. Optionally -- override existing variables with values from Dotenv files. load :: + MonadIO m => Bool -- ^ Override existing settings? -> [(String, String)] -- ^ List of values to be set in environment - -> IO () + -> m () load override = mapM_ (applySetting override) -- | Loads the options in the given file to the environment. Optionally -- override existing variables with values from Dotenv files. loadFile :: + MonadIO m => Bool -- ^ Override existing settings? -> FilePath -- ^ A file containing options to load into the environment - -> IO () + -> m () loadFile override f = load override =<< parseFile f -- | Parses the given dotenv file and returns values /without/ adding them to -- the environment. parseFile :: + MonadIO m => FilePath -- ^ A file containing options to read - -> IO [(String, String)] -- ^ Variables contained in the file + -> m [(String, String)] -- ^ Variables contained in the file parseFile f = do - contents <- readFile f + contents <- liftIO $ readFile f case parse configParser f contents of Left e -> error $ "Failed to read file" ++ show e Right options -> return options -applySetting :: Bool -> (String, String) -> IO () +applySetting :: MonadIO m => Bool -> (String, String) -> m () applySetting override (key, value) = if override then - setEnv key value + liftIO $ setEnv key value else do - res <- lookupEnv key + res <- liftIO $ lookupEnv key case res of - Nothing -> setEnv key value + Nothing -> liftIO $ setEnv key value Just _ -> return () + +-- | The helper allows to avoid exceptions in the case of missing files and +-- perform some action instead. +-- +-- @since 0.3.1.0 + +onMissingFile :: MonadCatch m + => m a -- ^ Action to perform that may fail because of missing file + -> m a -- ^ Action to perform if file is indeed missing + -> m a +onMissingFile f h = catchIf isDoesNotExistError f (const h) diff --git a/src/Configuration/Dotenv/Parse.hs b/src/Configuration/Dotenv/Parse.hs --- a/src/Configuration/Dotenv/Parse.hs +++ b/src/Configuration/Dotenv/Parse.hs @@ -12,83 +12,80 @@ -- information on the dotenv format can be found in the project README and the -- test suite. -module Configuration.Dotenv.Parse (configParser) where +{-# LANGUAGE CPP #-} -import Text.Megaparsec ((), anyChar, char, eof, manyTill, try) -import Text.Megaparsec.String (Parser) -import Text.Megaparsec.Char - (digitChar, letterChar, eol, noneOf, oneOf) +module Configuration.Dotenv.Parse (configParser) where import Control.Applicative -import Prelude - -import Data.Maybe (catMaybes) -import Control.Monad (liftM2) +import Control.Monad +import Text.Megaparsec +import Text.Megaparsec.String (Parser) +import qualified Text.Megaparsec.Lexer as L --- | Returns a parser for a Dotenv configuration file. Accepts key --- and value arguments separated by "=". Comments are allowed on --- lines by themselves and on blank lines. +-- | Returns a parser for a Dotenv configuration file. Accepts key and value +-- arguments separated by @=@. Comments in all positions are handled +-- appropriately. configParser :: Parser [(String, String)] -configParser = catMaybes <$> many envLine <* eof - - -envLine :: Parser (Maybe (String, String)) -envLine = (comment <|> blankLine) *> return Nothing <|> Just <$> optionLine - -blankLine :: Parser String -blankLine = many verticalSpace <* eol "blank line" +configParser = between scn eof (sepEndBy1 envLine (eol <* scn)) -optionLine :: Parser (String, String) -optionLine = liftM2 (,) - (many verticalSpace *> variableName <* variableValueSeparator) - value +-- | Parse a single environment variable assignment. +envLine :: Parser (String, String) +envLine = (,) <$> (lexeme variableName <* lexeme (char '=')) <*> lexeme value -- | Variables must start with a letter or underscore, and may contain -- letters, digits or '_' character after the first character. variableName :: Parser String -variableName = liftM2 (:) (letterChar <|> char '_') - (many (letterChar <|> char '_' <|> digitChar - unwords [ "valid non-leading shell variable character (alphanumeric," - , "digit or underscore)" ])) - - unwords [ "shell variable name (letter or underscore followed" - , "by alphanumeric characters or underscores)" ] +variableName = ((:) <$> firstChar <*> many otherChar) "variable name" + where + firstChar = char '_' <|> letterChar + otherChar = firstChar <|> digitChar +-- | Value: quoted or unquoted. value :: Parser String -value = quotedValue <|> unquotedValue "variable value" - -quotedValue :: Parser String -quotedValue = (quotedWith '\'' <|> quotedWith '\"') - <* (comment *> return () <|> many verticalSpace *> endOfLineOrInput) - "variable value surrounded with single or double quotes" - -unquotedValue :: Parser String -unquotedValue = - manyTill anyChar (comment <|> many verticalSpace <* endOfLineOrInput) +value = (quotedValue <|> unquotedValue) "variable value" + where + quotedValue = quotedWith '\'' <|> quotedWith '\"' + unquotedValue = many (noneOf "\'\" \t\n\r") --- | Based on a commented-string parser in: --- http://hub.darcs.net/navilan/XMonadTasks/raw/Data/Config/Lexer.hs +-- | Parse a value quoted with given character. quotedWith :: Char -> Parser String -quotedWith c = char c *> many chr <* (char c "closing quote character") +quotedWith q = between (char q) (char q) (many $ escapedChar <|> normalChar) + where + escapedChar = (char '\\' *> anyChar) "escaped character" + normalChar = noneOf (q : "\\") "unescaped character" - where chr = esc <|> noneOf [c] - esc = escape *> char c "escape character" +---------------------------------------------------------------------------- +-- Boilerplate and whitespace setup -comment :: Parser String -comment = try (many verticalSpace *> char '#') - *> manyTill anyChar endOfLineOrInput - "comment" +-- | Lexeme wrapper that takes care of consuming of white space. +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc +{-# INLINE lexeme #-} -endOfLineOrInput :: Parser () -endOfLineOrInput = eol *> return () <|> eof +-- | Space consumer. Consumes all white space including comments, but never +-- consumes newlines. +sc :: Parser () +sc = L.space (void spaceChar') skipLineComment empty +{-# INLINE sc #-} -variableValueSeparator :: Parser () -variableValueSeparator = - many verticalSpace *> (char '=' "variable-value separator character (=)") - *> many verticalSpace *> return () +-- | Just like 'sc' but also eats newlines. +scn :: Parser () +scn = L.space (void spaceChar) skipLineComment empty +{-# INLINE scn #-} -escape :: Parser Char -escape = char '\\' +-- | Just like 'spaceChar', but does not consume newlines. +spaceChar' :: Parser Char +spaceChar' = oneOf " \t" +{-# INLINE spaceChar' #-} -verticalSpace :: Parser Char -verticalSpace = oneOf " \t" +-- | Skip line comment and stop before newline character without consuming +-- it. +skipLineComment :: Parser () +#if MIN_VERSION_megaparsec(5,1,0) +skipLineComment = L.skipLineComment "#" +#else +skipLineComment = p >> void (manyTill anyChar n) + where p = string "#" + n = lookAhead (void newline) <|> eof +#endif +{-# INLINE skipLineComment #-} diff --git a/src/Configuration/Dotenv/Text.hs b/src/Configuration/Dotenv/Text.hs --- a/src/Configuration/Dotenv/Text.hs +++ b/src/Configuration/Dotenv/Text.hs @@ -16,9 +16,14 @@ import qualified Data.Text as T import Control.Arrow ((***)) +import Control.Monad (liftM) + +import Control.Monad.IO.Class (MonadIO(..)) + -- | Parses the given dotenv file and returns values /without/ adding them to -- the environment. parseFile :: + MonadIO m => FilePath -- ^ A file containing options to read - -> IO [(T.Text, T.Text)] -- ^ Variables contained in the file -parseFile f = map (T.pack *** T.pack) `fmap` Configuration.Dotenv.parseFile f + -> m [(T.Text, T.Text)] -- ^ Variables contained in the file +parseFile f = map (T.pack *** T.pack) `liftM` Configuration.Dotenv.parseFile f