{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.SetupCmd
( setupCmd
) where
import qualified Data.Either.Extra as EE
import Stack.Prelude
import Stack.Runners
( ShouldReexec (..), withBuildConfig, withConfig )
import Stack.Setup ( SetupOpts (..), ensureCompilerAndMsys )
import Stack.Types.BuildConfig
( HasBuildConfig, configFileL, wantedCompilerVersionL )
import Stack.Types.CompilerPaths ( CompilerPaths (..) )
import Stack.Types.Config ( Config (..), HasConfig (..) )
import Stack.Types.GHCVariant ( HasGHCVariant )
import Stack.Types.Runner ( Runner )
import Stack.Types.SetupOpts ( SetupCmdOpts (..) )
import Stack.Types.Version ( VersionCheck (..) )
setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd SetupCmdOpts
sco = 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
$ do
Bool
installGHC <- Getting Bool Config Bool -> RIO Config Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool Config Bool -> RIO Config Bool)
-> Getting Bool Config Bool -> RIO Config Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> Config -> Const Bool Config
forall env. HasConfig env => Lens' env Config
Lens' Config Config
configL ((Config -> Const Bool Config) -> Config -> Const Bool Config)
-> Getting Bool Config Bool -> Getting Bool Config Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to (.installGHC)
Bool
installMsys <- Getting Bool Config Bool -> RIO Config Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Bool Config Bool -> RIO Config Bool)
-> Getting Bool Config Bool -> RIO Config Bool
forall a b. (a -> b) -> a -> b
$ (Config -> Const Bool Config) -> Config -> Const Bool Config
forall env. HasConfig env => Lens' env Config
Lens' Config Config
configL ((Config -> Const Bool Config) -> Config -> Const Bool Config)
-> Getting Bool Config Bool -> Getting Bool Config Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Bool) -> SimpleGetter Config Bool
forall s a. (s -> a) -> SimpleGetter s a
to (.installMsys)
case (Bool
installGHC, Bool
installMsys) of
(Bool
True, Bool
True) -> RIO BuildConfig () -> RIO Config ()
forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig (RIO BuildConfig () -> RIO Config ())
-> RIO BuildConfig () -> RIO Config ()
forall a b. (a -> b) -> a -> b
$ do
(WantedCompiler
wantedCompiler, VersionCheck
compilerCheck, Maybe (Path Abs File)
mConfigFile) <-
case SetupCmdOpts
sco.compilerVersion of
Just WantedCompiler
v -> (WantedCompiler, VersionCheck, Maybe (Path Abs File))
-> RIO
BuildConfig (WantedCompiler, VersionCheck, Maybe (Path Abs File))
forall a. a -> RIO BuildConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler
v, VersionCheck
MatchMinor, Maybe (Path Abs File)
forall a. Maybe a
Nothing)
Maybe WantedCompiler
Nothing -> do
WantedCompiler
wantedCompilerVersion <- Getting WantedCompiler BuildConfig WantedCompiler
-> RIO BuildConfig WantedCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WantedCompiler BuildConfig WantedCompiler
forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL
VersionCheck
compilerCheck <- Getting VersionCheck BuildConfig VersionCheck
-> RIO BuildConfig VersionCheck
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const VersionCheck Config)
-> BuildConfig -> Const VersionCheck BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> Const VersionCheck Config)
-> BuildConfig -> Const VersionCheck BuildConfig)
-> ((VersionCheck -> Const VersionCheck VersionCheck)
-> Config -> Const VersionCheck Config)
-> Getting VersionCheck BuildConfig VersionCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> VersionCheck) -> SimpleGetter Config VersionCheck
forall s a. (s -> a) -> SimpleGetter s a
to (.compilerCheck))
Either (Path Abs File) (Path Abs File)
configFile <- Getting
(Either (Path Abs File) (Path Abs File))
BuildConfig
(Either (Path Abs File) (Path Abs File))
-> RIO BuildConfig (Either (Path Abs File) (Path Abs File))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(Either (Path Abs File) (Path Abs File))
BuildConfig
(Either (Path Abs File) (Path Abs File))
forall env.
HasBuildConfig env =>
Lens' env (Either (Path Abs File) (Path Abs File))
Lens' BuildConfig (Either (Path Abs File) (Path Abs File))
configFileL
let eitherConfigFile :: Path Abs File
eitherConfigFile = Either (Path Abs File) (Path Abs File) -> Path Abs File
forall a. Either a a -> a
EE.fromEither Either (Path Abs File) (Path Abs File)
configFile
(WantedCompiler, VersionCheck, Maybe (Path Abs File))
-> RIO
BuildConfig (WantedCompiler, VersionCheck, Maybe (Path Abs File))
forall a. a -> RIO BuildConfig a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( WantedCompiler
wantedCompilerVersion
, VersionCheck
compilerCheck
, Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
eitherConfigFile
)
SetupCmdOpts
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> RIO BuildConfig ()
forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupCmdOpts
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> RIO env ()
setup SetupCmdOpts
sco WantedCompiler
wantedCompiler VersionCheck
compilerCheck Maybe (Path Abs File)
mConfigFile
(Bool
False, Bool
True) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
[ StyleDoc
styledNoInstallGHC
, StyleDoc
singleFlag
]
(Bool
True, Bool
False) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
[ StyleDoc
styledNoInstallMsys
, StyleDoc
singleFlag
]
(Bool
False, Bool
False) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
[ StyleDoc
styledNoInstallGHC
, StyleDoc
"and"
, StyleDoc
styledNoInstallMsys
, String -> StyleDoc
flow String
"flags are"
]
where
styledNoInstallGHC :: StyleDoc
styledNoInstallGHC = Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-ghc"
styledNoInstallMsys :: StyleDoc
styledNoInstallMsys = Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-msys"
singleFlag :: StyleDoc
singleFlag = String -> StyleDoc
flow String
"flag is"
warn :: [StyleDoc] -> m ()
warn [StyleDoc]
docs = [StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL ([StyleDoc] -> m ()) -> [StyleDoc] -> m ()
forall a b. (a -> b) -> a -> b
$
[StyleDoc
"The"]
[StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [StyleDoc]
docs
[StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [ String -> StyleDoc
flow String
"inconsistent with"
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack setup") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, String -> StyleDoc
flow String
"No action taken."
]
setup ::
(HasBuildConfig env, HasGHCVariant env)
=> SetupCmdOpts
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> RIO env ()
setup :: forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupCmdOpts
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> RIO env ()
setup SetupCmdOpts
sco WantedCompiler
wantedCompiler VersionCheck
compilerCheck Maybe (Path Abs File)
configFile = do
Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL
Bool
sandboxedGhc <- (.sandboxed) (CompilerPaths -> Bool)
-> ((CompilerPaths, ExtraDirs) -> CompilerPaths)
-> (CompilerPaths, ExtraDirs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CompilerPaths, ExtraDirs) -> CompilerPaths
forall a b. (a, b) -> a
fst ((CompilerPaths, ExtraDirs) -> Bool)
-> RIO env (CompilerPaths, ExtraDirs) -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SetupOpts -> RIO env (CompilerPaths, ExtraDirs)
forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupOpts -> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys SetupOpts
{ installGhcIfMissing :: Bool
installGhcIfMissing = Bool
True
, installMsysIfMissing :: Bool
installMsysIfMissing = Bool
True
, useSystem :: Bool
useSystem = Config
config.systemGHC Bool -> Bool -> Bool
&& Bool -> Bool
not SetupCmdOpts
sco.forceReinstall
, WantedCompiler
wantedCompiler :: WantedCompiler
wantedCompiler :: WantedCompiler
wantedCompiler
, VersionCheck
compilerCheck :: VersionCheck
compilerCheck :: VersionCheck
compilerCheck
, Maybe (Path Abs File)
configFile :: Maybe (Path Abs File)
configFile :: Maybe (Path Abs File)
configFile
, forceReinstall :: Bool
forceReinstall = SetupCmdOpts
sco.forceReinstall
, sanityCheck :: Bool
sanityCheck = Bool
True
, skipGhcCheck :: Bool
skipGhcCheck = Bool
False
, skipMsys :: Bool
skipMsys = Config
config.skipMsys
, resolveMissingGHC :: Maybe StyleDoc
resolveMissingGHC = Maybe StyleDoc
forall a. Maybe a
Nothing
, ghcBindistURL :: Maybe String
ghcBindistURL = SetupCmdOpts
sco.ghcBindistUrl
}
let compiler :: StyleDoc
compiler = case WantedCompiler
wantedCompiler of
WCGhc Version
_ -> StyleDoc
"GHC"
WCGhcGit{} -> StyleDoc
"GHC (built from source)"
WCGhcjs {} -> StyleDoc
"GHCJS"
compilerHelpMsg :: StyleDoc
compilerHelpMsg = [StyleDoc] -> StyleDoc
fillSep
[ String -> StyleDoc
flow String
"To use this"
, StyleDoc
compiler
, String -> StyleDoc
flow String
"and packages outside of a project, consider using:"
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack ghc") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack ghci") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack runghc") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, StyleDoc
"or"
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack exec") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
if Bool
sandboxedGhc
then [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
[ String -> StyleDoc
flow String
"Stack will use a sandboxed"
, StyleDoc
compiler
, String -> StyleDoc
flow String
"it installed."
, StyleDoc
compilerHelpMsg
]
else [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
[ String -> StyleDoc
flow String
"Stack will use the"
, StyleDoc
compiler
, String -> StyleDoc
flow String
"on your PATH. For more information on paths, see"
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack path")
, StyleDoc
"and"
, Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack exec env") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
, StyleDoc
compilerHelpMsg
]