{-# LANGUAGE LambdaCase #-}

-- | Functions for conditionally running 'IO' actions based on an environment
-- variable.
--
-- @since 0.1
module System.Environment.Guard
  ( -- * 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 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 :: String -> IO a -> IO (Maybe a)
guardSet :: forall a. [Char] -> IO a -> IO (Maybe a)
guardSet [Char]
var = [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO (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_ :: String -> IO a -> IO ()
guardSet_ :: forall a. [Char] -> IO a -> IO ()
guardSet_ [Char]
var = IO (Maybe a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe a) -> IO ()) -> (IO a -> IO (Maybe a)) -> IO a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO a -> IO (Maybe a)
forall a. [Char] -> IO a -> IO (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 :: String -> String -> IO a -> IO (Maybe a)
guardExpected :: forall a. [Char] -> [Char] -> IO a -> IO (Maybe a)
guardExpected [Char]
var [Char]
expected = [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
guardPredicate [Char]
var ([Char] -> [Char] -> Bool
eqCaseInsensitive [Char]
expected)

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

-- | Variant of 'guardPredicate' that ignores the return value.
--
-- @since 0.1
guardPredicate_ :: String -> (String -> Bool) -> IO a -> IO ()
guardPredicate_ :: forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO ()
guardPredicate_ [Char]
var [Char] -> Bool
p = IO (Maybe a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe a) -> IO ()) -> (IO a -> IO (Maybe a)) -> IO a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO (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 :: String -> (String -> Bool) -> IO a -> IO (Maybe a)
guardPredicate :: forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p IO a
io =
  [Char] -> IO (Maybe [Char])
lookupEnv [Char]
var
    IO (Maybe [Char]) -> (Maybe [Char] -> IO (Maybe a)) -> IO (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) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
io
      Maybe [Char]
_ -> Maybe a -> IO (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