{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
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(..)
, optional, (<=<), (>=>), (<>), asum
, 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
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
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)