envparse 0.4.1 → 0.6.0
raw patch · 11 files changed
Files
- CHANGELOG.markdown +27/−0
- LICENSE +1/−1
- README.markdown +1/−2
- envparse.cabal +3/−3
- src/Env.hs +7/−5
- src/Env/Generic.hs +4/−0
- src/Env/Internal/Error.hs +2/−3
- src/Env/Internal/Help.hs +35/−19
- src/Env/Internal/Parser.hs +78/−63
- test/Env/Internal/ParserSpec.hs +11/−1
- test/EnvSpec.hs +33/−13
CHANGELOG.markdown view
@@ -1,3 +1,30 @@+0.6.0+=====++A PVP-compliant re-release of 0.5.2 with no changes. (I missed a breaking change back in 0.5.1.)++0.5.2+=====++ * Added `eitherReader`. (https://github.com/supki/envparse/pull/24)++0.5.1+=====++ * Added configurable maximum info block width (https://github.com/supki/envparse/pull/21).++ * Added `instance (Field e a, ...) => Field e (Maybe a)` for generic environment parsing. (https://github.com/supki/envparse/pull/16)++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 =====
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2014-2017, Matvey Aksenov+Copyright (c) 2014-2019, Matvey Aksenov All rights reserved.
README.markdown view
@@ -1,7 +1,6 @@ envparse ========-[](https://hackage.haskell.org/package/envparse)-[](https://travis-ci.org/supki/envparse)+[](https://github.com/supki/envparse/actions/workflows/ci.yml) [optparse-applicative][0], but for environment variables
envparse.cabal view
@@ -1,5 +1,5 @@ name: envparse-version: 0.4.1+version: 0.6.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.6.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
src/Env.hs view
@@ -51,6 +51,7 @@ , Help.header , Help.desc , Help.footer+ , Help.widthMax , Help.handleError , Help.ErrorHandler , Help.defaultErrorHandler@@ -58,7 +59,9 @@ , var , Var , Reader+ , eitherReader , str+ , char , nonempty , splitOn , auto@@ -69,8 +72,7 @@ , Flag , HasHelp , help- , HasKeep- , keep+ , sensitive , Help.helpDoc , Error(..) , Error.AsUnset(..)@@ -118,19 +120,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
src/Env/Generic.hs view
@@ -241,6 +241,10 @@ instance (Env.AsUnset e, Env.AsUnread e) => Field e Double +-- | Optional parser.+instance (Field e a, Env.AsUnset e, Env.AsUnread e) => Field e (Maybe a) where+ field name help = Env.optional (field name help)+ -- | Uses the 'String' value verbatim. instance Env.AsUnset e => Field e String where field name help =
src/Env/Internal/Error.hs view
@@ -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
src/Env/Internal/Help.hs view
@@ -9,6 +9,7 @@ , header , desc , footer+ , widthMax , handleError ) where @@ -25,35 +26,42 @@ helpInfo :: Info e -> Parser e b -> [(String, e)] -> String-helpInfo Info {infoHeader, infoDesc, infoFooter, infoHandleError} p errors =+helpInfo Info {infoHeader, infoDesc, infoFooter, infoHandleError, infoWidthMax} p errors = List.intercalate "\n\n" $ catMaybes [ infoHeader- , fmap (List.intercalate "\n" . splitWords 50) infoDesc- , Just (helpDoc p)- , fmap (List.intercalate "\n" . splitWords 50) infoFooter+ , fmap (List.intercalate "\n" . splitWords infoWidthMax) infoDesc+ , Just (helpDoc infoWidthMax p)+ , fmap (List.intercalate "\n" . splitWords infoWidthMax) infoFooter ] ++ helpErrors infoHandleError errors -- | A pretty-printed list of recognized environment variables suitable for usage messages-helpDoc :: Parser e a -> String-helpDoc p =- List.intercalate "\n" ("Available environment variables:\n" : helpParserDoc p)+helpDoc :: Int -> Parser e a -> String+helpDoc widthMax p =+ List.intercalate "\n" ("Available environment variables:\n" : helpParserDoc widthMax p) -helpParserDoc :: Parser e a -> [String]-helpParserDoc =- concat . Map.elems . foldAlt (\v -> Map.singleton (varfName v) (helpVarfDoc v)) . unParser+helpParserDoc :: Int -> Parser e a -> [String]+helpParserDoc widthMax =+ concat . Map.elems . foldAlt (\v -> Map.singleton (varfName v) (helpVarfDoc widthMax v)) . unParser -helpVarfDoc :: VarF e a -> [String]-helpVarfDoc VarF {varfName, varfHelp, varfHelpDef} =+helpVarfDoc :: Int -> VarF e a -> [String]+helpVarfDoc widthMax VarF {varfName, varfHelp, varfHelpDef} = case varfHelp of- Nothing -> [indent 2 varfName]+ Nothing -> [indent vo varfName] Just h- | k > 15 -> indent 2 varfName : map (indent 25) (splitWords 30 t)+ | k > nameWidthMax ->+ indent vo varfName : map (indent ho) (splitWords (widthMax - ho) t) | otherwise ->- case zipWith indent (23 - k : repeat 25) (splitWords 30 t) of- (x : xs) -> (indent 2 varfName ++ x) : xs- [] -> [indent 2 varfName]- where k = length varfName- t = maybe h (\s -> h ++ " (default: " ++ s ++")") varfHelpDef+ case zipWith indent (ho - vo - k : repeat ho) (splitWords (widthMax - ho) t) of+ (x : xs) -> (indent vo varfName ++ x) : xs+ [] -> [indent vo varfName]+ where+ k = length varfName+ t = maybe h (\s -> h ++ " (default: " ++ s ++")") varfHelpDef+ where+ -- The longest variable name that fits the compact view.+ nameWidthMax = ho - vo - 1 {- the space between the variable name and the help text -}+ vo = 2 -- variable name offset+ ho = 25 -- help text offset splitWords :: Int -> String -> [String] splitWords n =@@ -87,6 +95,7 @@ , infoDesc :: Maybe String , infoFooter :: Maybe String , infoHandleError :: ErrorHandler e+ , infoWidthMax :: Int } -- | Given a variable name and an error value, try to produce a useful error message@@ -98,6 +107,7 @@ , infoDesc = Nothing , infoFooter = Nothing , infoHandleError = defaultErrorHandler+ , infoWidthMax = 80 } -- | Set the help text header (it usually includes the application's name and version)@@ -111,6 +121,12 @@ -- | Set the help text footer (it usually includes examples) footer :: String -> Info e -> Info e footer h i = i {infoFooter=Just h}++-- | Set the max info width.+--+-- /Note:/ It will be set to 26 columns if a smaller value is passed.+widthMax :: Int -> Info e -> Info e+widthMax n i = i {infoWidthMax=max 26 n} -- | An error handler handleError :: ErrorHandler e -> Info x -> Info e
src/Env/Internal/Parser.hs view
@@ -1,19 +1,22 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Env.Internal.Parser ( Parser(..) , VarF(..) , parsePure- , eachUnsetVar+ , traverseSensitiveVar , Mod(..) , prefixed , var , Var(..) , defaultVar , Reader+ , eitherReader , str+ , char , nonempty , splitOn , auto@@ -25,14 +28,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 +52,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 +103,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,9 +126,12 @@ -- | 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+-- | Create a 'Reader' from a simple parser function+eitherReader :: Error.AsUnread e => (String -> Either String a) -> Reader e a+eitherReader f s =+ left (Error.unread . suffix) (f s)+ where+ suffix x = x <> ": " <> show s -- | Parse a particular variable from the environment --@@ -115,15 +141,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 +161,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 +196,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 +236,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 +262,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 +297,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
test/Env/Internal/ParserSpec.hs view
@@ -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
test/EnvSpec.hs view
@@ -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