module Effectful.Environment
  ( -- * Effect
    Environment

    -- ** Handlers
  , runEnvironment

    -- * Querying the environment
  , getArgs
  , getProgName
  , getExecutablePath
  , getEnv
  , getEnvironment
  , lookupEnv

    -- * Modifying the environment
  , setEnv
  , unsetEnv
  , withArgs
  , withProgName
  ) where

import qualified System.Environment as E

import Effectful
import Effectful.Dispatch.Static

-- | An effect for querying and modifying the system environment.
data Environment :: Effect

type instance DispatchOf Environment = Static WithSideEffects
data instance StaticRep Environment = Environment

-- | Run the 'Environment' effect.
runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
runEnvironment :: Eff (Environment : es) a -> Eff es a
runEnvironment = StaticRep Environment -> Eff (Environment : es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (sideEffects :: SideEffects)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Environment
Environment

-- | Lifted 'E.getArgs'.
getArgs :: Environment :> es => Eff es [String]
getArgs :: Eff es [String]
getArgs = IO [String] -> Eff es [String]
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO [String]
E.getArgs

-- | Lifted 'E.getEnv'.
getEnv :: Environment :> es => String -> Eff es String
getEnv :: String -> Eff es String
getEnv = IO String -> Eff es String
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO String -> Eff es String)
-> (String -> IO String) -> String -> Eff es String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
E.getEnv

-- | Lifted 'E.getEnvironment'.
getEnvironment :: Environment :> es => Eff es [(String, String)]
getEnvironment :: Eff es [(String, String)]
getEnvironment = IO [(String, String)] -> Eff es [(String, String)]
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO [(String, String)]
E.getEnvironment

-- | Lifted 'E.getExecutablePath'.
getExecutablePath :: Environment :> es => Eff es FilePath
getExecutablePath :: Eff es String
getExecutablePath = IO String -> Eff es String
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO String
E.getExecutablePath

-- | Lifted 'E.getProgName'.
getProgName :: Environment :> es => Eff es String
getProgName :: Eff es String
getProgName = IO String -> Eff es String
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO String
E.getProgName

-- | Lifted 'E.lookupEnv'.
lookupEnv :: Environment :> es => String -> Eff es (Maybe String)
lookupEnv :: String -> Eff es (Maybe String)
lookupEnv = IO (Maybe String) -> Eff es (Maybe String)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (Maybe String) -> Eff es (Maybe String))
-> (String -> IO (Maybe String)) -> String -> Eff es (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
E.lookupEnv

-- | Lifted 'E.setEnv'.
setEnv :: Environment :> es => String -> String -> Eff es ()
setEnv :: String -> String -> Eff es ()
setEnv String
n = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (String -> IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
E.setEnv String
n

-- | Lifted 'E.unsetEnv'.
unsetEnv :: Environment :> es => String -> Eff es ()
unsetEnv :: String -> Eff es ()
unsetEnv = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (String -> IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
E.unsetEnv

-- | Lifted 'E.withArgs'.
withArgs :: Environment :> es => [String] -> Eff es a -> Eff es a
withArgs :: [String] -> Eff es a -> Eff es a
withArgs = (IO a -> IO a) -> Eff es a -> Eff es a
forall a b (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
(IO a -> IO b) -> Eff es a -> Eff es b
unsafeLiftMapIO ((IO a -> IO a) -> Eff es a -> Eff es a)
-> ([String] -> IO a -> IO a) -> [String] -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO a -> IO a
forall a. [String] -> IO a -> IO a
E.withArgs

-- | Lifted 'E.withProgName'.
withProgName :: Environment :> es => String -> Eff es a -> Eff es a
withProgName :: String -> Eff es a -> Eff es a
withProgName = (IO a -> IO a) -> Eff es a -> Eff es a
forall a b (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
(IO a -> IO b) -> Eff es a -> Eff es b
unsafeLiftMapIO ((IO a -> IO a) -> Eff es a -> Eff es a)
-> (String -> IO a -> IO a) -> String -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a -> IO a
forall a. String -> IO a -> IO a
E.withProgName