{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
-- | 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' ('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
--   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
-- @
module Env
  ( parse
  , parseOr
  , Parser
  , Mod
  , Help.Info
  , Help.header
  , Help.desc
  , Help.footer
  , Help.handleError
  , Help.ErrorHandler
  , Help.defaultErrorHandler
  , prefixed
  , var
  , Var
  , Reader
  , str
  , char
  , nonempty
  , splitOn
  , auto
  , def
  , helpDef
  , flag
  , switch
  , Flag
  , HasHelp
  , help
  , sensitive
  , Help.helpDoc
  , Error(..)
  , Error.AsUnset(..)
  , Error.AsEmpty(..)
  , Error.AsUnread(..)
  -- * Re-exports
  -- $re-exports
  , optional, (<=<), (>=>), (<>), asum
  -- * Testing
  -- $testing
  , parsePure
  ) where

import           Control.Applicative
import           Control.Monad ((>=>), (<=<))
import           Data.Foldable (asum, for_)
#if __GLASGOW_HASKELL__ < 710
import           Data.Monoid (Monoid(..), (<>))
#else
import           Data.Monoid ((<>))
#endif
import           System.Environment (getEnvironment)
#if __GLASGOW_HASKELL__ >= 708
import           System.Environment (unsetEnv)
#endif
import           System.Exit (exitFailure)
import qualified System.IO as IO

import qualified Env.Internal.Help as Help
import           Env.Internal.Parser
import           Env.Internal.Error (Error)
import qualified Env.Internal.Error as Error

-- $re-exports
-- External functions that may be useful to the consumer of the library

-- $testing
-- 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 ('Help.header' \"env-parse 0.2.0\") ('var' 'str' \"USER\" ('def' \"nobody\"))
-- @
parse :: Error.AsUnset e => (Help.Info Error -> Help.Info e) -> Parser e a -> IO a
parse :: (Info Error -> Info e) -> Parser e a -> IO a
parse Info Error -> Info e
m =
  (Either Any a -> a) -> IO (Either Any a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Any -> a) -> (a -> a) -> Either Any a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Any
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"absurd") a -> a
forall a. a -> a
id) (IO (Either Any a) -> IO a)
-> (Parser e a -> IO (Either Any a)) -> Parser e a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> IO Any)
-> (Info Error -> Info e) -> Parser e a -> IO (Either Any a)
forall e a b.
AsUnset e =>
([Char] -> IO a)
-> (Info Error -> Info e) -> Parser e b -> IO (Either a b)
parseOr [Char] -> IO Any
forall a. [Char] -> IO a
die Info Error -> Info e
m

-- | Try to parse the environment
--
-- Use this if simply dying on failure (the behavior of 'parse') is inadequate for your needs.
parseOr :: Error.AsUnset e => (String -> IO a) -> (Help.Info Error -> Help.Info e) -> Parser e b -> IO (Either a b)
parseOr :: ([Char] -> IO a)
-> (Info Error -> Info e) -> Parser e b -> IO (Either a b)
parseOr [Char] -> IO a
onFailure Info Error -> Info e
helpMod Parser e b
parser = do
  Either [([Char], e)] b
b <- ([([Char], [Char])] -> Either [([Char], e)] b)
-> IO [([Char], [Char])] -> IO (Either [([Char], e)] b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Parser e b -> [([Char], [Char])] -> Either [([Char], e)] b
forall e a.
AsUnset e =>
Parser e a -> [([Char], [Char])] -> Either [([Char], e)] a
parsePure Parser e b
parser) IO [([Char], [Char])]
getEnvironment
#if __GLASGOW_HASKELL__ >= 708
  Either [([Char], e)] b -> (b -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either [([Char], e)] b
b ((b -> IO ()) -> IO ()) -> (b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \b
_ ->
    Parser e b -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) e a b.
Applicative m =>
Parser e a -> ([Char] -> m b) -> m ()
traverseSensitiveVar Parser e b
parser [Char] -> IO ()
unsetEnv
#endif
  ([([Char], e)] -> IO a)
-> Either [([Char], e)] b -> IO (Either a b)
forall (f :: * -> *) a b t.
Applicative f =>
(a -> f b) -> Either a t -> f (Either b t)
traverseLeft ([Char] -> IO a
onFailure ([Char] -> IO a)
-> ([([Char], e)] -> [Char]) -> [([Char], e)] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info e -> Parser e b -> [([Char], e)] -> [Char]
forall e b. Info e -> Parser e b -> [([Char], e)] -> [Char]
Help.helpInfo (Info Error -> Info e
helpMod Info Error
Help.defaultInfo) Parser e b
parser) Either [([Char], e)] b
b

die :: String -> IO a
die :: [Char] -> IO a
die [Char]
m =
  do Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr [Char]
m; IO a
forall a. IO a
exitFailure

traverseLeft :: Applicative f => (a -> f b) -> Either a t -> f (Either b t)
traverseLeft :: (a -> f b) -> Either a t -> f (Either b t)
traverseLeft a -> f b
f =
  (a -> f (Either b t))
-> (t -> f (Either b t)) -> Either a t -> f (Either b t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b t) -> f b -> f (Either b t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b t
forall a b. a -> Either a b
Left (f b -> f (Either b t)) -> (a -> f b) -> a -> f (Either b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (Either b t -> f (Either b t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either b t -> f (Either b t))
-> (t -> Either b t) -> t -> f (Either b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Either b t
forall a b. b -> Either a b
Right)