envparse-0.3.0: Parse environment variables

Safe HaskellSafe
LanguageHaskell2010

Env

Contents

Description

Here's a simple example of a program that uses envparse's parser:

module Main (main) where

import Control.Monad (unless)
import Env

data Hello = Hello { name :: String, quiet :: Bool }

hello :: IO Hello
hello = Env.parse (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
  unless quiet $
    putStrLn ("Hello, " ++ name ++ "!")

The NAME environment variable is mandatory and contains the name of the person to greet. QUIET, on the other hand, is an optional boolean flag, false by default, that decides whether the greeting should be silent.

If the NAME variable is undefined in the environment then running the program will result in the following help text:

envparse example

Available environment variables:

  NAME                   Target for the greeting
  QUIET                  Whether to actually print the
                         greeting

Parsing errors:

  NAME is unset

Synopsis

Documentation

parse :: (Info Error -> Info e) -> Parser e a -> IO a Source #

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"))

parseOr :: (String -> IO a) -> (Info Error -> Info e) -> Parser e b -> IO (Either a b) Source #

Try to parse the environment

Use this if simply dying on failure (the behavior of parse) is inadequate for your needs.

data Parser e a Source #

An environment parser

Instances

Functor (Parser e) Source # 

Methods

fmap :: (a -> b) -> Parser e a -> Parser e b #

(<$) :: a -> Parser e b -> Parser e a #

Applicative (Parser e) Source # 

Methods

pure :: a -> Parser e a #

(<*>) :: Parser e (a -> b) -> Parser e a -> Parser e b #

(*>) :: Parser e a -> Parser e b -> Parser e b #

(<*) :: Parser e a -> Parser e b -> Parser e a #

Alternative (Parser e) Source # 

Methods

empty :: Parser e a #

(<|>) :: Parser e a -> Parser e a -> Parser e a #

some :: Parser e a -> Parser e [a] #

many :: Parser e a -> Parser e [a] #

data Mod t a Source #

This represents a modification of the properties of a particular Parser. Combine them using the Monoid instance.

Instances

Monoid (Mod t a) Source # 

Methods

mempty :: Mod t a #

mappend :: Mod t a -> Mod t a -> Mod t a #

mconcat :: [Mod t a] -> Mod t a #

data Info e Source #

Parser's metadata

header :: String -> Info e -> Info e Source #

Set the help text header (it usually includes the application's name and version)

desc :: String -> Info e -> Info e Source #

Set the short description

footer :: String -> Info e -> Info e Source #

Set the help text footer (it usually includes examples)

handleError :: ErrorHandler e -> Info x -> Info e Source #

An error handler

type ErrorHandler e = String -> e -> Maybe String Source #

Given a variable name and an error value, try to produce a useful error message

defaultErrorHandler :: (AsUnset e, AsEmpty e, AsUnread e) => ErrorHandler e Source #

The default error handler

prefixed :: String -> Parser e a -> Parser e a Source #

The string to prepend to the name of every declared environment variable

var :: AsUnset e => Reader e a -> String -> Mod Var a -> Parser e a Source #

Parse a particular variable from the environment

>>> var str "EDITOR" (def "vim" <> helpDef show)

data Var a Source #

Environment variable metadata

Instances

HasHelp Var Source # 

Methods

setHelp :: String -> Var a -> Var a

type Reader e a = String -> Either e a Source #

An environment variable's value parser. Use (<=<) and (>=>) to combine these

str :: IsString s => Reader e s Source #

The trivial reader

nonempty :: (AsEmpty e, IsString s) => Reader e s Source #

The reader that accepts only non-empty strings

auto :: (AsUnread e, Read a) => Reader e a Source #

The reader that uses the Read instance of the type

def :: a -> Mod Var a Source #

The default value of the variable

Note: specifying it means the parser won't ever fail.

helpDef :: (a -> String) -> Mod Var a Source #

Show the default value of the variable in the help text

flag Source #

Arguments

:: (AsUnset e, AsEmpty e) 
=> a

default value

-> a

active value

-> String 
-> Mod Flag a 
-> Parser e a 

A flag that takes the active value if the environment variable is set and non-empty and the default value otherwise

Note: this parser never fails.

switch :: (AsUnset e, AsEmpty e) => String -> Mod Flag Bool -> Parser e Bool Source #

A simple boolean flag

Note: the same caveats apply.

data Flag a Source #

Flag metadata

Instances

HasHelp Flag Source # 

Methods

setHelp :: String -> Flag a -> Flag a

class HasHelp t Source #

A class of things that can have a help message attached to them

Minimal complete definition

setHelp

Instances

HasHelp Flag Source # 

Methods

setHelp :: String -> Flag a -> Flag a

HasHelp Var Source # 

Methods

setHelp :: String -> Var a -> Var a

help :: HasHelp t => String -> Mod t a Source #

Attach help text to the variable

helpDoc :: Parser e a -> String Source #

A pretty-printed list of recognized environment variables suitable for usage messages

data Error Source #

The type of errors returned by envparse's Readers. 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.

class AsUnset e where Source #

The class of types that contain and can be constructed from the error returned from parsing unset variables.

Minimal complete definition

unset, tryUnset

Methods

unset :: e Source #

tryUnset :: e -> Maybe () Source #

Instances

class AsEmpty e where Source #

The class of types that contain and can be constructed from the error returned from parsing variables whose value is empty.

Minimal complete definition

empty, tryEmpty

Methods

empty :: e Source #

tryEmpty :: e -> Maybe () Source #

Instances

class AsUnread e where Source #

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.

Minimal complete definition

unread, tryUnread

Re-exports

External functions that may be useful to the consumer of the library

optional :: Alternative f => f a -> f (Maybe a) #

One or none.

(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c infixr 1 #

Right-to-left Kleisli composition of monads. (>=>), with the arguments flipped.

Note how this operator resembles function composition (.):

(.)   ::            (b ->   c) -> (a ->   b) -> a ->   c
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c infixr 1 #

Left-to-right Kleisli composition of monads.

(<>) :: Monoid m => m -> m -> m infixr 6 #

An infix synonym for mappend.

Since: 4.5.0.0

asum :: (Foldable t, Alternative f) => t (f a) -> f a #

The sum of a collection of actions, generalizing concat.

Testing

Utilities to test—without dabbling in IO—that your parsers do what you want them to do

parsePure :: Parser e b -> [(String, String)] -> Either [(String, e)] b Source #

Try to parse a pure environment