{-# LANGUAGE LambdaCase #-}

-- | "System.Environment.Guard" for 'MonadIO'.
--
-- @since 0.1
module System.Environment.Guard.Lifted
  ( -- * 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)

-- | @'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) -> [Char] -> [Char]
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) -> [Char] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower [Char]
b