{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Effectful.Environment.Guard.Static
  ( -- * Effect
    EnvGuard,

    -- ** Handler
    runEnvGuard,

    -- * High level combinators
    ExpectEnv (..),
    withGuard,
    withGuard_,
    guardOrElse,
    guardOrElse',

    -- * Low level functions

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

    -- ** Checking environment variable match
    guardEquals,
    guardEquals_,

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

import Control.Monad (void)
import Data.Char qualified as Ch
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    seqUnliftIO,
    unsafeEff,
  )
import System.Environment.Guard
  ( ExpectEnv
      ( ExpectEnvEquals,
        ExpectEnvPredicate,
        ExpectEnvSet
      ),
  )
import System.Environment.Guard qualified as EnvGuard

-- | Static effect for 'EnvGuard'.
--
-- @since 0.1
data EnvGuard :: Effect

type instance DispatchOf EnvGuard = Static WithSideEffects

data instance StaticRep EnvGuard = MkEnvGuard

-- | @since 0.1
guardPredicate ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  (String -> Bool) ->
  Eff es a ->
  Eff es (Maybe a)
guardPredicate :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
guardPredicate [Char]
envStr [Char] -> Bool
p Eff es a
action =
  (Env es -> IO (Maybe a)) -> Eff es (Maybe a)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (Maybe a)) -> Eff es (Maybe a))
-> (Env es -> IO (Maybe a)) -> Eff es (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es
-> ((forall r. Eff es r -> IO r) -> IO (Maybe a)) -> IO (Maybe a)
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO (Maybe a)) -> IO (Maybe a))
-> ((forall r. Eff es r -> IO r) -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO -> [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
forall a. [Char] -> ([Char] -> Bool) -> IO a -> IO (Maybe a)
EnvGuard.guardPredicate [Char]
envStr [Char] -> Bool
p (Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO Eff es a
action)

-- | Runs an EnvGuard effect.
--
-- @since 0.1
runEnvGuard :: (IOE :> es) => Eff (EnvGuard : es) a -> Eff es a
runEnvGuard :: forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (EnvGuard : es) a -> Eff es a
runEnvGuard = StaticRep EnvGuard -> Eff (EnvGuard : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep EnvGuard
MkEnvGuard

-- | @since 0.1
withGuard ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  ExpectEnv ->
  Eff es a ->
  Eff es (Maybe a)
withGuard :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es (Maybe a)
withGuard [Char]
var ExpectEnv
expect Eff es a
m =
  case ExpectEnv
expect of
    ExpectEnv
ExpectEnvSet -> [Char] -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> Eff es a -> Eff es (Maybe a)
guardSet [Char]
var Eff es a
m
    ExpectEnvEquals [Char]
str -> [Char] -> [Char] -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> [Char] -> Eff es a -> Eff es (Maybe a)
guardEquals [Char]
var [Char]
str Eff es a
m
    ExpectEnvPredicate [Char] -> Bool
p -> [Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p Eff es a
m

-- | @since 0.1
withGuard_ ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  ExpectEnv ->
  Eff es a ->
  Eff es ()
withGuard_ :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es ()
withGuard_ [Char]
var ExpectEnv
expect = Eff es (Maybe a) -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es (Maybe a) -> Eff es ())
-> (Eff es a -> Eff es (Maybe a)) -> Eff es a -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpectEnv -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es (Maybe a)
withGuard [Char]
var ExpectEnv
expect

-- | @since 0.1
guardOrElse ::
  (EnvGuard :> es, HasCallStack) =>
  -- | The environment variable.
  String ->
  -- | The expectation.
  ExpectEnv ->
  -- | The action to run if the expectation succeeds.
  Eff es a ->
  -- | The action to run if the expectation fails.
  Eff es e ->
  -- | The result.
  Eff es (Either e a)
guardOrElse :: forall (es :: [Effect]) a e.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es e -> Eff es (Either e a)
guardOrElse [Char]
var ExpectEnv
expect Eff es a
m1 Eff es e
m2 =
  [Char] -> ExpectEnv -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es (Maybe a)
withGuard [Char]
var ExpectEnv
expect Eff es a
m1
    Eff es (Maybe a)
-> (Maybe a -> Eff es (Either e a)) -> Eff es (Either e a)
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> Either e a -> Eff es (Either e a)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> Eff es (Either e a))
-> Either e a -> Eff es (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) -> Eff es e -> Eff es (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es e
m2

-- | @since 0.1
guardOrElse' ::
  (EnvGuard :> es, HasCallStack) =>
  -- | The environment variable.
  String ->
  -- | The expectation.
  ExpectEnv ->
  -- | The action to run if the expectation succeeds.
  Eff es a ->
  -- | The action to run if the expectation fails.
  Eff es a ->
  -- | The result.
  Eff es a
guardOrElse' :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es a -> Eff es a
guardOrElse' [Char]
var ExpectEnv
expect Eff es a
m = (Either a a -> a) -> Eff es (Either a a) -> Eff es a
forall a b. (a -> b) -> Eff es a -> Eff es b
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) (Eff es (Either a a) -> Eff es a)
-> (Eff es a -> Eff es (Either a a)) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ExpectEnv -> Eff es a -> Eff es a -> Eff es (Either a a)
forall (es :: [Effect]) a e.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ExpectEnv -> Eff es a -> Eff es e -> Eff es (Either e a)
guardOrElse [Char]
var ExpectEnv
expect Eff es a
m

-- | @since 0.1
guardSet ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  Eff es a ->
  Eff es (Maybe a)
guardSet :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> Eff es a -> Eff es (Maybe a)
guardSet [Char]
var = [Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
guardPredicate [Char]
var (Bool -> [Char] -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | @since 0.1
guardSet_ ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  Eff es a ->
  Eff es ()
guardSet_ :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> Eff es a -> Eff es ()
guardSet_ [Char]
var = Eff es (Maybe a) -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es (Maybe a) -> Eff es ())
-> (Eff es a -> Eff es (Maybe a)) -> Eff es a -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> Eff es a -> Eff es (Maybe a)
guardSet [Char]
var

-- | @since 0.1
guardEquals ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  String ->
  Eff es a ->
  Eff es (Maybe a)
guardEquals :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> [Char] -> Eff es a -> Eff es (Maybe a)
guardEquals [Char]
var [Char]
expected = [Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
guardPredicate [Char]
var ([Char] -> [Char] -> Bool
eqCaseInsensitive [Char]
expected)

-- | @since 0.1
guardEquals_ ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  String ->
  Eff es a ->
  Eff es ()
guardEquals_ :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> [Char] -> Eff es a -> Eff es ()
guardEquals_ [Char]
var [Char]
expected = Eff es (Maybe a) -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es (Maybe a) -> Eff es ())
-> (Eff es a -> Eff es (Maybe a)) -> Eff es a -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> [Char] -> Eff es a -> Eff es (Maybe a)
guardEquals [Char]
var [Char]
expected

-- | @since 0.1
guardPredicate_ ::
  (EnvGuard :> es, HasCallStack) =>
  String ->
  (String -> Bool) ->
  Eff es a ->
  Eff es ()
guardPredicate_ :: forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es ()
guardPredicate_ [Char]
var [Char] -> Bool
p = Eff es (Maybe a) -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es (Maybe a) -> Eff es ())
-> (Eff es a -> Eff es (Maybe a)) -> Eff es a -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
forall (es :: [Effect]) a.
(EnvGuard :> es, HasCallStack) =>
[Char] -> ([Char] -> Bool) -> Eff es a -> Eff es (Maybe a)
guardPredicate [Char]
var [Char] -> Bool
p

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