{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Types.EnvSettings
  ( EnvSettings (..)
  , minimalEnvSettings
  , defaultEnvSettings
  , plainEnvSettings
  ) where

import           Stack.Prelude

-- | Controls which version of the environment is used

data EnvSettings = EnvSettings
  { EnvSettings -> Bool
esIncludeLocals :: !Bool
  -- ^ include local project bin directory, GHC_PACKAGE_PATH, etc

  , EnvSettings -> Bool
esIncludeGhcPackagePath :: !Bool
  -- ^ include the GHC_PACKAGE_PATH variable

  , EnvSettings -> Bool
esStackExe :: !Bool
  -- ^ set the STACK_EXE variable to the current executable name

  , EnvSettings -> Bool
esLocaleUtf8 :: !Bool
  -- ^ set the locale to C.UTF-8

  , EnvSettings -> Bool
esKeepGhcRts :: !Bool
  -- ^ if True, keep GHCRTS variable in environment

  }
  deriving (EnvSettings -> EnvSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnvSettings -> EnvSettings -> Bool
$c/= :: EnvSettings -> EnvSettings -> Bool
== :: EnvSettings -> EnvSettings -> Bool
$c== :: EnvSettings -> EnvSettings -> Bool
Eq, Eq EnvSettings
EnvSettings -> EnvSettings -> Bool
EnvSettings -> EnvSettings -> Ordering
EnvSettings -> EnvSettings -> EnvSettings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EnvSettings -> EnvSettings -> EnvSettings
$cmin :: EnvSettings -> EnvSettings -> EnvSettings
max :: EnvSettings -> EnvSettings -> EnvSettings
$cmax :: EnvSettings -> EnvSettings -> EnvSettings
>= :: EnvSettings -> EnvSettings -> Bool
$c>= :: EnvSettings -> EnvSettings -> Bool
> :: EnvSettings -> EnvSettings -> Bool
$c> :: EnvSettings -> EnvSettings -> Bool
<= :: EnvSettings -> EnvSettings -> Bool
$c<= :: EnvSettings -> EnvSettings -> Bool
< :: EnvSettings -> EnvSettings -> Bool
$c< :: EnvSettings -> EnvSettings -> Bool
compare :: EnvSettings -> EnvSettings -> Ordering
$ccompare :: EnvSettings -> EnvSettings -> Ordering
Ord, Int -> EnvSettings -> ShowS
[EnvSettings] -> ShowS
EnvSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvSettings] -> ShowS
$cshowList :: [EnvSettings] -> ShowS
show :: EnvSettings -> String
$cshow :: EnvSettings -> String
showsPrec :: Int -> EnvSettings -> ShowS
$cshowsPrec :: Int -> EnvSettings -> ShowS
Show)

minimalEnvSettings :: EnvSettings
minimalEnvSettings :: EnvSettings
minimalEnvSettings =
  EnvSettings
  { esIncludeLocals :: Bool
esIncludeLocals = Bool
False
  , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
False
  , esStackExe :: Bool
esStackExe = Bool
False
  , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
  , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
False
  }

-- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH.

--

-- Note that this also passes through the GHCRTS environment variable.

-- See https://github.com/commercialhaskell/stack/issues/3444

defaultEnvSettings :: EnvSettings
defaultEnvSettings :: EnvSettings
defaultEnvSettings = EnvSettings
  { esIncludeLocals :: Bool
esIncludeLocals = Bool
True
  , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
True
  , esStackExe :: Bool
esStackExe = Bool
True
  , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
  , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
True
  }

-- | Environment settings which do not embellish the environment

--

-- Note that this also passes through the GHCRTS environment variable.

-- See https://github.com/commercialhaskell/stack/issues/3444

plainEnvSettings :: EnvSettings
plainEnvSettings :: EnvSettings
plainEnvSettings = EnvSettings
  { esIncludeLocals :: Bool
esIncludeLocals = Bool
False
  , esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
False
  , esStackExe :: Bool
esStackExe = Bool
False
  , esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
  , esKeepGhcRts :: Bool
esKeepGhcRts = Bool
True
  }