{-# LANGUAGE CPP #-}

{- ORMOLU_DISABLE -}

-- | Dynamic effects for "System.Environment". For static effects, see
-- https://hackage.haskell.org/package/effectful-2.2.2.0/docs/Effectful-Environment.html.
--
-- @since 0.1
module Effectful.Environment.Dynamic
  ( -- * Effect
    Environment (..),
    getArgs,
    getProgName,
#if MIN_VERSION_base(4,17,0)
    executablePath,
#endif
    getExecutablePath,
    getEnv,
    lookupEnv,
    setEnv,
    unsetEnv,
    withArgs,
    withProgName,
    getEnvironment,

    -- ** Handlers
    runEnvironment,

    -- * Types
    QueryExePath (..),
  )
where

{- ORMOLU_ENABLE -}

import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic
  ( HasCallStack,
    localSeqUnlift,
    reinterpret,
    send,
  )
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Environment.Static qualified as Static
import Effectful.Environment.Utils (QueryExePath (NoQuery, QueryResult))

{- ORMOLU_DISABLE -}

-- | Dynamic effects for "System.Environment".
--
-- @since 0.1
data Environment :: Effect where
  GetArgs :: Environment m [String]
  GetProgName :: Environment m String
#if MIN_VERSION_base(4,17,0)
  ExecutablePath :: (Environment m QueryExePath)
#endif
  GetExecutablePath :: Environment m FilePath
  GetEnv :: String -> Environment m String
  LookupEnv :: String -> Environment m (Maybe String)
  SetEnv :: String -> String -> Environment m ()
  UnsetEnv :: String -> Environment m ()
  WithArgs :: [String] -> m a -> Environment m a
  WithProgName :: String -> m () -> Environment m ()
  GetEnvironment :: Environment m [(String, String)]

-- | @since 0.1
instance ShowEffect Environment where
  showEffectCons :: forall (m :: * -> *) a. Environment m a -> String
showEffectCons = \case
    Environment m a
GetArgs -> String
"GetArgs"
    Environment m a
GetProgName -> String
"GetProgName"
#if MIN_VERSION_base(4,17,0)
    Environment m a
ExecutablePath -> String
"ExecutablePath"
#endif
    Environment m a
GetExecutablePath -> String
"GetExecutablePath"
    GetEnv String
_ -> String
"GetEnv"
    LookupEnv String
_ -> String
"LookupEnv"
    SetEnv String
_ String
_ -> String
"SetEnv"
    UnsetEnv String
_ -> String
"UnsetEnv"
    WithArgs [String]
_ m a
_ -> String
"WithArgs"
    WithProgName String
_ m ()
_ -> String
"WithProgName"
    Environment m a
GetEnvironment -> String
"GetEnvironment"

{- ORMOLU_ENABLE -}

-- | @since 0.1
type instance DispatchOf Environment = Dynamic

{- ORMOLU_DISABLE -}

-- | Runs 'Environment' in 'IO'.
--
-- @since 0.1
runEnvironment ::
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (Environment : es) a ->
  Eff es a
runEnvironment :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Environment : es) a -> Eff es a
runEnvironment = (Eff (Environment : es) a -> Eff es a)
-> EffectHandler Environment (Environment : es)
-> Eff (Environment : es) a
-> Eff es a
forall (e :: (* -> *) -> * -> *)
       (handlerEs :: [(* -> *) -> * -> *]) a (es :: [(* -> *) -> * -> *])
       b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Environment : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Environment : es) a -> Eff es a
Static.runEnvironment (EffectHandler Environment (Environment : es)
 -> Eff (Environment : es) a -> Eff es a)
-> EffectHandler Environment (Environment : es)
-> Eff (Environment : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Environment : es)
env -> \case
  Environment (Eff localEs) a
GetArgs -> Eff (Environment : es) a
Eff (Environment : es) [String]
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
Eff es [String]
Static.getArgs
  Environment (Eff localEs) a
GetProgName -> Eff (Environment : es) a
Eff (Environment : es) String
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
Eff es String
Static.getProgName
#if MIN_VERSION_base(4,17,0)
  Environment (Eff localEs) a
ExecutablePath -> Eff (Environment : es) a
Eff (Environment : es) QueryExePath
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es QueryExePath
Static.executablePath
#endif
  Environment (Eff localEs) a
GetExecutablePath -> Eff (Environment : es) a
Eff (Environment : es) String
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
Eff es String
Static.getExecutablePath
  GetEnv String
s -> String -> Eff (Environment : es) String
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
String -> Eff es String
Static.getEnv String
s
  LookupEnv String
s -> String -> Eff (Environment : es) (Maybe String)
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
String -> Eff es (Maybe String)
Static.lookupEnv String
s
  SetEnv String
s String
t -> String -> String -> Eff (Environment : es) ()
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
String -> String -> Eff es ()
Static.setEnv String
s String
t
  UnsetEnv String
s -> String -> Eff (Environment : es) ()
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
String -> Eff es ()
Static.unsetEnv String
s
  WithArgs [String]
args Eff localEs a
m -> LocalEnv localEs (Environment : es)
-> ((forall r. Eff localEs r -> Eff (Environment : es) r)
    -> Eff (Environment : es) a)
-> Eff (Environment : es) a
forall (es :: [(* -> *) -> * -> *])
       (handlerEs :: [(* -> *) -> * -> *])
       (localEs :: [(* -> *) -> * -> *]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Environment : es)
env (((forall r. Eff localEs r -> Eff (Environment : es) r)
  -> Eff (Environment : es) a)
 -> Eff (Environment : es) a)
-> ((forall r. Eff localEs r -> Eff (Environment : es) r)
    -> Eff (Environment : es) a)
-> Eff (Environment : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (Environment : es) r
runInStatic ->
    [String] -> Eff (Environment : es) a -> Eff (Environment : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(Environment :> es) =>
[String] -> Eff es a -> Eff es a
Static.withArgs [String]
args (Eff localEs a -> Eff (Environment : es) a
forall r. Eff localEs r -> Eff (Environment : es) r
runInStatic Eff localEs a
m)
  WithProgName String
name Eff localEs ()
m -> LocalEnv localEs (Environment : es)
-> ((forall r. Eff localEs r -> Eff (Environment : es) r)
    -> Eff (Environment : es) a)
-> Eff (Environment : es) a
forall (es :: [(* -> *) -> * -> *])
       (handlerEs :: [(* -> *) -> * -> *])
       (localEs :: [(* -> *) -> * -> *]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Environment : es)
env (((forall r. Eff localEs r -> Eff (Environment : es) r)
  -> Eff (Environment : es) a)
 -> Eff (Environment : es) a)
-> ((forall r. Eff localEs r -> Eff (Environment : es) r)
    -> Eff (Environment : es) a)
-> Eff (Environment : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (Environment : es) r
runInStatic ->
    String -> Eff (Environment : es) a -> Eff (Environment : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(Environment :> es) =>
String -> Eff es a -> Eff es a
Static.withProgName String
name (Eff localEs a -> Eff (Environment : es) a
forall r. Eff localEs r -> Eff (Environment : es) r
runInStatic Eff localEs a
Eff localEs ()
m)
  Environment (Eff localEs) a
GetEnvironment -> Eff (Environment : es) a
Eff (Environment : es) [(String, String)]
forall (es :: [(* -> *) -> * -> *]).
(Environment :> es) =>
Eff es [(String, String)]
Static.getEnvironment

{- ORMOLU_ENABLE -}

-- | Lifted 'Env.getArgs'.
--
-- @since 0.1
getArgs :: (Environment :> es, HasCallStack) => Eff es [String]
getArgs :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es [String]
getArgs = Environment (Eff es) [String] -> Eff es [String]
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Environment (Eff es) [String]
forall (m :: * -> *). Environment m [String]
GetArgs

-- | Lifted 'Env.getProgName'.
--
-- @since 0.1
getProgName :: (Environment :> es, HasCallStack) => Eff es String
getProgName :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es String
getProgName = Environment (Eff es) String -> Eff es String
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Environment (Eff es) String
forall (m :: * -> *). Environment m String
GetProgName

#if MIN_VERSION_base(4,17,0)

-- | Lifted 'Env.executablePath'.
--
-- @since 0.1
executablePath :: (Environment :> es, HasCallStack) => Eff es QueryExePath
executablePath :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es QueryExePath
executablePath = Environment (Eff es) QueryExePath -> Eff es QueryExePath
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Environment (Eff es) QueryExePath
forall (m :: * -> *). Environment m QueryExePath
ExecutablePath

#endif

-- | Lifted 'Env.getExecutablePath'.
--
-- @since 0.1
getExecutablePath :: (Environment :> es, HasCallStack) => Eff es FilePath
getExecutablePath :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es String
getExecutablePath = Environment (Eff es) String -> Eff es String
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Environment (Eff es) String
forall (m :: * -> *). Environment m String
GetExecutablePath

-- | Lifted 'Env.getEnv'.
--
-- @since 0.1
getEnv :: (Environment :> es, HasCallStack) => String -> Eff es String
getEnv :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
String -> Eff es String
getEnv = Environment (Eff es) String -> Eff es String
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) String -> Eff es String)
-> (String -> Environment (Eff es) String)
-> String
-> Eff es String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Environment (Eff es) String
forall (m :: * -> *). String -> Environment m String
GetEnv

-- | Lifted 'Env.lookupEnv'.
--
-- @since 0.1
lookupEnv ::
  (Environment :> es, HasCallStack) =>
  String ->
  Eff es (Maybe String)
lookupEnv :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
String -> Eff es (Maybe String)
lookupEnv = Environment (Eff es) (Maybe String) -> Eff es (Maybe String)
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) (Maybe String) -> Eff es (Maybe String))
-> (String -> Environment (Eff es) (Maybe String))
-> String
-> Eff es (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Environment (Eff es) (Maybe String)
forall (m :: * -> *). String -> Environment m (Maybe String)
LookupEnv

-- | Lifted 'Env.setEnv'.
--
-- @since 0.1
setEnv :: (Environment :> es, HasCallStack) => String -> String -> Eff es ()
setEnv :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
String -> String -> Eff es ()
setEnv String
s = Environment (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) () -> Eff es ())
-> (String -> Environment (Eff es) ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Environment (Eff es) ()
forall (m :: * -> *). String -> String -> Environment m ()
SetEnv String
s

-- | Lifted 'Env.unsetEnv'.
--
-- @since 0.1
unsetEnv :: (Environment :> es, HasCallStack) => String -> Eff es ()
unsetEnv :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
String -> Eff es ()
unsetEnv = Environment (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) () -> Eff es ())
-> (String -> Environment (Eff es) ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Environment (Eff es) ()
forall (m :: * -> *). String -> Environment m ()
UnsetEnv

-- | Lifted 'Env.withArgs'.
--
-- @since 0.1
withArgs ::
  (Environment :> es, HasCallStack) =>
  [String] ->
  Eff es a ->
  Eff es a
withArgs :: forall (es :: [(* -> *) -> * -> *]) a.
(Environment :> es, HasCallStack) =>
[String] -> Eff es a -> Eff es a
withArgs [String]
args = Environment (Eff es) a -> Eff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) a -> Eff es a)
-> (Eff es a -> Environment (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Eff es a -> Environment (Eff es) a
forall (m :: * -> *) a. [String] -> m a -> Environment m a
WithArgs [String]
args

-- | Lifted 'Env.withProgName'.
--
-- @since 0.1
withProgName ::
  (Environment :> es, HasCallStack) =>
  String ->
  Eff es () ->
  Eff es ()
withProgName :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
String -> Eff es () -> Eff es ()
withProgName String
name = Environment (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Environment (Eff es) () -> Eff es ())
-> (Eff es () -> Environment (Eff es) ()) -> Eff es () -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Eff es () -> Environment (Eff es) ()
forall (m :: * -> *). String -> m () -> Environment m ()
WithProgName String
name

-- | Lifted 'Env.getEnvironment'.
--
-- @since 0.1
getEnvironment :: (Environment :> es, HasCallStack) => Eff es [(String, String)]
getEnvironment :: forall (es :: [(* -> *) -> * -> *]).
(Environment :> es, HasCallStack) =>
Eff es [(String, String)]
getEnvironment = Environment (Eff es) [(String, String)]
-> Eff es [(String, String)]
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Environment (Eff es) [(String, String)]
forall (m :: * -> *). Environment m [(String, String)]
GetEnvironment