{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- | Types and function related to Stack's @exec@, @ghc@, @run@, @runghc@ and

-- @runhaskell@ commands.

module Stack.Exec
  ( ExecOpts (..)
  , SpecialExecCmd (..)
  , ExecOptsExtra (..)
  , execCmd
  ) where

import qualified Data.List as L
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import           RIO.Process ( exec )
import           Stack.Build ( build )
import           Stack.Build.Target ( NeedTargets (..) )
import           Stack.GhcPkg ( findGhcPkgField )
import           Stack.Setup ( withNewLocalBuildTargets )
import           Stack.Types.NamedComponent ( NamedComponent (..), isCExe )
import           Stack.Prelude
import           Stack.Runners ( ShouldReexec (..), withConfig, withEnvConfig )
import           Stack.Types.BuildConfig
                   ( BuildConfig (..), HasBuildConfig (..) )
import           Stack.Types.BuildOpts
                   ( BuildOptsCLI (..), defaultBuildOptsCLI )
import           Stack.Types.CompilerPaths
                   ( CompilerPaths (..), HasCompiler (..), getGhcPkgExe )
import           Stack.Types.Config ( Config (..), HasConfig (..) )
import           Stack.Types.EnvConfig ( EnvConfig )
import           Stack.Types.EnvSettings ( EnvSettings (..) )
import           Stack.Types.Runner ( Runner )
import           Stack.Types.SourceMap ( SMWanted (..), ppComponents )
import           System.Directory ( withCurrentDirectory )
import           System.FilePath ( isValid )

-- | Type representing exceptions thrown by functions in the "Stack.Exec"

-- module.

newtype ExecException
  = InvalidPathForExec FilePath
  deriving (Int -> ExecException -> ShowS
[ExecException] -> ShowS
ExecException -> String
(Int -> ExecException -> ShowS)
-> (ExecException -> String)
-> ([ExecException] -> ShowS)
-> Show ExecException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecException -> ShowS
showsPrec :: Int -> ExecException -> ShowS
$cshow :: ExecException -> String
show :: ExecException -> String
$cshowList :: [ExecException] -> ShowS
showList :: [ExecException] -> ShowS
Show, Typeable)

instance Exception ExecException where
  displayException :: ExecException -> String
displayException (InvalidPathForExec String
path) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Error: [S-1541]\n"
    , String
"Got an invalid '--cwd' argument for 'stack exec' ("
    , String
path
    , String
")."
    ]

-- | Type representing \'pretty\' exceptions thrown by functions in the

-- "Stack.Exec" module.

data ExecPrettyException
  = PackageIdNotFoundBug !String
  | ExecutableToRunNotFound
  deriving (Int -> ExecPrettyException -> ShowS
[ExecPrettyException] -> ShowS
ExecPrettyException -> String
(Int -> ExecPrettyException -> ShowS)
-> (ExecPrettyException -> String)
-> ([ExecPrettyException] -> ShowS)
-> Show ExecPrettyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecPrettyException -> ShowS
showsPrec :: Int -> ExecPrettyException -> ShowS
$cshow :: ExecPrettyException -> String
show :: ExecPrettyException -> String
$cshowList :: [ExecPrettyException] -> ShowS
showList :: [ExecPrettyException] -> ShowS
Show, Typeable)

instance Pretty ExecPrettyException where
  pretty :: ExecPrettyException -> StyleDoc
pretty (PackageIdNotFoundBug String
name) = String -> StyleDoc -> StyleDoc
bugPrettyReport String
"[S-8251]" (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$
    StyleDoc
"Could not find the package id of the package" StyleDoc -> StyleDoc -> StyleDoc
<+>
      Style -> StyleDoc -> StyleDoc
style Style
Target (String -> StyleDoc
forall a. IsString a => String -> a
fromString String
name)
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
  pretty ExecPrettyException
ExecutableToRunNotFound =
       StyleDoc
"[S-2483]"
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"No executables found."

instance Exception ExecPrettyException

-- Type representing Stack's execution commands.

data SpecialExecCmd
  = ExecCmd String
  | ExecRun
  | ExecGhc
  | ExecRunGhc
  deriving (SpecialExecCmd -> SpecialExecCmd -> Bool
(SpecialExecCmd -> SpecialExecCmd -> Bool)
-> (SpecialExecCmd -> SpecialExecCmd -> Bool) -> Eq SpecialExecCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialExecCmd -> SpecialExecCmd -> Bool
== :: SpecialExecCmd -> SpecialExecCmd -> Bool
$c/= :: SpecialExecCmd -> SpecialExecCmd -> Bool
/= :: SpecialExecCmd -> SpecialExecCmd -> Bool
Eq, Int -> SpecialExecCmd -> ShowS
[SpecialExecCmd] -> ShowS
SpecialExecCmd -> String
(Int -> SpecialExecCmd -> ShowS)
-> (SpecialExecCmd -> String)
-> ([SpecialExecCmd] -> ShowS)
-> Show SpecialExecCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecialExecCmd -> ShowS
showsPrec :: Int -> SpecialExecCmd -> ShowS
$cshow :: SpecialExecCmd -> String
show :: SpecialExecCmd -> String
$cshowList :: [SpecialExecCmd] -> ShowS
showList :: [SpecialExecCmd] -> ShowS
Show)

data ExecOptsExtra = ExecOptsExtra
  { ExecOptsExtra -> EnvSettings
eoEnvSettings :: !EnvSettings
  , ExecOptsExtra -> [String]
eoPackages :: ![String]
  , ExecOptsExtra -> [String]
eoRtsOptions :: ![String]
  , ExecOptsExtra -> Maybe String
eoCwd :: !(Maybe FilePath)
  }
  deriving Int -> ExecOptsExtra -> ShowS
[ExecOptsExtra] -> ShowS
ExecOptsExtra -> String
(Int -> ExecOptsExtra -> ShowS)
-> (ExecOptsExtra -> String)
-> ([ExecOptsExtra] -> ShowS)
-> Show ExecOptsExtra
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecOptsExtra -> ShowS
showsPrec :: Int -> ExecOptsExtra -> ShowS
$cshow :: ExecOptsExtra -> String
show :: ExecOptsExtra -> String
$cshowList :: [ExecOptsExtra] -> ShowS
showList :: [ExecOptsExtra] -> ShowS
Show

-- Type representing options for Stack's execution commands.

data ExecOpts = ExecOpts
  { ExecOpts -> SpecialExecCmd
eoCmd :: !SpecialExecCmd
  , ExecOpts -> [String]
eoArgs :: ![String]
  , ExecOpts -> ExecOptsExtra
eoExtra :: !ExecOptsExtra
  }
  deriving Int -> ExecOpts -> ShowS
[ExecOpts] -> ShowS
ExecOpts -> String
(Int -> ExecOpts -> ShowS)
-> (ExecOpts -> String) -> ([ExecOpts] -> ShowS) -> Show ExecOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecOpts -> ShowS
showsPrec :: Int -> ExecOpts -> ShowS
$cshow :: ExecOpts -> String
show :: ExecOpts -> String
$cshowList :: [ExecOpts] -> ShowS
showList :: [ExecOpts] -> ShowS
Show

-- | The function underlying Stack's @exec@, @ghc@, @run@, @runghc@ and

-- @runhaskell@ commands. Execute a command.

execCmd :: ExecOpts -> RIO Runner ()
execCmd :: ExecOpts -> RIO Runner ()
execCmd ExecOpts {[String]
ExecOptsExtra
SpecialExecCmd
eoCmd :: ExecOpts -> SpecialExecCmd
eoArgs :: ExecOpts -> [String]
eoExtra :: ExecOpts -> ExecOptsExtra
eoCmd :: SpecialExecCmd
eoArgs :: [String]
eoExtra :: ExecOptsExtra
..} =
  ShouldReexec -> RIO Config () -> RIO Runner ()
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec (RIO Config () -> RIO Runner ()) -> RIO Config () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$ NeedTargets -> BuildOptsCLI -> RIO EnvConfig () -> RIO Config ()
forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
AllowNoTargets BuildOptsCLI
boptsCLI (RIO EnvConfig () -> RIO Config ())
-> RIO EnvConfig () -> RIO Config ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> RIO EnvConfig () -> RIO EnvConfig ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
targets) (RIO EnvConfig () -> RIO EnvConfig ())
-> RIO EnvConfig () -> RIO EnvConfig ()
forall a b. (a -> b) -> a -> b
$ Maybe (Set (Path Abs File) -> IO ()) -> RIO EnvConfig ()
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
forall a. Maybe a
Nothing

    Config
config <- Getting Config EnvConfig Config -> RIO EnvConfig Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config EnvConfig Config
forall env. HasConfig env => Lens' env Config
Lens' EnvConfig Config
configL
    ProcessContext
menv <- IO ProcessContext -> RIO EnvConfig ProcessContext
forall a. IO a -> RIO EnvConfig a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessContext -> RIO EnvConfig ProcessContext)
-> IO ProcessContext -> RIO EnvConfig ProcessContext
forall a b. (a -> b) -> a -> b
$ Config -> EnvSettings -> IO ProcessContext
configProcessContextSettings Config
config EnvSettings
eoEnvSettings
    ProcessContext -> RIO EnvConfig () -> RIO EnvConfig ()
forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv (RIO EnvConfig () -> RIO EnvConfig ())
-> RIO EnvConfig () -> RIO EnvConfig ()
forall a b. (a -> b) -> a -> b
$ do
      -- Add RTS options to arguments

      let argsWithRts :: [String] -> [String]
argsWithRts [String]
args = if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
eoRtsOptions
                  then [String]
args :: [String]
                  else [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"+RTS"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
eoRtsOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-RTS"]
      (String
cmd, [String]
args) <- case (SpecialExecCmd
eoCmd, [String] -> [String]
argsWithRts [String]
eoArgs) of
        (ExecCmd String
cmd, [String]
args) -> (String, [String]) -> RIO EnvConfig (String, [String])
forall a. a -> RIO EnvConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
cmd, [String]
args)
        (SpecialExecCmd
ExecRun, [String]
args) -> [String] -> RIO EnvConfig (String, [String])
forall {s}. HasEnvConfig s => [String] -> RIO s (String, [String])
getRunCmd [String]
args
        (SpecialExecCmd
ExecGhc, [String]
args) -> [String] -> [String] -> RIO EnvConfig (String, [String])
forall {s}.
(HasCompiler s, HasProcessContext s, HasTerm s) =>
[String] -> [String] -> RIO s (String, [String])
getGhcCmd [String]
eoPackages [String]
args
        (SpecialExecCmd
ExecRunGhc, [String]
args) -> [String] -> [String] -> RIO EnvConfig (String, [String])
forall {s}.
(HasCompiler s, HasProcessContext s, HasTerm s) =>
[String] -> [String] -> RIO s (String, [String])
getRunGhcCmd [String]
eoPackages [String]
args

      Maybe String -> RIO EnvConfig () -> RIO EnvConfig ()
runWithPath Maybe String
eoCwd (RIO EnvConfig () -> RIO EnvConfig ())
-> RIO EnvConfig () -> RIO EnvConfig ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> RIO EnvConfig ()
forall env b.
(HasProcessContext env, HasLogFunc env) =>
String -> [String] -> RIO env b
exec String
cmd [String]
args
 where
  ExecOptsExtra {[String]
Maybe String
EnvSettings
eoEnvSettings :: ExecOptsExtra -> EnvSettings
eoPackages :: ExecOptsExtra -> [String]
eoRtsOptions :: ExecOptsExtra -> [String]
eoCwd :: ExecOptsExtra -> Maybe String
eoEnvSettings :: EnvSettings
eoRtsOptions :: [String]
eoPackages :: [String]
eoCwd :: Maybe String
..} = ExecOptsExtra
eoExtra

  targets :: [String]
targets = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words [String]
eoPackages
  boptsCLI :: BuildOptsCLI
boptsCLI = BuildOptsCLI
defaultBuildOptsCLI
             { boptsCLITargets :: [Text]
boptsCLITargets = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
targets
             }

  -- return the package-id of the first package in GHC_PACKAGE_PATH

  getPkgId :: String -> RIO env String
getPkgId String
name = do
    GhcPkgExe
pkg <- RIO env GhcPkgExe
forall env. HasCompiler env => RIO env GhcPkgExe
getGhcPkgExe
    Maybe Text
mId <- GhcPkgExe
-> [Path Abs Dir] -> String -> Text -> RIO env (Maybe Text)
forall env.
(HasProcessContext env, HasTerm env) =>
GhcPkgExe
-> [Path Abs Dir] -> String -> Text -> RIO env (Maybe Text)
findGhcPkgField GhcPkgExe
pkg [] String
name Text
"id"
    case Maybe Text
mId of
      Just Text
i -> String -> RIO env String
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> String
forall a. HasCallStack => [a] -> a
L.head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
words (Text -> String
T.unpack Text
i))
      -- should never happen as we have already installed the packages

      Maybe Text
_      -> ExecPrettyException -> RIO env String
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO (String -> ExecPrettyException
PackageIdNotFoundBug String
name)

  getPkgOpts :: [String] -> RIO env [String]
getPkgOpts [String]
pkgs =
    ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-package-id=" ++) ([String] -> [String]) -> RIO env [String] -> RIO env [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> RIO env String) -> [String] -> RIO env [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> RIO env String
forall {env}.
(HasCompiler env, HasProcessContext env, HasTerm env) =>
String -> RIO env String
getPkgId [String]
pkgs

  getRunCmd :: [String] -> RIO s (String, [String])
getRunCmd [String]
args = do
    Map PackageName ProjectPackage
packages <- Getting
  (Map PackageName ProjectPackage) s (Map PackageName ProjectPackage)
-> RIO s (Map PackageName ProjectPackage)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Map PackageName ProjectPackage) s (Map PackageName ProjectPackage)
 -> RIO s (Map PackageName ProjectPackage))
-> Getting
     (Map PackageName ProjectPackage) s (Map PackageName ProjectPackage)
-> RIO s (Map PackageName ProjectPackage)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Map PackageName ProjectPackage) BuildConfig)
-> s -> Const (Map PackageName ProjectPackage) s
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' s BuildConfig
buildConfigL((BuildConfig
  -> Const (Map PackageName ProjectPackage) BuildConfig)
 -> s -> Const (Map PackageName ProjectPackage) s)
-> ((Map PackageName ProjectPackage
     -> Const
          (Map PackageName ProjectPackage) (Map PackageName ProjectPackage))
    -> BuildConfig
    -> Const (Map PackageName ProjectPackage) BuildConfig)
-> Getting
     (Map PackageName ProjectPackage) s (Map PackageName ProjectPackage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Map PackageName ProjectPackage)
-> SimpleGetter BuildConfig (Map PackageName ProjectPackage)
forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> Map PackageName ProjectPackage
smwProject (SMWanted -> Map PackageName ProjectPackage)
-> (BuildConfig -> SMWanted)
-> BuildConfig
-> Map PackageName ProjectPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)
    [Set NamedComponent]
pkgComponents <- [ProjectPackage]
-> (ProjectPackage -> RIO s (Set NamedComponent))
-> RIO s [Set NamedComponent]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map PackageName ProjectPackage -> [ProjectPackage]
forall k a. Map k a -> [a]
Map.elems Map PackageName ProjectPackage
packages) ProjectPackage -> RIO s (Set NamedComponent)
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m (Set NamedComponent)
ppComponents
    let executables :: [NamedComponent]
executables = (Set NamedComponent -> [NamedComponent])
-> [Set NamedComponent] -> [NamedComponent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((NamedComponent -> Bool) -> [NamedComponent] -> [NamedComponent]
forall a. (a -> Bool) -> [a] -> [a]
filter NamedComponent -> Bool
isCExe ([NamedComponent] -> [NamedComponent])
-> (Set NamedComponent -> [NamedComponent])
-> Set NamedComponent
-> [NamedComponent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList) [Set NamedComponent]
pkgComponents
    let (Maybe NamedComponent
exe, [String]
args') = case [String]
args of
                       []   -> (Maybe NamedComponent
firstExe, [String]
args)
                       String
x:[String]
xs -> case (NamedComponent -> Bool)
-> [NamedComponent] -> Maybe NamedComponent
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\NamedComponent
y -> NamedComponent
y NamedComponent -> NamedComponent -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> NamedComponent
CExe (String -> Text
T.pack String
x)) [NamedComponent]
executables of
                               Maybe NamedComponent
Nothing -> (Maybe NamedComponent
firstExe, [String]
args)
                               Maybe NamedComponent
argExe -> (Maybe NamedComponent
argExe, [String]
xs)
                       where
                          firstExe :: Maybe NamedComponent
firstExe = [NamedComponent] -> Maybe NamedComponent
forall a. [a] -> Maybe a
listToMaybe [NamedComponent]
executables
    case Maybe NamedComponent
exe of
      Just (CExe Text
exe') -> do
        [Text] -> RIO s () -> RIO s ()
forall env a. HasEnvConfig env => [Text] -> RIO env a -> RIO env a
withNewLocalBuildTargets [Char -> Text -> Text
T.cons Char
':' Text
exe'] (RIO s () -> RIO s ()) -> RIO s () -> RIO s ()
forall a b. (a -> b) -> a -> b
$ Maybe (Set (Path Abs File) -> IO ()) -> RIO s ()
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build Maybe (Set (Path Abs File) -> IO ())
forall a. Maybe a
Nothing
        (String, [String]) -> RIO s (String, [String])
forall a. a -> RIO s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
exe', [String]
args')
      Maybe NamedComponent
_ -> ExecPrettyException -> RIO s (String, [String])
forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO ExecPrettyException
ExecutableToRunNotFound

  getGhcCmd :: [String] -> [String] -> RIO s (String, [String])
getGhcCmd [String]
pkgs [String]
args = do
    [String]
pkgopts <- [String] -> RIO s [String]
forall {env}.
(HasCompiler env, HasProcessContext env, HasTerm env) =>
[String] -> RIO env [String]
getPkgOpts [String]
pkgs
    Path Abs File
compiler <- Getting (Path Abs File) s (Path Abs File) -> RIO s (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs File) s (Path Abs File)
 -> RIO s (Path Abs File))
-> Getting (Path Abs File) s (Path Abs File)
-> RIO s (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Getting (Path Abs File) s CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter s CompilerPaths
compilerPathsLGetting (Path Abs File) s CompilerPaths
-> ((Path Abs File -> Const (Path Abs File) (Path Abs File))
    -> CompilerPaths -> Const (Path Abs File) CompilerPaths)
-> Getting (Path Abs File) s (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Path Abs File)
-> SimpleGetter CompilerPaths (Path Abs File)
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Path Abs File
cpCompiler
    (String, [String]) -> RIO s (String, [String])
forall a. a -> RIO s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
compiler, [String]
pkgopts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

  getRunGhcCmd :: [String] -> [String] -> RIO s (String, [String])
getRunGhcCmd [String]
pkgs [String]
args = do
    [String]
pkgopts <- [String] -> RIO s [String]
forall {env}.
(HasCompiler env, HasProcessContext env, HasTerm env) =>
[String] -> RIO env [String]
getPkgOpts [String]
pkgs
    Path Abs File
interpret <- Getting (Path Abs File) s (Path Abs File) -> RIO s (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs File) s (Path Abs File)
 -> RIO s (Path Abs File))
-> Getting (Path Abs File) s (Path Abs File)
-> RIO s (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Getting (Path Abs File) s CompilerPaths
forall env. HasCompiler env => SimpleGetter env CompilerPaths
SimpleGetter s CompilerPaths
compilerPathsLGetting (Path Abs File) s CompilerPaths
-> ((Path Abs File -> Const (Path Abs File) (Path Abs File))
    -> CompilerPaths -> Const (Path Abs File) CompilerPaths)
-> Getting (Path Abs File) s (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CompilerPaths -> Path Abs File)
-> SimpleGetter CompilerPaths (Path Abs File)
forall s a. (s -> a) -> SimpleGetter s a
to CompilerPaths -> Path Abs File
cpInterpreter
    (String, [String]) -> RIO s (String, [String])
forall a. a -> RIO s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
interpret, [String]
pkgopts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

  runWithPath :: Maybe FilePath -> RIO EnvConfig () -> RIO EnvConfig ()
  runWithPath :: Maybe String -> RIO EnvConfig () -> RIO EnvConfig ()
runWithPath Maybe String
path RIO EnvConfig ()
callback = case Maybe String
path of
    Maybe String
Nothing -> RIO EnvConfig ()
callback
    Just String
p | Bool -> Bool
not (String -> Bool
isValid String
p) -> ExecException -> RIO EnvConfig ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ExecException -> RIO EnvConfig ())
-> ExecException -> RIO EnvConfig ()
forall a b. (a -> b) -> a -> b
$ String -> ExecException
InvalidPathForExec String
p
    Just String
p -> (UnliftIO (RIO EnvConfig) -> IO ()) -> RIO EnvConfig ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO (RIO EnvConfig) -> IO ()) -> RIO EnvConfig ())
-> (UnliftIO (RIO EnvConfig) -> IO ()) -> RIO EnvConfig ()
forall a b. (a -> b) -> a -> b
$ \UnliftIO (RIO EnvConfig)
ul -> String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
p (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UnliftIO (RIO EnvConfig) -> forall a. RIO EnvConfig a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO (RIO EnvConfig)
ul RIO EnvConfig ()
callback