{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE OverloadedRecordDot   #-}

{-|
Module      : Stack.Types.Runner
License     : BSD-3-Clause
-}

module Stack.Types.Runner
  ( Runner (..)
  , HasRunner (..)
  , HasDockerEntrypointMVar (..)
  , globalOptsL
  , stackYamlLocL
  , lockFileBehaviorL
  , terminalL
  , reExecL
  , rslInLogL
  , progNameL
  , mExecutablePathL
  , viewExecutablePath
  ) where

import           RIO.Process ( HasProcessContext (..), ProcessContext )
import           Stack.Prelude hiding ( stylesUpdate )
import           Stack.Types.Config.Exception ( ConfigPrettyException (..) )
import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
import           Stack.Types.LockFileBehavior ( LockFileBehavior )
import           Stack.Types.StackYamlLoc ( StackYamlLoc )

-- | The base environment that almost everything in Stack runs in, based off of

-- parsing command line options in t'GlobalOpts'. Provides logging, process

-- execution, and the MVar used to ensure that the Docker entrypoint is

-- performed exactly once.

data Runner = Runner
  { Runner -> GlobalOpts
globalOpts           :: !GlobalOpts
  , Runner -> Bool
useColor             :: !Bool
  , Runner -> LogFunc
logFunc              :: !LogFunc
  , Runner -> Int
termWidth            :: !Int
  , Runner -> ProcessContext
processContext       :: !ProcessContext
  , Runner -> MVar Bool
dockerEntrypointMVar :: !(MVar Bool)
  }

instance HasLogFunc Runner where
  logFuncL :: Lens' Runner LogFunc
logFuncL = (Runner -> LogFunc)
-> (Runner -> LogFunc -> Runner) -> Lens' Runner LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.logFunc) (\Runner
x LogFunc
y -> Runner
x { logFunc = y })

instance HasProcessContext Runner where
  processContextL :: Lens' Runner ProcessContext
processContextL =
    (Runner -> ProcessContext)
-> (Runner -> ProcessContext -> Runner)
-> Lens' Runner ProcessContext
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.processContext) (\Runner
x ProcessContext
y -> Runner
x { processContext = y })

instance HasRunner Runner where
  runnerL :: Lens' Runner Runner
runnerL = (Runner -> f Runner) -> Runner -> f Runner
forall a. a -> a
id

instance HasStylesUpdate Runner where
  stylesUpdateL :: Lens' Runner StylesUpdate
  stylesUpdateL :: Lens' Runner StylesUpdate
stylesUpdateL = (GlobalOpts -> f GlobalOpts) -> Runner -> f Runner
forall env. HasRunner env => Lens' env GlobalOpts
Lens' Runner GlobalOpts
globalOptsL ((GlobalOpts -> f GlobalOpts) -> Runner -> f Runner)
-> ((StylesUpdate -> f StylesUpdate) -> GlobalOpts -> f GlobalOpts)
-> (StylesUpdate -> f StylesUpdate)
-> Runner
-> f Runner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> StylesUpdate)
-> (GlobalOpts -> StylesUpdate -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts StylesUpdate StylesUpdate
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (.stylesUpdate)
    (\GlobalOpts
x StylesUpdate
y -> GlobalOpts
x { stylesUpdate = y })

instance HasTerm Runner where
  useColorL :: Lens' Runner Bool
useColorL = (Runner -> Bool) -> (Runner -> Bool -> Runner) -> Lens' Runner Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.useColor) (\Runner
x Bool
y -> Runner
x { useColor = y })
  termWidthL :: Lens' Runner Int
termWidthL = (Runner -> Int) -> (Runner -> Int -> Runner) -> Lens' Runner Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.termWidth) (\Runner
x Int
y -> Runner
x { termWidth  = y })

instance HasDockerEntrypointMVar Runner where
  dockerEntrypointMVarL :: Lens' Runner (MVar Bool)
dockerEntrypointMVarL =
    (Runner -> MVar Bool)
-> (Runner -> MVar Bool -> Runner) -> Lens' Runner (MVar Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.dockerEntrypointMVar) (\Runner
x MVar Bool
y -> Runner
x { dockerEntrypointMVar = y })

-- | Class for environment values which have a t'Runner'.

class (HasProcessContext env, HasLogFunc env) => HasRunner env where
  runnerL :: Lens' env Runner

-- | Class for environment values which have a Docker entrypoint 'MVar'.

class HasRunner env => HasDockerEntrypointMVar env where
  dockerEntrypointMVarL :: Lens' env (MVar Bool)

-- | See the @stackYaml@ field of the v'GlobalOpts' data constructor.

stackYamlLocL :: HasRunner env => Lens' env StackYamlLoc
stackYamlLocL :: forall env. HasRunner env => Lens' env StackYamlLoc
stackYamlLocL =
  (GlobalOpts -> f GlobalOpts) -> env -> f env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> f GlobalOpts) -> env -> f env)
-> ((StackYamlLoc -> f StackYamlLoc) -> GlobalOpts -> f GlobalOpts)
-> (StackYamlLoc -> f StackYamlLoc)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> StackYamlLoc)
-> (GlobalOpts -> StackYamlLoc -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts StackYamlLoc StackYamlLoc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.stackYaml) (\GlobalOpts
x StackYamlLoc
y -> GlobalOpts
x { stackYaml = y })

-- | See the @lockFileBehavior@ field of the v'GlobalOpts' data constructor.

lockFileBehaviorL :: HasRunner env => SimpleGetter env LockFileBehavior
lockFileBehaviorL :: forall env. HasRunner env => SimpleGetter env LockFileBehavior
lockFileBehaviorL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((LockFileBehavior -> Const r LockFileBehavior)
    -> GlobalOpts -> Const r GlobalOpts)
-> (LockFileBehavior -> Const r LockFileBehavior)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> LockFileBehavior)
-> SimpleGetter GlobalOpts LockFileBehavior
forall s a. (s -> a) -> SimpleGetter s a
to (.lockFileBehavior)

-- | See the t'GlobalOpts' type.

globalOptsL :: HasRunner env => Lens' env GlobalOpts
globalOptsL :: forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL = (Runner -> f Runner) -> env -> f env
forall env. HasRunner env => Lens' env Runner
Lens' env Runner
runnerL ((Runner -> f Runner) -> env -> f env)
-> ((GlobalOpts -> f GlobalOpts) -> Runner -> f Runner)
-> (GlobalOpts -> f GlobalOpts)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Runner -> GlobalOpts)
-> (Runner -> GlobalOpts -> Runner) -> Lens' Runner GlobalOpts
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.globalOpts) (\Runner
x GlobalOpts
y -> Runner
x { globalOpts = y })

-- | See the @terminal@ field of the v'GlobalOpts' data constructor.

terminalL :: HasRunner env => Lens' env Bool
terminalL :: forall env. HasRunner env => Lens' env Bool
terminalL =
  (GlobalOpts -> f GlobalOpts) -> env -> f env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> f GlobalOpts) -> env -> f env)
-> ((Bool -> f Bool) -> GlobalOpts -> f GlobalOpts)
-> (Bool -> f Bool)
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> Bool)
-> (GlobalOpts -> Bool -> GlobalOpts)
-> Lens GlobalOpts GlobalOpts Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.terminal) (\GlobalOpts
x Bool
y -> GlobalOpts
x { terminal = y })

-- | See the @reExecVersion@ field of the v'GlobalOpts' data constructor.

reExecL :: HasRunner env => SimpleGetter env Bool
reExecL :: forall env. HasRunner env => SimpleGetter env Bool
reExecL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((Bool -> Const r Bool) -> GlobalOpts -> Const r GlobalOpts)
-> (Bool -> Const r Bool)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> Bool) -> SimpleGetter GlobalOpts Bool
forall s a. (s -> a) -> SimpleGetter s a
to (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (GlobalOpts -> Maybe String) -> GlobalOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.reExecVersion))

-- | See the @rslInLog@ field of the v'GlobalOpts' data constructor.

rslInLogL :: HasRunner env => SimpleGetter env Bool
rslInLogL :: forall env. HasRunner env => SimpleGetter env Bool
rslInLogL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((Bool -> Const r Bool) -> GlobalOpts -> Const r GlobalOpts)
-> (Bool -> Const r Bool)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> Bool) -> SimpleGetter GlobalOpts Bool
forall s a. (s -> a) -> SimpleGetter s a
to (.rslInLog)

-- | See the @progNameL@ field of the v'GlobalOpts' data constructor.

progNameL :: HasRunner env => SimpleGetter env String
progNameL :: forall env. HasRunner env => SimpleGetter env String
progNameL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((String -> Const r String) -> GlobalOpts -> Const r GlobalOpts)
-> (String -> Const r String)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> String) -> SimpleGetter GlobalOpts String
forall s a. (s -> a) -> SimpleGetter s a
to (.progName)

-- | See the @mExecutablePath@ field of the v'GlobalOpts' data constructor.

mExecutablePathL :: HasRunner env => SimpleGetter env (Maybe (Path Abs File))
mExecutablePathL :: forall env.
HasRunner env =>
SimpleGetter env (Maybe (Path Abs File))
mExecutablePathL = (GlobalOpts -> Const r GlobalOpts) -> env -> Const r env
forall env. HasRunner env => Lens' env GlobalOpts
Lens' env GlobalOpts
globalOptsL ((GlobalOpts -> Const r GlobalOpts) -> env -> Const r env)
-> ((Maybe (Path Abs File) -> Const r (Maybe (Path Abs File)))
    -> GlobalOpts -> Const r GlobalOpts)
-> (Maybe (Path Abs File) -> Const r (Maybe (Path Abs File)))
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalOpts -> Maybe (Path Abs File))
-> SimpleGetter GlobalOpts (Maybe (Path Abs File))
forall s a. (s -> a) -> SimpleGetter s a
to (.mExecutablePath)

-- | Yield the path to the current Stack executable, if the operating system

-- provides a reliable way to determine it. Otherwise throw

-- 'Stack.Types.Config.Exception.NoExecutablePath'.

viewExecutablePath :: HasRunner env => RIO env (Path Abs File)
viewExecutablePath :: forall env. HasRunner env => RIO env (Path Abs File)
viewExecutablePath = Getting (Maybe (Path Abs File)) env (Maybe (Path Abs File))
-> RIO env (Maybe (Path Abs File))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe (Path Abs File)) env (Maybe (Path Abs File))
forall env.
HasRunner env =>
SimpleGetter env (Maybe (Path Abs File))
SimpleGetter env (Maybe (Path Abs File))
mExecutablePathL RIO env (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> RIO env (Path Abs File))
-> RIO env (Path Abs File)
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Path Abs File)
Nothing -> Getting String env String -> RIO env String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String env String
forall env. HasRunner env => SimpleGetter env String
SimpleGetter env String
progNameL RIO env String
-> (String -> RIO env (Path Abs File)) -> RIO env (Path Abs File)
forall a b. RIO env a -> (a -> RIO env b) -> RIO env b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConfigPrettyException -> RIO env (Path Abs File)
forall e (m :: * -> *) a.
(Exception e, MonadThrow m, Pretty e) =>
e -> m a
prettyThrowM (ConfigPrettyException -> RIO env (Path Abs File))
-> (String -> ConfigPrettyException)
-> String
-> RIO env (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ConfigPrettyException
NoExecutablePath
    Just Path Abs File
executablePath -> Path Abs File -> RIO env (Path Abs File)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
executablePath