{-# LANGUAGE LambdaCase #-}

-- | "System.Environment.Guard" for 'MonadIO'.
--
-- @since 0.1
module System.Environment.Guard.Lifted
  ( -- * High level combinators
    ExpectEnv (..),
    withGuard,
    withGuard_,
    guardOrElse,
    guardOrElse',

    -- * Low level functions

    -- ** Checking environment variable is set
    guardSet,
    guardSet_,

    -- ** Checking environment variable match
    guardExpected,
    guardExpected_,

    -- ** Checking environment variable predicate
    guardPredicate,
    guardPredicate_,
  )
where

import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Char (toLower)
import System.Environment (lookupEnv)

-- $setup
-- >>> import Data.Functor (($>))
-- >>> import System.Environment (setEnv)

-- | The expectation for an environment variable lookup.
--
-- @since 0.1.1
data ExpectEnv
  = -- | Expect that the environment variable is set
    -- (i.e. contents can be anything).
    --
    -- @since 0.1.1
    ExpectEnvSet
  | -- | Expect that the environment variable is set and the contents equals
    -- the string. This is __case-insensitive__.
    --
    -- @since 0.1.1
    ExpectEnvEquals String
  | -- | Expect that the environment variable is set and its contents
    -- satisfies the predicate.
    --
    -- @since 0.1.1
    ExpectEnvPredicate (String -> Bool)

-- | @since 0.1.1
instance Show ExpectEnv where
  showsPrec :: Int -> ExpectEnv -> ShowS
showsPrec Int
_ ExpectEnv
ExpectEnvSet = [Char] -> ShowS
showString [Char]
"ExpectEnvSet"
  showsPrec Int
i (ExpectEnvEquals [Char]
s) =
    Bool -> ShowS -> ShowS
showParen
      (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ([Char] -> ShowS
showString [Char]
"ExpectEnvEquals " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Char]
s)
  showsPrec Int
i (ExpectEnvPredicate [Char] -> Bool
_) =
    Bool -> ShowS -> ShowS
showParen
      (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      ([Char] -> ShowS
showString [Char]
"ExpectEnvEquals " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"_")

-- | Guards an action behind an environment variable according to
-- the given expectation.
--
-- ==== __Examples__
-- >>> setEnv "FOO" "bar"
-- >>> withGuard "FOO" (ExpectEnvEquals "baz") (putStrLn "succeeded")
-- Nothing
--
-- >>> withGuard "FOO" ExpectEnvSet (putStrLn "succeeded")
-- succeeded
-- Just ()
--
-- @since 0.1.1
withGuard :: MonadIO m => String -> ExpectEnv -> m a -> m (Maybe a)
withGuard :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m (Maybe a)
withGuard [Char]
var ExpectEnv
expect m a
m =
  case ExpectEnv
expect of
    ExpectEnv
ExpectEnvSet -> [Char] -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => [Char] -> m a -> m (Maybe a)
guardSet [Char]
var m a
m
    ExpectEnvEquals [Char]
str -> [Char] -> [Char] -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> [Char] -> m a -> m (Maybe a)
guardExpected [Char]
var [Char]
str m a
m
    ExpectEnvPredicate [Char] -> Bool
p -> [Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p m a
m

-- | Variant of 'withGuard' that ignores the return value.
--
-- @since 0.1.1
withGuard_ :: MonadIO m => String -> ExpectEnv -> m a -> m ()
withGuard_ :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m ()
withGuard_ [Char]
var ExpectEnv
expect = m (Maybe a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe a) -> m ()) -> (m a -> m (Maybe a)) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpectEnv -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m (Maybe a)
withGuard [Char]
var ExpectEnv
expect

-- | @guardOrElse var expect m1 m2@ is equivalent to
-- @withGuard var expect m1@ except that it runs @m2@ if @m1@ is not run.
--
-- ==== __Examples__
-- >>> setEnv "FOO" "bar"
-- >>> guardOrElse "FOO" ExpectEnvSet (pure True) (pure "not found")
-- Right True
--
-- >>> guardOrElse "BAR" ExpectEnvSet (pure True) (pure "not found")
-- Left "not found"
--
-- @since 0.1.1
guardOrElse ::
  MonadIO m =>
  -- | The environment variable.
  String ->
  -- | The expectation.
  ExpectEnv ->
  -- | The action to run if the expectation succeeds.
  m a ->
  -- | The action to run if the expectation fails.
  m e ->
  -- | The result.
  m (Either e a)
guardOrElse :: forall (m :: * -> *) a e.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m e -> m (Either e a)
guardOrElse [Char]
var ExpectEnv
expect m a
m1 m e
m2 =
  [Char] -> ExpectEnv -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m (Maybe a)
withGuard [Char]
var ExpectEnv
expect m a
m1
    m (Maybe a) -> (Maybe a -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ a -> Either e a
forall a b. b -> Either a b
Right a
x
      Maybe a
Nothing -> e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> m e -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m e
m2

-- | 'guardOrElse' specialized to the same type so that we always return an
-- @a@. This can also be used to ignore the return value i.e.
--
-- @
-- guardOrElse' var expect (void m1) m2
-- @
--
-- ==== __Examples__
-- >>> setEnv "FOO" "bar"
-- >>> guardOrElse' "FOO" ExpectEnvSet (pure True) (pure False)
-- True
--
-- >>> guardOrElse' "BAR" ExpectEnvSet (pure True) (pure False)
-- False
--
-- >>> guardOrElse' "BAR" ExpectEnvSet (void $ pure True) (putStrLn "not found")
-- not found
--
-- @since 0.1.1
guardOrElse' ::
  MonadIO m =>
  -- | The environment variable.
  String ->
  -- | The expectation.
  ExpectEnv ->
  -- | The action to run if the expectation succeeds.
  m a ->
  -- | The action to run if the expectation fails.
  m a ->
  -- | The result.
  m a
guardOrElse' :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m a -> m a
guardOrElse' [Char]
var ExpectEnv
expect m a
m = (Either a a -> a) -> m (Either a a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id) (m (Either a a) -> m a) -> (m a -> m (Either a a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpectEnv -> m a -> m a -> m (Either a a)
forall (m :: * -> *) a e.
MonadIO m =>
[Char] -> ExpectEnv -> m a -> m e -> m (Either e a)
guardOrElse [Char]
var ExpectEnv
expect m a
m

-- | @'guardSet' var io@ runs @io@ iff
--
-- 1. The environment variable @var@ is set.
--
-- @
-- 'guardSet' var === 'guardPredicate' var ('const' 'True')
-- @
--
-- ==== __Examples__
--
-- >>> guardSet "NOT_SET" (putStrLn "ran io" $> True)
-- Nothing
--
-- >>> setEnv "SET" "foo"
-- >>> guardSet "SET" (putStrLn "ran io" $> True)
-- ran io
-- Just True
--
-- @since 0.1
guardSet :: MonadIO m => String -> m a -> m (Maybe a)
guardSet :: forall (m :: * -> *) a. MonadIO m => [Char] -> m a -> m (Maybe a)
guardSet [Char]
var = [Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
guardPredicate [Char]
var (Bool -> [Char] -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Variant of 'guardSet' that ignores the return value.
--
-- @since 0.1
guardSet_ :: MonadIO m => String -> m a -> m ()
guardSet_ :: forall (m :: * -> *) a. MonadIO m => [Char] -> m a -> m ()
guardSet_ [Char]
var = m (Maybe a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe a) -> m ()) -> (m a -> m (Maybe a)) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => [Char] -> m a -> m (Maybe a)
guardSet [Char]
var

-- | @'guardExpected' var expected io@ runs @io@ iff
--
-- 1. The environment variable @var@ is set.
-- 2. @var@'s value equals @expected@. This is __case-insensitive__.
--
-- @
-- 'guardExpected' var expected === 'guardPredicate' var (\\a b -> 'fmap' 'toLower' a == 'fmap' 'toLower' b)
-- @
--
-- ==== __Examples__
--
-- >>> guardExpected "NOT_SET" "val" (putStrLn "ran io" $> True)
-- Nothing
--
-- >>> setEnv "WRONG_VAL" "good_val"
-- >>> guardExpected "WRONG_VAL" "bad_val" (putStrLn "ran io" $> True)
-- Nothing
--
-- >>> setEnv "WILL_RUN" "val"
-- >>> guardExpected "WILL_RUN" "VAL" (putStrLn "ran io" $> True)
-- ran io
-- Just True
--
-- @since 0.1
guardExpected :: MonadIO m => String -> String -> m a -> m (Maybe a)
guardExpected :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> [Char] -> m a -> m (Maybe a)
guardExpected [Char]
var [Char]
expected = [Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
guardPredicate [Char]
var ([Char] -> [Char] -> Bool
eqCaseInsensitive [Char]
expected)

-- | Variant of 'guardExpected_' that ignores the return value.
--
-- @since 0.1
guardExpected_ :: MonadIO m => String -> String -> m a -> m ()
guardExpected_ :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> [Char] -> m a -> m ()
guardExpected_ [Char]
var [Char]
expected = m (Maybe a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe a) -> m ()) -> (m a -> m (Maybe a)) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> [Char] -> m a -> m (Maybe a)
guardExpected [Char]
var [Char]
expected

-- | Variant of 'guardPredicate' that ignores the return value.
--
-- @since 0.1
guardPredicate_ :: MonadIO m => String -> (String -> Bool) -> m a -> m ()
guardPredicate_ :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m ()
guardPredicate_ [Char]
var [Char] -> Bool
p = m (Maybe a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe a) -> m ()) -> (m a -> m (Maybe a)) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p

-- | This is the most general way to check an environment variable.
-- @'guardPredicate' var p io@ runs @io@ iff
--
-- 1. The environment variable @var@ is set.
-- 2. @var@'s value satisfies predicate @p@.
--
-- ==== __Examples__
--
-- >>> guardPredicate "NOT_SET" (const True) (putStrLn "ran io" $> True)
-- Nothing
--
-- >>> setEnv "CASE_WRONG" "VAL"
-- >>> guardPredicate "CASE_WRONG" (== "val") (putStrLn "ran io" $> True)
-- Nothing
--
-- >>> setEnv "WILL_RUN" "VAL"
-- >>> guardPredicate "WILL_RUN" (== "VAL") (putStrLn "ran io" $> True)
-- ran io
-- Just True
--
-- @since 0.1
guardPredicate :: MonadIO m => String -> (String -> Bool) -> m a -> m (Maybe a)
guardPredicate :: forall (m :: * -> *) a.
MonadIO m =>
[Char] -> ([Char] -> Bool) -> m a -> m (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p m a
io =
  IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO (Maybe [Char])
lookupEnv [Char]
var)
    m (Maybe [Char]) -> (Maybe [Char] -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just [Char]
result | [Char] -> Bool
p [Char]
result -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
io
      Maybe [Char]
_ -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

eqCaseInsensitive :: String -> String -> Bool
eqCaseInsensitive :: [Char] -> [Char] -> Bool
eqCaseInsensitive [Char]
a [Char]
b = (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
b