envparse 0.2.2 → 0.3.0

raw patch · 9 files changed

+314/−127 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +12/−0
• LICENSE +1/−1
• envparse.cabal +7/−4
• example/CustomError.hs +79/−0
• example/Main.hs +5/−2
• src/Env.hs +28/−28
• src/Env/Error.hs +64/−0
• src/Env/Help.hs +82/−24
• src/Env/Parse.hs +36/−68

@@ -1,3 +1,15 @@+0.2.2+=====++  * Supported user-defined `Reader` errors. (https://github.com/supki/envparse/pull/4)++  * Widened the range of GHC versions to test the library with from 7.6–7.8 to 7.6–HEAD.++0.2.2+=====++  * Added `helpDoc`, a `Parser` pretty-printer for use in error messages.+ 0.2.1 ===== 

@@ -1,4 +1,4 @@-Copyright (c) 2014-2015, Matvey Aksenov+Copyright (c) 2014-2016, Matvey Aksenov  All rights reserved. 

@@ -1,5 +1,5 @@ name:                envparse-version:             0.2.2+version:             0.3.0 synopsis:            Parse environment variables description:   Here's a simple example of a program that uses @envparse@'s parser:@@ -19,7 +19,7 @@   &#x20;   main :: IO ()   main = do-  &#x20; Hello &#x7b; name, quiet &#x7d; <- hello+  &#x20; Hello &#x7b;name, quiet&#x7d; <- hello   &#x20; unless quiet $   &#x20;   putStrLn (\"Hello, \" ++ name ++ \"!\")   @@@ -45,7 +45,7 @@   &#x20; NAME is unset   @ homepage:            https://supki.github.io/envparse-license:             BSD2+license:             BSD3 license-file:        LICENSE author:              Matvey Aksenov maintainer:          matvey.aksenov@gmail.com@@ -53,10 +53,12 @@ category:            System build-type:          Simple cabal-version:       >= 1.10+tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3 extra-source-files:   README.markdown   CHANGELOG.markdown   example/Main.hs+  example/CustomError.hs  source-repository head   type:     git@@ -65,7 +67,7 @@ source-repository this   type:     git   location: https://github.com/supki/envparse-  tag:      0.2.2+  tag:      0.3.0  library   default-language:@@ -78,6 +80,7 @@   exposed-modules:     Env   other-modules:+    Env.Error     Env.Free     Env.Help     Env.Parse

@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+-- | Greetings for $NAMES+--+-- @+-- % NAME=a5579150 COUNT=0 runhaskell -isrc example/Main.hs+-- ...+-- COUNT must be > 0, but is 0+-- % NAME=a5579150 COUNT=3 runhaskell -isrc example/Main.hs+-- Hello, foo!+-- Hello, foo!+-- Hello, foo!+module Main (main) where++#if __GLASGOW_HASKELL__ < 710+import           Control.Applicative ((<$>), (<*>))+#endif+import           Control.Monad (replicateM_)+import           Env+import           Text.Printf (printf)+++data Hello = Hello { name :: String, count :: Int }++main :: IO ()+main = do+  Hello {name, count} <- hello+  replicateM_ count $+    putStrLn ("Hello, " ++ name ++ "!")++hello :: IO Hello+hello = Env.parse (header "envparse example" . handleError customErrorHandler) $ Hello+  <$> var nonempty            "NAME"  (help "Target for the greeting")+  <*> var (positive <=< auto) "COUNT" (help "How many times to greet?")++customErrorHandler :: ErrorHandler CustomError+customErrorHandler name err =+  case err of+    NonPositive n ->+      Just (printf "  %s must be > 0, but is %d" name n)+    _ ->+      defaultErrorHandler name err++positive :: Int -> Either CustomError Int+positive n+  | n <= 0 =+    Left (NonPositive n)+  | otherwise =+    return n++data CustomError+  = NonPositive Int+  | EnvError Error++-- * Boilerplate++instance AsUnset CustomError where+  unset =+    EnvError unset+  tryUnset err =+    case err of+      EnvError err' -> tryUnset err'+      _ -> Nothing++instance AsEmpty CustomError where+  empty =+    EnvError empty+  tryEmpty err =+    case err of+      EnvError err' -> tryEmpty err'+      _ -> Nothing++instance AsUnread CustomError where+  unread =+    EnvError . unread+  tryUnread err =+    case err of+      EnvError err' -> tryUnread err'+      _ -> Nothing

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} -- | Greetings for $NAME --@@ -9,16 +10,18 @@ -- @ module Main (main) where +#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>), (<*>))+#endif import Control.Monad (unless) import Env   data Hello = Hello { name :: String, quiet :: Bool } - main :: IO () main = do-  Hello { name, quiet } <- hello+  Hello {name, quiet} <- hello   unless quiet $     putStrLn ("Hello, " ++ name ++ "!") 

@@ -11,13 +11,13 @@ -- data Hello = Hello { name :: String, quiet :: Bool } -- -- hello :: IO Hello--- hello = Env.'parse' ('header' \"envparse example\") $+-- hello = Env.'parse' ('Help.header' \"envparse example\") $ --   Hello \<$\> 'var' ('str' <=< 'nonempty') \"NAME\"  ('help' \"Target for the greeting\") --         \<*\> 'switch'                 \"QUIET\" ('help' \"Whether to actually print the greeting\") -- -- main :: IO () -- main = do---   Hello { name, quiet } <- hello+--   Hello {name, quiet} <- hello --   unless quiet $ --     putStrLn (\"Hello, \" ++ name ++ \"!\") -- @@@ -47,10 +47,13 @@   , parseOr   , Parser   , Mod-  , Info-  , header-  , desc-  , footer+  , Help.Info+  , Help.header+  , Help.desc+  , Help.footer+  , Help.handleError+  , Help.ErrorHandler+  , Help.defaultErrorHandler   , prefixed   , var   , Var@@ -65,14 +68,14 @@   , Flag   , HasHelp   , help-  , helpDoc+  , Help.helpDoc+  , Error(..)+  , Error.AsUnset(..)+  , Error.AsEmpty(..)+  , Error.AsUnread(..)   -- * Re-exports   -- $re-exports-  , pure, (<$>), (<*>), (*>), (<*), optional-  , empty, (<|>)-  , (<=<), (>=>)-  , (<>), mempty, mconcat-  , asum+  , optional, (<=<), (>=>), (<>), asum   -- * Testing   -- $testing   , parsePure@@ -82,15 +85,18 @@ import           Control.Monad ((>=>), (<=<)) import           Data.Foldable (asum) #if __GLASGOW_HASKELL__ < 710-import           Data.Monoid (Monoid(..))-#endif+import           Data.Monoid (Monoid(..), (<>))+#else import           Data.Monoid ((<>))+#endif import           System.Environment (getEnvironment) import           System.Exit (exitFailure) import qualified System.IO as IO -import           Env.Help (helpInfo, helpDoc)+import qualified Env.Help as Help import           Env.Parse+import           Env.Error (Error)+import qualified Env.Error as Error  -- $re-exports -- External functions that may be useful to the consumer of the library@@ -99,32 +105,26 @@ -- Utilities to test—without dabbling in IO—that your parsers do -- what you want them to do - -- | Parse the environment or die -- -- Prints the help text and exits with @EXIT_FAILURE@ on encountering a parse error. -- -- @--- >>> parse ('header' \"env-parse 0.2.0\") ('var' 'str' \"USER\" ('def' \"nobody\"))+-- >>> parse ('Help.header' \"env-parse 0.2.0\") ('var' 'str' \"USER\" ('def' \"nobody\")) -- @-parse :: Mod Info a -> Parser a -> IO a-parse m = fmap (either (\_ -> error "absurd") id) . parseOr die m+parse :: (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) -> Mod Info b -> Parser b -> IO (Either a b)-parseOr f m p = traverseLeft f . parsePure m p =<< getEnvironment+parseOr :: (String -> IO a) -> (Help.Info Error -> Help.Info e) -> Parser e b -> IO (Either a b)+parseOr f g p =+  traverseLeft (f . Help.helpInfo (g Help.defaultInfo) p) . parsePure p =<< getEnvironment  die :: String -> IO a die m = do IO.hPutStrLn IO.stderr m; exitFailure---- | Try to parse a pure environment-parsePure :: Mod Info a -> Parser a -> [(String, String)] -> Either String a-parsePure (Mod f) p = mapLeft (helpInfo (f defaultInfo) p) . static p--mapLeft :: (a -> b) -> Either a t -> Either b t-mapLeft f = either (Left . f) Right  traverseLeft :: Applicative f => (a -> f b) -> Either a t -> f (Either b t) traverseLeft f = either (fmap Left . f) (pure . Right)

@@ -0,0 +1,64 @@+-- | This module contains an extensible error infrastructure.+--+-- Each kind of errors gets a separate type class which encodes+-- a 'Prism' (roughly a getter and a constructor). The 'Reader's, then,+-- have the constraints for precisely the set of errors they can return.+module Env.Error+  ( Error(..)+  , AsUnset(..)+  , AsEmpty(..)+  , AsUnread(..)+  ) where+++-- | The type of errors returned by @envparse@'s 'Reader's. These fall into 3+-- categories:+--+--   * Variables that are unset in the environment.+--   * Variables whose value is empty.+--   * Variables whose value cannot be parsed using the 'Read' instance.+data Error+  = UnsetError+  | EmptyError+  | UnreadError String+    deriving (Show, Eq)++-- | The class of types that contain and can be constructed from+-- the error returned from parsing unset variables.+class AsUnset e where+  unset :: e+  tryUnset :: e -> Maybe ()++instance AsUnset Error where+  unset = UnsetError+  tryUnset err =+    case err of+      UnsetError -> Just ()+      _ -> Nothing++-- | The class of types that contain and can be constructed from+-- the error returned from parsing variables whose value is empty.+class AsEmpty e where+  empty :: e+  tryEmpty :: e -> Maybe ()++instance AsEmpty Error where+  empty = EmptyError+  tryEmpty err =+    case err of+      EmptyError -> Just ()+      _ -> 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.+class AsUnread e where+  unread :: String -> e+  tryUnread :: e -> Maybe String++instance AsUnread Error where+  unread = UnreadError+  tryUnread err =+    case err of+      UnreadError msg -> Just msg+      _ -> Nothing

@@ -2,35 +2,46 @@ module Env.Help   ( helpInfo   , helpDoc+  , Info+  , ErrorHandler+  , defaultInfo+  , defaultErrorHandler+  , header+  , desc+  , footer+  , handleError   ) where +import           Data.Foldable (asum) import qualified Data.List as List import qualified Data.Map as Map-import           Data.Maybe (catMaybes)+import           Data.Maybe (catMaybes, mapMaybe) import           Data.Ord (comparing) +import           Env.Error (Error)+import qualified Env.Error as Error import           Env.Free-import           Env.Parse+import           Env.Parse hiding (Mod)  -helpInfo :: Info a -> Parser b -> [Error] -> String-helpInfo Info { infoHeader, infoDesc, infoFooter } p errors =+helpInfo :: Info e -> Parser e b -> [(String, e)] -> String+helpInfo Info {infoHeader, infoDesc, infoFooter, infoHandleError} 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-    ] ++ helpErrors errors+    ] ++ helpErrors infoHandleError errors --- | A pretty-printed list of recognized environment variables suitable for usage messages.-helpDoc :: Parser a -> String+-- | 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) -helpParserDoc :: Parser a -> [String]+helpParserDoc :: Parser e a -> [String] helpParserDoc = concat . Map.elems . foldAlt (\v -> Map.singleton (varfName v) (helpVarfDoc v)) . unParser -helpVarfDoc :: VarF a -> [String]+helpVarfDoc :: VarF e a -> [String] helpVarfDoc VarF { varfName, varfHelp, varfHelpDef } =   case varfHelp of     Nothing -> [indent 2 varfName]@@ -43,21 +54,6 @@      where k = length varfName            t = maybe h (\s -> h ++ " (default: " ++ s ++")") varfHelpDef -helpErrors :: [Error] -> [String]-helpErrors [] = []-helpErrors fs =-  [ "Parsing errors:"-  , List.intercalate "\n" (map helpError (List.sortBy (comparing varName) fs))-  ]--helpError :: Error -> String-helpError (ParseError n e)  = "  " ++ n ++ " cannot be parsed: " ++ e-helpError (ENoExistError n) = "  " ++ n ++ " is unset"--varName :: Error -> String-varName (ParseError n _)  = n-varName (ENoExistError n) = n- splitWords :: Int -> String -> [String] splitWords n = go [] 0 . words  where@@ -74,3 +70,65 @@  indent :: Int -> String -> String indent n s = replicate n ' ' ++ s++helpErrors :: ErrorHandler e -> [(String, e)] -> [String]+helpErrors _       [] = []+helpErrors handler fs =+  [ "Parsing errors:"+  , List.intercalate "\n" (mapMaybe (uncurry handler) (List.sortBy (comparing varName) fs))+  ]++-- | Parser's metadata+data Info e = Info+  { infoHeader      :: Maybe String+  , infoDesc        :: Maybe String+  , infoFooter      :: Maybe String+  , infoHandleError :: ErrorHandler e+  }++-- | Given a variable name and an error value, try to produce a useful error message+type ErrorHandler e = String -> e -> Maybe String++defaultInfo :: Info Error+defaultInfo = Info+  { infoHeader = Nothing+  , infoDesc = Nothing+  , infoFooter = Nothing+  , infoHandleError = defaultErrorHandler+  }++-- | Set the help text header (it usually includes the application's name and version)+header :: String -> Info e -> Info e+header h i = i {infoHeader=Just h}++-- | Set the short description+desc :: String -> Info e -> Info e+desc h i = i {infoDesc=Just h}++-- | Set the help text footer (it usually includes examples)+footer :: String -> Info e -> Info e+footer h i = i {infoFooter=Just h}++-- | An error handler+handleError :: ErrorHandler e -> Info x -> Info e+handleError handler i = i {infoHandleError=handler}++-- | The default error handler+defaultErrorHandler :: (Error.AsUnset e, Error.AsEmpty e, Error.AsUnread e) => ErrorHandler e+defaultErrorHandler name err =+  asum [handleUnsetError name err, handleEmptyError name err, handleUnreadError name err]++handleUnsetError :: Error.AsUnset e => ErrorHandler e+handleUnsetError name =+  fmap (\() -> indent 2 (name ++ " is unset")) . Error.tryUnset++handleEmptyError :: Error.AsEmpty e => ErrorHandler e+handleEmptyError name =+  fmap (\() -> indent 2 (name ++ " is empty")) . Error.tryEmpty++handleUnreadError :: Error.AsUnread e => ErrorHandler e+handleUnreadError name =+  fmap (\val -> indent 2 (name ++ " has value " ++ val ++ " that cannot be parsed")) . Error.tryUnread++varName :: (String, e) -> String+varName (n, _) = n

@@ -1,18 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} module Env.Parse   ( Parser(..)   , VarF(..)-  , static-  , Error(..)+  , parsePure   , Mod(..)-  , Info(..)-  , defaultInfo-  , header-  , desc-  , footer   , prefixed   , var   , Var(..)@@ -31,6 +26,7 @@   ) where  import           Control.Applicative+import           Control.Monad ((<=<)) import           Data.Map (Map) import qualified Data.Map as Map #if __GLASGOW_HASKELL__ < 710@@ -39,71 +35,68 @@ import           Data.String (IsString(..))  import           Env.Free+import qualified Env.Error as Error import           Env.Val  -static :: Parser b -> [(String, String)] -> Either [Error] b-static (Parser p) (Map.fromList -> env) =+-- | Try to parse a pure environment+parsePure :: Parser e b -> [(String, String)] -> Either [(String, e)] b+parsePure (Parser p) (Map.fromList -> env) =   toEither (runAlt go p)  where-  go v = maybe id (\d x -> x <|> pure d) (varfDef v) (fromEither (readVar v =<< lookupVar v env))--lookupVar :: VarF a -> Map String String -> Either [Error] String-lookupVar v = note [ENoExistError (varfName v)] . Map.lookup (varfName v)--readVar :: VarF a -> String -> Either [Error] a-readVar v = mapLeft (pure . ParseError (varfName v)) . varfReader v+  go v = maybe id (\d x -> x <|> pure d) (varfDef v) (fromEither (readVar v env)) -note :: a -> Maybe b -> Either a b-note a = maybe (Left a) Right+readVar :: VarF e a -> Map String String -> Either [(String, e)] a+readVar VarF {varfName, varfReader} =+  mapLeft (pure . (\err -> (varfName, err))) . varfReader varfName  mapLeft :: (a -> b) -> Either a t -> Either b t-mapLeft f = either (Left . f) Right+mapLeft f =+  either (Left . f) Right   -- | An environment parser-newtype Parser a = Parser { unParser :: Alt VarF a }+newtype Parser e a = Parser { unParser :: Alt (VarF e) a }     deriving (Functor) -instance Applicative Parser where+instance Applicative (Parser e) where   pure = Parser . pure   Parser f <*> Parser x = Parser (f <*> x) -instance Alternative Parser where+instance Alternative (Parser e) where   empty = Parser empty   Parser f <|> Parser x = Parser (f <|> x)  -- | The string to prepend to the name of every declared environment variable-prefixed :: String -> Parser a -> Parser a+prefixed :: String -> Parser e a -> Parser e a prefixed pre =   Parser . hoistAlt (\v -> v { varfName = pre ++ varfName v }) . unParser  -data Error-  = ParseError String String-  | ENoExistError String-    deriving (Show, Eq)--data VarF a = VarF+data VarF e a = VarF   { varfName    :: String-  , varfReader  :: Reader a+  , varfReader  :: String -> Map String String -> Either e a   , varfHelp    :: Maybe String   , varfDef     :: Maybe a   , varfHelpDef :: Maybe String   } deriving (Functor)  -- | An environment variable's value parser. Use @(<=<)@ and @(>=>)@ to combine these-type Reader a = String -> Either String a+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 -- -- @ -- >>> var 'str' \"EDITOR\" ('def' \"vim\" <> 'helpDef' show) -- @-var :: Reader a -> String -> Mod Var a -> Parser a+var :: Error.AsUnset e => Reader e a -> String -> Mod Var a -> Parser e a var r n (Mod f) = Parser . liftAlt $ VarF   { varfName    = n-  , varfReader  = r+  , varfReader  = \name -> r <=< lookupVar name   , varfHelp    = varHelp   , varfDef     = varDef   , varfHelpDef = varHelpDef <*> varDef@@ -116,12 +109,13 @@ -- -- /Note:/ this parser never fails. flag-  :: a -- ^ default value+  :: forall e a. (Error.AsUnset e, Error.AsEmpty e)+  => a -- ^ default value   -> a -- ^ active value-  -> String -> Mod Flag a -> Parser a+  -> String -> Mod Flag a -> Parser e a flag f t n (Mod g) = Parser . liftAlt $ VarF   { varfName    = n-  , varfReader  = Right . either (const f) (const t) . (nonempty :: Reader String)+  , varfReader  = \name -> Right . either (const f) (const t) . (nonempty :: Reader e String) <=< lookupVar name   , varfHelp    = flagHelp   , varfDef     = Just f   , varfHelpDef = Nothing@@ -132,20 +126,20 @@ -- | A simple boolean 'flag' -- -- /Note:/ the same caveats apply.-switch :: String -> Mod Flag Bool -> Parser Bool+switch :: (Error.AsUnset e, Error.AsEmpty e) => String -> Mod Flag Bool -> Parser e Bool switch = flag False True  -- | The trivial reader-str :: IsString s => Reader s+str :: IsString s => Reader e s str = Right . fromString  -- | The reader that accepts only non-empty strings-nonempty :: IsString s => Reader s-nonempty = fmap fromString . go where go [] = Left "a non-empty string is expected"; go xs = Right xs+nonempty :: (Error.AsEmpty e, IsString s) => Reader e s+nonempty = fmap fromString . go where go [] = Left Error.empty; go xs = Right xs  -- | The reader that uses the 'Read' instance of the type-auto :: Read a => Reader a-auto = \s -> case reads s of [(v, "")] -> Right v; _ -> Left (show s ++ " is an invalid value")+auto :: (Error.AsUnread e, Read a) => Reader e a+auto = \s -> case reads s of [(v, "")] -> Right v; _ -> Left (Error.unread (show s)) {-# ANN auto "HLint: ignore Redundant lambda" #-}  @@ -157,32 +151,6 @@   mempty = Mod id   mappend (Mod f) (Mod g) = Mod (g . f) ---- | Parser's metadata-data Info a = Info-  { infoHeader   :: Maybe String-  , infoDesc     :: Maybe String-  , infoFooter   :: Maybe String-  }--defaultInfo :: Info a-defaultInfo = Info-  { infoHeader   = Nothing-  , infoDesc     = Nothing-  , infoFooter   = Nothing-  }---- | A help text header (it usually includes an application name and version)-header :: String -> Mod Info a-header h = Mod (\i -> i { infoHeader = Just h })---- | A short program description-desc :: String -> Mod Info a-desc h = Mod (\i -> i { infoDesc = Just h })---- | A help text footer (it usually includes examples)-footer :: String -> Mod Info a-footer h = Mod (\i -> i { infoFooter = Just h })   -- | Environment variable metadata