diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,13 @@ +0.5 +=== + + * Added `char`. + + * Fixed masking parse errors with default values. (https://github.com/supki/envparse/issues/8) + + * Replaced `keep` with `sensitive`. All variables are kept in the environment after a successul parse + except those wrapped in `sensitive`. (https://github.com/supki/envparse/issues/9) + 0.4.1 ===== diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2017, Matvey Aksenov +Copyright (c) 2014-2019, Matvey Aksenov All rights reserved. diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,7 +1,5 @@ envparse ======== -[![Hackage](https://budueba.com/hackage/envparse)](https://hackage.haskell.org/package/envparse) -[![Build Status](https://secure.travis-ci.org/supki/envparse.png?branch=master)](https://travis-ci.org/supki/envparse) [optparse-applicative][0], but for environment variables diff --git a/envparse.cabal b/envparse.cabal --- a/envparse.cabal +++ b/envparse.cabal @@ -1,5 +1,5 @@ name: envparse -version: 0.4.1 +version: 0.5.0 synopsis: Parse environment variables description: Here's a simple example of a program that uses @envparse@'s parser: @@ -69,7 +69,7 @@ source-repository this type: git location: https://github.com/supki/envparse - tag: 0.4.1 + tag: 0.5.0 library default-language: @@ -102,10 +102,10 @@ base >= 4.6 && < 5 , containers + , envparse , hspec , text hs-source-dirs: - src test main-is: Spec.hs diff --git a/src/Env.hs b/src/Env.hs --- a/src/Env.hs +++ b/src/Env.hs @@ -59,6 +59,7 @@ , Var , Reader , str + , char , nonempty , splitOn , auto @@ -69,8 +70,7 @@ , Flag , HasHelp , help - , HasKeep - , keep + , sensitive , Help.helpDoc , Error(..) , Error.AsUnset(..) @@ -118,19 +118,19 @@ -- @ -- >>> parse ('Help.header' \"env-parse 0.2.0\") ('var' 'str' \"USER\" ('def' \"nobody\")) -- @ -parse :: (Help.Info Error -> Help.Info e) -> Parser e a -> IO a +parse :: Error.AsUnset e => (Help.Info Error -> Help.Info e) -> Parser e a -> IO a parse m = fmap (either (\_ -> error "absurd") id) . parseOr die m -- | Try to parse the environment -- -- Use this if simply dying on failure (the behavior of 'parse') is inadequate for your needs. -parseOr :: (String -> IO a) -> (Help.Info Error -> Help.Info e) -> Parser e b -> IO (Either a b) +parseOr :: Error.AsUnset e => (String -> IO a) -> (Help.Info Error -> Help.Info e) -> Parser e b -> IO (Either a b) parseOr onFailure helpMod parser = do b <- fmap (parsePure parser) getEnvironment #if __GLASGOW_HASKELL__ >= 708 for_ b $ \_ -> - eachUnsetVar parser unsetEnv + traverseSensitiveVar parser unsetEnv #endif traverseLeft (onFailure . Help.helpInfo (helpMod Help.defaultInfo) parser) b diff --git a/src/Env/Internal/Error.hs b/src/Env/Internal/Error.hs --- a/src/Env/Internal/Error.hs +++ b/src/Env/Internal/Error.hs @@ -16,7 +16,7 @@ -- -- * Variables that are unset in the environment. -- * Variables whose value is empty. --- * Variables whose value cannot be parsed using the 'Read' instance. +-- * Variables whose value cannot be parsed. data Error = UnsetError | EmptyError @@ -50,8 +50,7 @@ _ -> Nothing -- | The class of types that contain and can be constructed from --- the error returned from parsing variable whose value cannot --- be parsed using the 'Read' instance. +-- the error returned from parsing variable whose value cannot be parsed. class AsUnread e where unread :: String -> e tryUnread :: e -> Maybe String diff --git a/src/Env/Internal/Parser.hs b/src/Env/Internal/Parser.hs --- a/src/Env/Internal/Parser.hs +++ b/src/Env/Internal/Parser.hs @@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Env.Internal.Parser ( Parser(..) , VarF(..) , parsePure - , eachUnsetVar + , traverseSensitiveVar , Mod(..) , prefixed , var @@ -14,6 +15,7 @@ , defaultVar , Reader , str + , char , nonempty , splitOn , auto @@ -25,14 +27,13 @@ , Flag , HasHelp , help - , HasKeep - , keep + , sensitive ) where import Control.Applicative import Control.Arrow (left) import Control.Monad ((<=<)) -import Data.Foldable (for_) +import Data.Foldable (traverse_) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set @@ -50,21 +51,36 @@ -- | Try to parse a pure environment -parsePure :: Parser e a -> [(String, String)] -> Either [(String, e)] a +parsePure :: Error.AsUnset e => Parser e a -> [(String, String)] -> Either [(String, e)] a parsePure (Parser p) (Map.fromList -> env) = - toEither (runAlt go p) + toEither (runAlt (fromEither . left pure . go) p) where - go v = maybe id (\d x -> x <|> pure d) (varfDef v) (fromEither (readVar v env)) + go v@VarF {..} = + case lookupVar v env of + Left lookupErr -> + maybe (Left lookupErr) pure varfDef + Right val -> + readVar v val -eachUnsetVar :: Applicative m => Parser e a -> (String -> m b) -> m () -eachUnsetVar Parser {unParser} = - for_ (foldAlt (\VarF {varfKeep, varfName} -> if varfKeep then Set.empty else Set.singleton varfName) unParser) +traverseSensitiveVar :: Applicative m => Parser e a -> (String -> m b) -> m () +traverseSensitiveVar Parser {unParser} f = + traverse_ f sensitiveVars + where + sensitiveVars = + foldAlt (\VarF {varfSensitive, varfName} -> if varfSensitive then Set.singleton varfName else Set.empty) unParser -readVar :: VarF e a -> Map String String -> Either [(String, e)] a -readVar VarF {varfName, varfReader} = - left (pure . (\err -> (varfName, err))) . varfReader varfName +readVar :: VarF e a -> String -> Either (String, e) a +readVar VarF {..} = + addName varfName . varfReader +lookupVar :: Error.AsUnset e => VarF e a -> Map String String -> Either (String, e) String +lookupVar VarF {..} = + addName varfName . maybe (Left Error.unset) Right . Map.lookup varfName +addName :: String -> Either e a -> Either (String, e) a +addName name = + left ((,) name) + -- | An environment parser newtype Parser e a = Parser { unParser :: Alt (VarF e) a } deriving (Functor) @@ -86,14 +102,20 @@ prefixed pre = Parser . hoistAlt (\v -> v {varfName=pre ++ varfName v}) . unParser +-- | Mark the enclosed variables as sensitive to remove them from the environment +-- once they've been parsed successfully. +sensitive :: Parser e a -> Parser e a +sensitive = + Parser . hoistAlt (\v -> v {varfSensitive = True}) . unParser + data VarF e a = VarF - { varfName :: String - , varfReader :: String -> Map String String -> Either e a - , varfHelp :: Maybe String - , varfDef :: Maybe a - , varfHelpDef :: Maybe String - , varfKeep :: Bool + { varfName :: String + , varfReader :: Reader e a + , varfHelp :: Maybe String + , varfDef :: Maybe a + , varfHelpDef :: Maybe String + , varfSensitive :: Bool } deriving (Functor) liftVarF :: VarF e a -> Parser e a @@ -103,10 +125,6 @@ -- | An environment variable's value parser. Use @(<=<)@ and @(>=>)@ to combine these type Reader e a = String -> Either e a -lookupVar :: Error.AsUnset e => String -> Map String String -> Either e String -lookupVar name = - maybe (Left Error.unset) Right . Map.lookup name - -- | Parse a particular variable from the environment -- -- @ @@ -115,15 +133,15 @@ var :: Error.AsUnset e => Reader e a -> String -> Mod Var a -> Parser e a var r n (Mod f) = liftVarF $ VarF - { varfName = n - , varfReader = \name -> r <=< lookupVar name - , varfHelp = varHelp - , varfDef = varDef + { varfName = n + , varfReader = r + , varfHelp = varHelp + , varfDef = varDef , varfHelpDef = varHelpDef <*> varDef - , varfKeep = varKeep + , varfSensitive = varSensitive } where - Var {varHelp, varDef, varHelpDef, varKeep} = f defaultVar + Var {varHelp, varDef, varHelpDef, varSensitive} = f defaultVar -- | A flag that takes the active value if the environment variable -- is set and non-empty and the default value otherwise @@ -135,18 +153,18 @@ -> String -> Mod Flag a -> Parser e a flag f t n (Mod g) = liftVarF $ VarF - { varfName = n - , varfReader = \name env -> - pure $ case (nonempty :: Reader Error.Error String) =<< lookupVar name env of + { varfName = n + , varfReader = \val -> + pure $ case (nonempty :: Reader Error.Error String) val of Left _ -> f Right _ -> t - , varfHelp = flagHelp - , varfDef = Just f + , varfHelp = flagHelp + , varfDef = Just f , varfHelpDef = Nothing - , varfKeep = flagKeep + , varfSensitive = flagSensitive } where - Flag {flagHelp, flagKeep} = g defaultFlag + Flag {flagHelp, flagSensitive} = g defaultFlag -- | A simple boolean 'flag' -- @@ -170,6 +188,11 @@ auto s = case reads s of [(v, "")] -> Right v; _ -> Left (Error.unread (show s)) +-- | The single character string reader +char :: Error.AsUnread e => Reader e Char +char s = + case s of [c] -> Right c; _ -> Left (Error.unread "must be a one-character string") + -- | The reader that splits a string into a list of strings consuming the separator. splitOn :: Char -> Reader e [String] splitOn sep = Right . go @@ -205,22 +228,22 @@ -- | Environment variable metadata data Var a = Var - { varHelp :: Maybe String - , varHelpDef :: Maybe (a -> String) - , varDef :: Maybe a - , varKeep :: Bool + { varHelp :: Maybe String + , varHelpDef :: Maybe (a -> String) + , varDef :: Maybe a + , varSensitive :: Bool } defaultVar :: Var a defaultVar = Var - { varHelp = Nothing - , varDef = Nothing + { varHelp = Nothing + , varDef = Nothing , varHelpDef = Nothing - , varKeep = defaultKeep + , varSensitive = defaultSensitive } -defaultKeep :: Bool -defaultKeep = False +defaultSensitive :: Bool +defaultSensitive = False -- | The default value of the variable -- @@ -231,14 +254,14 @@ -- | Flag metadata data Flag a = Flag - { flagHelp :: Maybe String - , flagKeep :: Bool + { flagHelp :: Maybe String + , flagSensitive :: Bool } defaultFlag :: Flag a defaultFlag = Flag { flagHelp = Nothing - , flagKeep = defaultKeep + , flagSensitive = defaultSensitive } -- | Show the default value of the variable in help. @@ -266,19 +289,3 @@ help :: HasHelp t => String -> Mod t a help = Mod . setHelp - --- | A class of things that can be still kept in an environment when the --- parsing has been completed. -class HasKeep t where - setKeep :: t a -> t a - -instance HasKeep Var where - setKeep v = v {varKeep=True} - -instance HasKeep Flag where - setKeep v = v {flagKeep=True} - --- | Keep a variable. -keep :: HasKeep t => Mod t a -keep = - Mod setKeep diff --git a/test/Env/Internal/ParserSpec.hs b/test/Env/Internal/ParserSpec.hs --- a/test/Env/Internal/ParserSpec.hs +++ b/test/Env/Internal/ParserSpec.hs @@ -5,7 +5,7 @@ import Data.Text (Text) import Test.Hspec -import Env.Internal.Error (Error) +import Env.Internal.Error (Error, unread) import Env.Internal.Parser @@ -30,6 +30,16 @@ it "is nicely composable " $ (mapM auto <=< splitOn ',') "1,2,3" `shouldBe` ok ([1, 2, 3] :: [Int]) + + describe "char" $ do + it "one character" $ + char "f" `shouldBe` ok 'f' + + it "empty" $ + char "" `shouldBe` Left (unread "must be a one-character string" :: Error) + + it "many characters" $ + char "foo" `shouldBe` Left (unread "must be a one-character string" :: Error) ok :: a -> Either Error a ok = Right diff --git a/test/EnvSpec.hs b/test/EnvSpec.hs --- a/test/EnvSpec.hs +++ b/test/EnvSpec.hs @@ -59,6 +59,11 @@ it "'nonempty' weeds out variables set to the empty string" $ p (var (str <=< nonempty) "empty" mempty) `shouldBe` Nothing + context "var has a default value" $ + context "malformed value is passed by the user" $ + it "fails to parse" $ + p (var auto "foo" (def 4)) `shouldBe` (Nothing :: Maybe Int) + context "alternatives" $ do it "can look through a list of alternatives" $ p (asum @@ -87,29 +92,44 @@ Just "zygohistomorphic" #if __GLASGOW_HASKELL__ >= 708 - it "unsets parsed variables" $ do + it "does not unset parsed variables" $ do setEnv "FOO" "4" setEnv "BAR" "7" parse (header "hi") (liftA2 (+) (var auto "FOO" (help "a")) (var auto "BAR" (help "b"))) `shouldReturn` (11 :: Int) - lookupEnv "FOO" `shouldReturn` Nothing - lookupEnv "BAR" `shouldReturn` Nothing + lookupEnv "FOO" `shouldReturn` Just "4" + lookupEnv "BAR" `shouldReturn` Just "7" - context "some variables are marked as kept" $ - it "does not unset them" $ do + context "some variables are marked as sensitive" $ do + it "unsets them" $ do setEnv "FOO" "4" setEnv "BAR" "7" - parse (header "hi") (liftA2 (+) (var auto "FOO" (help "a" <> keep)) (var auto "BAR" (help "b"))) `shouldReturn` (11 :: Int) + parse (header "hi") (liftA2 (+) (var auto "FOO" (help "a")) (sensitive (var auto "BAR" (help "b")))) `shouldReturn` (11 :: Int) lookupEnv "FOO" `shouldReturn` Just "4" lookupEnv "BAR" `shouldReturn` Nothing - context "parsing fails" $ - it "does not unset any variables" $ do - setEnv "FOO" "4" - setEnv "BAR" "bar" - parse (header "hi") (liftA2 (+) (var auto "FOO" (help "a" <> keep)) (var auto "BAR" (help "b"))) `shouldThrow` anyException - lookupEnv "FOO" `shouldReturn` Just "4" - lookupEnv "BAR" `shouldReturn` Just "bar" + context "parsing fails" $ + it "does not unset any variables" $ do + setEnv "FOO" "4" + setEnv "BAR" "bar" + parse (header "hi") (liftA2 (+) (var auto "FOO" (help "a")) (sensitive (var auto "BAR" (help "b")))) `shouldThrow` anyException + lookupEnv "FOO" `shouldReturn` Just "4" + lookupEnv "BAR" `shouldReturn` Just "bar" + + context "unsetting multiple variables" $ + it "unsets them" $ do + setEnv "FOO" "4" + setEnv "BAR" "7" + parse (header "hi") (sensitive (liftA2 (+) (var auto "FOO" (help "a")) (var auto "BAR" (help "b")))) `shouldReturn` (11 :: Int) + lookupEnv "FOO" `shouldReturn` Nothing + lookupEnv "BAR" `shouldReturn` Nothing #endif + + context "#18" $ + it "behaves reasonably" $ do + let parser = var (fmap Just . auto) "FOO" (def Nothing) :: Parser Error (Maybe Int) + parsePure parser [("FOO", "4")] `shouldBe` Right (Just 4) + parsePure parser [("FOO", "str")] `shouldBe` Left [("FOO", UnreadError "\"str\"")] + parsePure parser [] `shouldBe` Right Nothing greaterThan5 :: AsUnread e => Reader e Int