{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Env.Internal.Parser
  ( Parser(..)
  , VarF(..)
  , parsePure
  , traverseSensitiveVar
  , Mod(..)
  , prefixed
  , var
  , Var(..)
  , defaultVar
  , Reader
  , eitherReader
  , str
  , char
  , nonempty
  , splitOn
  , auto
  , def
  , helpDef
  , showDef
  , flag
  , switch
  , Flag
  , HasHelp
  , help
  , sensitive
  ) where

import           Control.Applicative
import           Control.Arrow (left)
import           Control.Monad ((<=<))
import           Data.Foldable (traverse_)
import           Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
#if __GLASGOW_HASKELL__ < 710
import           Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup (Semigroup(..))
#endif
import           Data.String (IsString(..))

import           Env.Internal.Free
import qualified Env.Internal.Error as Error
import           Env.Internal.Val


-- | Try to parse a pure environment
parsePure :: Error.AsUnset e => Parser e a -> [(String, String)] -> Either [(String, e)] a
parsePure :: forall e a.
AsUnset e =>
Parser e a -> [(String, String)] -> Either [(String, e)] a
parsePure (Parser Alt (VarF e) a
p) ([(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList -> Map String String
env) =
  Val [(String, e)] a -> Either [(String, e)] a
forall e a. Val e a -> Either e a
toEither ((forall x. VarF e x -> Val [(String, e)] x)
-> Alt (VarF e) a -> Val [(String, e)] a
forall (f :: * -> *) (g :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
runAlt (Either [(String, e)] x -> Val [(String, e)] x
forall e a. Either e a -> Val e a
fromEither (Either [(String, e)] x -> Val [(String, e)] x)
-> (VarF e x -> Either [(String, e)] x)
-> VarF e x
-> Val [(String, e)] x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, e) -> [(String, e)])
-> Either (String, e) x -> Either [(String, e)] x
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String, e) -> [(String, e)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (String, e) x -> Either [(String, e)] x)
-> (VarF e x -> Either (String, e) x)
-> VarF e x
-> Either [(String, e)] x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarF e x -> Either (String, e) x
forall {e} {b}. AsUnset e => VarF e b -> Either (String, e) b
go) Alt (VarF e) a
p)
 where
  go :: VarF e b -> Either (String, e) b
go v :: VarF e b
v@VarF {Bool
String
Maybe b
Maybe String
Reader e b
varfName :: String
varfReader :: Reader e b
varfHelp :: Maybe String
varfDef :: Maybe b
varfHelpDef :: Maybe String
varfSensitive :: Bool
varfName :: forall e a. VarF e a -> String
varfReader :: forall e a. VarF e a -> Reader e a
varfHelp :: forall e a. VarF e a -> Maybe String
varfDef :: forall e a. VarF e a -> Maybe a
varfHelpDef :: forall e a. VarF e a -> Maybe String
varfSensitive :: forall e a. VarF e a -> Bool
..} =
    case VarF e b -> Map String String -> Either (String, e) String
forall e a.
AsUnset e =>
VarF e a -> Map String String -> Either (String, e) String
lookupVar VarF e b
v Map String String
env of
      Left (String, e)
lookupErr ->
        Either (String, e) b
-> (b -> Either (String, e) b) -> Maybe b -> Either (String, e) b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String, e) -> Either (String, e) b
forall a b. a -> Either a b
Left (String, e)
lookupErr) b -> Either (String, e) b
forall a. a -> Either (String, e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
varfDef
      Right String
val ->
        VarF e b -> String -> Either (String, e) b
forall e a. VarF e a -> String -> Either (String, e) a
readVar VarF e b
v String
val

traverseSensitiveVar :: Applicative m => Parser e a -> (String -> m b) -> m ()
traverseSensitiveVar :: forall (m :: * -> *) e a b.
Applicative m =>
Parser e a -> (String -> m b) -> m ()
traverseSensitiveVar Parser {Alt (VarF e) a
unParser :: Alt (VarF e) a
unParser :: forall e a. Parser e a -> Alt (VarF e) a
unParser} String -> m b
f =
  (String -> m b) -> Set String -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> m b
f Set String
sensitiveVars
 where
  sensitiveVars :: Set String
sensitiveVars =
    (forall a. VarF e a -> Set String) -> Alt (VarF e) a -> Set String
forall p (f :: * -> *) b.
Monoid p =>
(forall a. f a -> p) -> Alt f b -> p
foldAlt (\VarF {Bool
varfSensitive :: forall e a. VarF e a -> Bool
varfSensitive :: Bool
varfSensitive, String
varfName :: forall e a. VarF e a -> String
varfName :: String
varfName} -> if Bool
varfSensitive then String -> Set String
forall a. a -> Set a
Set.singleton String
varfName else Set String
forall a. Set a
Set.empty) Alt (VarF e) a
unParser

readVar :: VarF e a -> String -> Either (String, e) a
readVar :: forall e a. VarF e a -> String -> Either (String, e) a
readVar VarF {Bool
String
Maybe a
Maybe String
Reader e a
varfName :: forall e a. VarF e a -> String
varfReader :: forall e a. VarF e a -> Reader e a
varfHelp :: forall e a. VarF e a -> Maybe String
varfDef :: forall e a. VarF e a -> Maybe a
varfHelpDef :: forall e a. VarF e a -> Maybe String
varfSensitive :: forall e a. VarF e a -> Bool
varfName :: String
varfReader :: Reader e a
varfHelp :: Maybe String
varfDef :: Maybe a
varfHelpDef :: Maybe String
varfSensitive :: Bool
..} =
  String -> Either e a -> Either (String, e) a
forall e a. String -> Either e a -> Either (String, e) a
addName String
varfName (Either e a -> Either (String, e) a)
-> Reader e a -> String -> Either (String, e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader e a
varfReader

lookupVar :: Error.AsUnset e => VarF e a -> Map String String -> Either (String, e) String
lookupVar :: forall e a.
AsUnset e =>
VarF e a -> Map String String -> Either (String, e) String
lookupVar VarF {Bool
String
Maybe a
Maybe String
Reader e a
varfName :: forall e a. VarF e a -> String
varfReader :: forall e a. VarF e a -> Reader e a
varfHelp :: forall e a. VarF e a -> Maybe String
varfDef :: forall e a. VarF e a -> Maybe a
varfHelpDef :: forall e a. VarF e a -> Maybe String
varfSensitive :: forall e a. VarF e a -> Bool
varfName :: String
varfReader :: Reader e a
varfHelp :: Maybe String
varfDef :: Maybe a
varfHelpDef :: Maybe String
varfSensitive :: Bool
..} =
  String -> Either e String -> Either (String, e) String
forall e a. String -> Either e a -> Either (String, e) a
addName String
varfName (Either e String -> Either (String, e) String)
-> (Map String String -> Either e String)
-> Map String String
-> Either (String, e) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either e String
-> (String -> Either e String) -> Maybe String -> Either e String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e String
forall a b. a -> Either a b
Left e
forall e. AsUnset e => e
Error.unset) String -> Either e String
forall a b. b -> Either a b
Right (Maybe String -> Either e String)
-> (Map String String -> Maybe String)
-> Map String String
-> Either e String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
varfName

addName :: String -> Either e a -> Either (String, e) a
addName :: forall e a. String -> Either e a -> Either (String, e) a
addName String
name =
  (e -> (String, e)) -> Either e a -> Either (String, e) a
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((,) String
name)

-- | An environment parser
newtype Parser e a = Parser { forall e a. Parser e a -> Alt (VarF e) a
unParser :: Alt (VarF e) a }
    deriving ((forall a b. (a -> b) -> Parser e a -> Parser e b)
-> (forall a b. a -> Parser e b -> Parser e a)
-> Functor (Parser e)
forall a b. a -> Parser e b -> Parser e a
forall a b. (a -> b) -> Parser e a -> Parser e b
forall e a b. a -> Parser e b -> Parser e a
forall e a b. (a -> b) -> Parser e a -> Parser e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> Parser e a -> Parser e b
fmap :: forall a b. (a -> b) -> Parser e a -> Parser e b
$c<$ :: forall e a b. a -> Parser e b -> Parser e a
<$ :: forall a b. a -> Parser e b -> Parser e a
Functor)

instance Applicative (Parser e) where
  pure :: forall a. a -> Parser e a
pure =
    Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) a -> Parser e a)
-> (a -> Alt (VarF e) a) -> a -> Parser e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Alt (VarF e) a
forall a. a -> Alt (VarF e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Parser Alt (VarF e) (a -> b)
f <*> :: forall a b. Parser e (a -> b) -> Parser e a -> Parser e b
<*> Parser Alt (VarF e) a
x =
    Alt (VarF e) b -> Parser e b
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) (a -> b)
f Alt (VarF e) (a -> b) -> Alt (VarF e) a -> Alt (VarF e) b
forall a b.
Alt (VarF e) (a -> b) -> Alt (VarF e) a -> Alt (VarF e) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Alt (VarF e) a
x)

instance Alternative (Parser e) where
  empty :: forall a. Parser e a
empty =
    Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser Alt (VarF e) a
forall a. Alt (VarF e) a
forall (f :: * -> *) a. Alternative f => f a
empty
  Parser Alt (VarF e) a
f <|> :: forall a. Parser e a -> Parser e a -> Parser e a
<|> Parser Alt (VarF e) a
x =
    Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) a
f Alt (VarF e) a -> Alt (VarF e) a -> Alt (VarF e) a
forall a. Alt (VarF e) a -> Alt (VarF e) a -> Alt (VarF e) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Alt (VarF e) a
x)

-- | The string to prepend to the name of every declared environment variable
prefixed :: String -> Parser e a -> Parser e a
prefixed :: forall e a. String -> Parser e a -> Parser e a
prefixed String
pre =
  Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) a -> Parser e a)
-> (Parser e a -> Alt (VarF e) a) -> Parser e a -> Parser e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. VarF e a -> VarF e a)
-> Alt (VarF e) a -> Alt (VarF e) a
forall (f :: * -> *) (g :: * -> *) b.
Functor g =>
(forall a. f a -> g a) -> Alt f b -> Alt g b
hoistAlt (\VarF e a
v -> VarF e a
v {varfName=pre ++ varfName v}) (Alt (VarF e) a -> Alt (VarF e) a)
-> (Parser e a -> Alt (VarF e) a) -> Parser e a -> Alt (VarF e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser e a -> Alt (VarF e) a
forall e a. Parser e a -> Alt (VarF e) a
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 :: forall e a. Parser e a -> Parser e a
sensitive =
  Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) a -> Parser e a)
-> (Parser e a -> Alt (VarF e) a) -> Parser e a -> Parser e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. VarF e a -> VarF e a)
-> Alt (VarF e) a -> Alt (VarF e) a
forall (f :: * -> *) (g :: * -> *) b.
Functor g =>
(forall a. f a -> g a) -> Alt f b -> Alt g b
hoistAlt (\VarF e a
v -> VarF e a
v {varfSensitive = True}) (Alt (VarF e) a -> Alt (VarF e) a)
-> (Parser e a -> Alt (VarF e) a) -> Parser e a -> Alt (VarF e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser e a -> Alt (VarF e) a
forall e a. Parser e a -> Alt (VarF e) a
unParser


data VarF e a = VarF
  { forall e a. VarF e a -> String
varfName      :: String
  , forall e a. VarF e a -> Reader e a
varfReader    :: Reader e a
  , forall e a. VarF e a -> Maybe String
varfHelp      :: Maybe String
  , forall e a. VarF e a -> Maybe a
varfDef       :: Maybe a
  , forall e a. VarF e a -> Maybe String
varfHelpDef   :: Maybe String
  , forall e a. VarF e a -> Bool
varfSensitive :: Bool
  } deriving ((forall a b. (a -> b) -> VarF e a -> VarF e b)
-> (forall a b. a -> VarF e b -> VarF e a) -> Functor (VarF e)
forall a b. a -> VarF e b -> VarF e a
forall a b. (a -> b) -> VarF e a -> VarF e b
forall e a b. a -> VarF e b -> VarF e a
forall e a b. (a -> b) -> VarF e a -> VarF e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> VarF e a -> VarF e b
fmap :: forall a b. (a -> b) -> VarF e a -> VarF e b
$c<$ :: forall e a b. a -> VarF e b -> VarF e a
<$ :: forall a b. a -> VarF e b -> VarF e a
Functor)

liftVarF :: VarF e a -> Parser e a
liftVarF :: forall e a. VarF e a -> Parser e a
liftVarF =
  Alt (VarF e) a -> Parser e a
forall e a. Alt (VarF e) a -> Parser e a
Parser (Alt (VarF e) a -> Parser e a)
-> (VarF e a -> Alt (VarF e) a) -> VarF e a -> Parser e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarF e a -> Alt (VarF e) a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt

-- | An environment variable's value parser. Use @(<=<)@ and @(>=>)@ to combine these
type Reader e a = String -> Either e a

-- | Create a 'Reader' from a simple parser function
eitherReader :: Error.AsUnread e => (String -> Either String a) -> Reader e a
eitherReader :: forall e a. AsUnread e => (String -> Either String a) -> Reader e a
eitherReader String -> Either String a
f String
s =
  (String -> e) -> Either String a -> Either e a
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> e
forall e. AsUnread e => String -> e
Error.unread (String -> e) -> (String -> String) -> String -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
suffix) (String -> Either String a
f String
s)
 where
  suffix :: String -> String
suffix String
x = String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
s

-- | Parse a particular variable from the environment
--
-- @
-- >>> var 'str' \"EDITOR\" ('def' \"vim\" <> 'helpDef' show)
-- @
var :: Error.AsUnset e => Reader e a -> String -> Mod Var a -> Parser e a
var :: forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader e a
r String
n (Mod Var a -> Var a
f) =
  VarF e a -> Parser e a
forall e a. VarF e a -> Parser e a
liftVarF (VarF e a -> Parser e a) -> VarF e a -> Parser e a
forall a b. (a -> b) -> a -> b
$ VarF
    { varfName :: String
varfName = String
n
    , varfReader :: Reader e a
varfReader = Reader e a
r
    , varfHelp :: Maybe String
varfHelp = Maybe String
varHelp
    , varfDef :: Maybe a
varfDef = Maybe a
varDef
    , varfHelpDef :: Maybe String
varfHelpDef = Maybe (a -> String)
varHelpDef Maybe (a -> String) -> Maybe a -> Maybe String
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
varDef
    , varfSensitive :: Bool
varfSensitive = Bool
varSensitive
    }
 where
  Var {Maybe String
varHelp :: Maybe String
varHelp :: forall a. Var a -> Maybe String
varHelp, Maybe a
varDef :: Maybe a
varDef :: forall a. Var a -> Maybe a
varDef, Maybe (a -> String)
varHelpDef :: Maybe (a -> String)
varHelpDef :: forall a. Var a -> Maybe (a -> String)
varHelpDef, Bool
varSensitive :: Bool
varSensitive :: forall a. Var a -> Bool
varSensitive} = Var a -> Var a
f Var a
forall a. Var a
defaultVar

-- | 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.
flag
  :: a -- ^ default value
  -> a -- ^ active value
  -> String -> Mod Flag a -> Parser e a
flag :: forall a e. a -> a -> String -> Mod Flag a -> Parser e a
flag a
f a
t String
n (Mod Flag a -> Flag a
g) =
  VarF e a -> Parser e a
forall e a. VarF e a -> Parser e a
liftVarF (VarF e a -> Parser e a) -> VarF e a -> Parser e a
forall a b. (a -> b) -> a -> b
$ VarF
    { varfName :: String
varfName = String
n
    , varfReader :: Reader e a
varfReader = \String
val ->
        a -> Either e a
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either e a) -> a -> Either e a
forall a b. (a -> b) -> a -> b
$ case (Reader Error String
forall e s. (AsEmpty e, IsString s) => Reader e s
nonempty :: Reader Error.Error String) String
val of
          Left  Error
_ -> a
f
          Right String
_ -> a
t
    , varfHelp :: Maybe String
varfHelp = Maybe String
flagHelp
    , varfDef :: Maybe a
varfDef = a -> Maybe a
forall a. a -> Maybe a
Just a
f
    , varfHelpDef :: Maybe String
varfHelpDef = Maybe String
forall a. Maybe a
Nothing
    , varfSensitive :: Bool
varfSensitive = Bool
flagSensitive
    }
 where
  Flag {Maybe String
flagHelp :: Maybe String
flagHelp :: forall a. Flag a -> Maybe String
flagHelp, Bool
flagSensitive :: Bool
flagSensitive :: forall a. Flag a -> Bool
flagSensitive} = Flag a -> Flag a
g Flag a
forall a. Flag a
defaultFlag

-- | A simple boolean 'flag'
--
-- /Note:/ this parser never fails.
switch :: String -> Mod Flag Bool -> Parser e Bool
switch :: forall e. String -> Mod Flag Bool -> Parser e Bool
switch =
  Bool -> Bool -> String -> Mod Flag Bool -> Parser e Bool
forall a e. a -> a -> String -> Mod Flag a -> Parser e a
flag Bool
False Bool
True

-- | The trivial reader
str :: IsString s => Reader e s
str :: forall s e. IsString s => Reader e s
str =
  s -> Either e s
forall a b. b -> Either a b
Right (s -> Either e s) -> (String -> s) -> String -> Either e s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString

-- | The reader that accepts only non-empty strings
nonempty :: (Error.AsEmpty e, IsString s) => Reader e s
nonempty :: forall e s. (AsEmpty e, IsString s) => Reader e s
nonempty =
  (String -> s) -> Either e String -> Either e s
forall a b. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> s
forall a. IsString a => String -> a
fromString (Either e String -> Either e s)
-> (String -> Either e String) -> String -> Either e s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either e String
forall {a} {a}. AsEmpty a => [a] -> Either a [a]
go where go :: [a] -> Either a [a]
go [] = a -> Either a [a]
forall a b. a -> Either a b
Left a
forall e. AsEmpty e => e
Error.empty; go [a]
xs = [a] -> Either a [a]
forall a b. b -> Either a b
Right [a]
xs

-- | The reader that uses the 'Read' instance of the type
auto :: (Error.AsUnread e, Read a) => Reader e a
auto :: forall e a. (AsUnread e, Read a) => Reader e a
auto String
s =
  case ReadS a
forall a. Read a => ReadS a
reads String
s of [(a
v, String
"")] -> a -> Either e a
forall a b. b -> Either a b
Right a
v; [(a, String)]
_ -> e -> Either e a
forall a b. a -> Either a b
Left (String -> e
forall e. AsUnread e => String -> e
Error.unread (String -> String
forall a. Show a => a -> String
show String
s))

-- | The single character string reader
char :: Error.AsUnread e => Reader e Char
char :: forall e. AsUnread e => Reader e Char
char String
s =
  case String
s of [Char
c] -> Char -> Either e Char
forall a b. b -> Either a b
Right Char
c; String
_ -> e -> Either e Char
forall a b. a -> Either a b
Left (String -> e
forall e. AsUnread e => String -> e
Error.unread String
"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 :: forall e. Char -> Reader e [String]
splitOn Char
sep = [String] -> Either e [String]
forall a b. b -> Either a b
Right ([String] -> Either e [String])
-> (String -> [String]) -> String -> Either e [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
go
 where
  go :: String -> [String]
go [] = []
  go String
xs = String -> [String]
go' String
xs

  go' :: String -> [String]
go' String
xs =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep) String
xs of
      (String
ys, []) ->
        String
ys String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
      (String
ys, Char
_ : String
zs) ->
        String
ys String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go' String
zs


-- | This represents a modification of the properties of a particular 'Parser'.
-- Combine them using the 'Monoid' instance.
newtype Mod t a = Mod (t a -> t a)

#if MIN_VERSION_base(4,9,0)
instance Semigroup (Mod t a) where
  Mod t a -> t a
f <> :: Mod t a -> Mod t a -> Mod t a
<> Mod t a -> t a
g = (t a -> t a) -> Mod t a
forall (t :: * -> *) a. (t a -> t a) -> Mod t a
Mod (t a -> t a
g (t a -> t a) -> (t a -> t a) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> t a
f)
#endif

instance Monoid (Mod t a) where
  mempty :: Mod t a
mempty = (t a -> t a) -> Mod t a
forall (t :: * -> *) a. (t a -> t a) -> Mod t a
Mod t a -> t a
forall a. a -> a
id
#if MIN_VERSION_base(4,11,0)
#elif MIN_VERSION_base(4,9,0)
  mappend = (<>)
#else
  mappend (Mod f) (Mod g) = Mod (g . f)
#endif

-- | Environment variable metadata
data Var a = Var
  { forall a. Var a -> Maybe String
varHelp      :: Maybe String
  , forall a. Var a -> Maybe (a -> String)
varHelpDef   :: Maybe (a -> String)
  , forall a. Var a -> Maybe a
varDef       :: Maybe a
  , forall a. Var a -> Bool
varSensitive :: Bool
  }

defaultVar :: Var a
defaultVar :: forall a. Var a
defaultVar = Var
  { varHelp :: Maybe String
varHelp = Maybe String
forall a. Maybe a
Nothing
  , varDef :: Maybe a
varDef = Maybe a
forall a. Maybe a
Nothing
  , varHelpDef :: Maybe (a -> String)
varHelpDef = Maybe (a -> String)
forall a. Maybe a
Nothing
  , varSensitive :: Bool
varSensitive = Bool
defaultSensitive
  }

defaultSensitive :: Bool
defaultSensitive :: Bool
defaultSensitive = Bool
False

-- | The default value of the variable
--
-- /Note:/ specifying it means the parser won't ever fail.
def :: a -> Mod Var a
def :: forall a. a -> Mod Var a
def a
d =
  (Var a -> Var a) -> Mod Var a
forall (t :: * -> *) a. (t a -> t a) -> Mod t a
Mod (\Var a
v -> Var a
v {varDef=Just d})

-- | Flag metadata
data Flag a = Flag
  { forall a. Flag a -> Maybe String
flagHelp      :: Maybe String
  , forall a. Flag a -> Bool
flagSensitive :: Bool
  }

defaultFlag :: Flag a
defaultFlag :: forall a. Flag a
defaultFlag = Flag
  { flagHelp :: Maybe String
flagHelp = Maybe String
forall a. Maybe a
Nothing
  , flagSensitive :: Bool
flagSensitive = Bool
defaultSensitive
  }

-- | Show the default value of the variable in help.
helpDef :: (a -> String) -> Mod Var a
helpDef :: forall a. (a -> String) -> Mod Var a
helpDef a -> String
d =
  (Var a -> Var a) -> Mod Var a
forall (t :: * -> *) a. (t a -> t a) -> Mod t a
Mod (\Var a
v -> Var a
v {varHelpDef=Just d})

-- | Use the 'Show' instance to show the default value of the variable in help.
showDef :: Show a => Mod Var a
showDef :: forall a. Show a => Mod Var a
showDef =
  (a -> String) -> Mod Var a
forall a. (a -> String) -> Mod Var a
helpDef a -> String
forall a. Show a => a -> String
show


-- | A class of things that can have a help message attached to them
class HasHelp t where
  setHelp :: String -> t a -> t a

instance HasHelp Var where
  setHelp :: forall a. String -> Var a -> Var a
setHelp String
h Var a
v = Var a
v {varHelp=Just h}

instance HasHelp Flag where
  setHelp :: forall a. String -> Flag a -> Flag a
setHelp String
h Flag a
v = Flag a
v {flagHelp=Just h}

-- | Attach help text to the variable
help :: HasHelp t => String -> Mod t a
help :: forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help =
  (t a -> t a) -> Mod t a
forall (t :: * -> *) a. (t a -> t a) -> Mod t a
Mod ((t a -> t a) -> Mod t a)
-> (String -> t a -> t a) -> String -> Mod t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> t a -> t a
forall a. String -> t a -> t a
forall (t :: * -> *) a. HasHelp t => String -> t a -> t a
setHelp