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

-- | Types and functions related to Stack's @setup@ command.

module Stack.SetupCmd
  ( SetupCmdOpts (..)
  , setupCmd
  , setup
  ) where

import           Stack.Prelude
import           Stack.Runners
                   ( ShouldReexec (..), withBuildConfig, withConfig )
import           Stack.Setup ( SetupOpts (..), ensureCompilerAndMsys )
import           Stack.Types.BuildConfig
                   ( HasBuildConfig, stackYamlL, 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.Version ( VersionCheck (..) )

-- | Type representing command line options for the @stack setup@ command.

data SetupCmdOpts = SetupCmdOpts
  { SetupCmdOpts -> Maybe WantedCompiler
scoCompilerVersion :: !(Maybe WantedCompiler)
  , SetupCmdOpts -> Bool
scoForceReinstall  :: !Bool
  , SetupCmdOpts -> Maybe String
scoGHCBindistURL   :: !(Maybe String)
  , SetupCmdOpts -> [String]
scoGHCJSBootOpts   :: ![String]
  , SetupCmdOpts -> Bool
scoGHCJSBootClean  :: !Bool
  }

-- | Function underlying the @stack setup@ command.

setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd sco :: SetupCmdOpts
sco@SetupCmdOpts{Bool
[String]
Maybe String
Maybe WantedCompiler
scoGHCJSBootClean :: Bool
scoGHCJSBootOpts :: [String]
scoGHCBindistURL :: Maybe String
scoForceReinstall :: Bool
scoCompilerVersion :: Maybe WantedCompiler
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoGHCJSBootOpts :: SetupCmdOpts -> [String]
scoGHCBindistURL :: SetupCmdOpts -> Maybe String
scoForceReinstall :: SetupCmdOpts -> Bool
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
..} = forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec forall a b. (a -> b) -> a -> b
$ do
  Bool
installGHC <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> Bool
configInstallGHC
  if Bool
installGHC
    then
       forall a. RIO BuildConfig a -> RIO Config a
withBuildConfig forall a b. (a -> b) -> a -> b
$ do
       (WantedCompiler
wantedCompiler, VersionCheck
compilerCheck, Maybe (Path Abs File)
mstack) <-
         case Maybe WantedCompiler
scoCompilerVersion of
           Just WantedCompiler
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (WantedCompiler
v, VersionCheck
MatchMinor, forall a. Maybe a
Nothing)
           Maybe WantedCompiler
Nothing -> (,,)
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Config -> VersionCheck
configCompilerCheck)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL)
       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)
mstack
    else
      forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ StyleDoc
"The"
        , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-ghc"
        , String -> StyleDoc
flow String
"flag is inconsistent with"
        , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack setup") 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{Bool
[String]
Maybe String
Maybe WantedCompiler
scoGHCJSBootClean :: Bool
scoGHCJSBootOpts :: [String]
scoGHCBindistURL :: Maybe String
scoForceReinstall :: Bool
scoCompilerVersion :: Maybe WantedCompiler
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoGHCJSBootOpts :: SetupCmdOpts -> [String]
scoGHCBindistURL :: SetupCmdOpts -> Maybe String
scoForceReinstall :: SetupCmdOpts -> Bool
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
..} WantedCompiler
wantedCompiler VersionCheck
compilerCheck Maybe (Path Abs File)
mstack = do
  Config{Bool
Int
[String]
[Text]
Maybe [PackageName]
Maybe (Path Abs File)
Maybe CompilerBuild
Maybe GHCVariant
Maybe AbstractResolver
Maybe SCM
Maybe TemplateName
VersionRange
Platform
Map PackageName [Text]
Map Text Text
Map ApplyGhcOptions [Text]
Map CabalConfigKey [Text]
Text
PantryConfig
Path Abs File
Path Abs Dir
Path Rel Dir
ApplyGhcOptions
ApplyProgOptions
BuildOpts
DumpLogs
NixOpts
PlatformVariant
ProjectConfig (Project, Path Abs File)
PvpBounds
UserStorage
VersionCheck
CompilerRepository
SetupInfo
DockerOpts
Runner
EnvSettings -> IO ProcessContext
configStackDeveloperMode :: Config -> Bool
configNoRunCompile :: Config -> Bool
configRecommendUpgrade :: Config -> Bool
configHideSourcePaths :: Config -> Bool
configUserStorage :: Config -> UserStorage
configResolver :: Config -> Maybe AbstractResolver
configStackRoot :: Config -> Path Abs Dir
configPantryConfig :: Config -> PantryConfig
configRunner :: Config -> Runner
configHackageBaseUrl :: Config -> Text
configSaveHackageCreds :: Config -> Bool
configAllowLocals :: Config -> Bool
configProject :: Config -> ProjectConfig (Project, Path Abs File)
configDumpLogs :: Config -> DumpLogs
configAllowDifferentUser :: Config -> Bool
configDefaultTemplate :: Config -> Maybe TemplateName
configAllowNewerDeps :: Config -> Maybe [PackageName]
configAllowNewer :: Config -> Bool
configApplyProgOptions :: Config -> ApplyProgOptions
configApplyGhcOptions :: Config -> ApplyGhcOptions
configRebuildGhcOptions :: Config -> Bool
configModifyCodePage :: Config -> Bool
configPvpBounds :: Config -> PvpBounds
configSetupInfoInline :: Config -> SetupInfo
configSetupInfoLocations :: Config -> [String]
configCabalConfigOpts :: Config -> Map CabalConfigKey [Text]
configGhcOptionsByCat :: Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByName :: Config -> Map PackageName [Text]
configScmInit :: Config -> Maybe SCM
configTemplateParams :: Config -> Map Text Text
configConcurrentTests :: Config -> Bool
configCustomPreprocessorExts :: Config -> [Text]
configExtraLibDirs :: Config -> [String]
configExtraIncludeDirs :: Config -> [String]
configOverrideGccPath :: Config -> Maybe (Path Abs File)
configJobs :: Config -> Int
configRequireStackVersion :: Config -> VersionRange
configLocalBin :: Config -> Path Abs Dir
configCompilerRepository :: Config -> CompilerRepository
configSkipMsys :: Config -> Bool
configSkipGHCCheck :: Config -> Bool
configSystemGHC :: Config -> Bool
configLatestSnapshot :: Config -> Text
configGHCBuild :: Config -> Maybe CompilerBuild
configGHCVariant :: Config -> Maybe GHCVariant
configPlatformVariant :: Config -> PlatformVariant
configPlatform :: Config -> Platform
configPrefixTimestamps :: Config -> Bool
configHideTHLoading :: Config -> Bool
configLocalPrograms :: Config -> Path Abs Dir
configLocalProgramsBase :: Config -> Path Abs Dir
configProcessContextSettings :: Config -> EnvSettings -> IO ProcessContext
configNix :: Config -> NixOpts
configDocker :: Config -> DockerOpts
configBuild :: Config -> BuildOpts
configUserConfigPath :: Config -> Path Abs File
configWorkDir :: Config -> Path Rel Dir
configStackDeveloperMode :: Bool
configNoRunCompile :: Bool
configRecommendUpgrade :: Bool
configHideSourcePaths :: Bool
configUserStorage :: UserStorage
configResolver :: Maybe AbstractResolver
configStackRoot :: Path Abs Dir
configPantryConfig :: PantryConfig
configRunner :: Runner
configHackageBaseUrl :: Text
configSaveHackageCreds :: Bool
configAllowLocals :: Bool
configProject :: ProjectConfig (Project, Path Abs File)
configDumpLogs :: DumpLogs
configAllowDifferentUser :: Bool
configDefaultTemplate :: Maybe TemplateName
configAllowNewerDeps :: Maybe [PackageName]
configAllowNewer :: Bool
configApplyProgOptions :: ApplyProgOptions
configApplyGhcOptions :: ApplyGhcOptions
configRebuildGhcOptions :: Bool
configModifyCodePage :: Bool
configPvpBounds :: PvpBounds
configSetupInfoInline :: SetupInfo
configSetupInfoLocations :: [String]
configCabalConfigOpts :: Map CabalConfigKey [Text]
configGhcOptionsByCat :: Map ApplyGhcOptions [Text]
configGhcOptionsByName :: Map PackageName [Text]
configScmInit :: Maybe SCM
configTemplateParams :: Map Text Text
configConcurrentTests :: Bool
configCustomPreprocessorExts :: [Text]
configExtraLibDirs :: [String]
configExtraIncludeDirs :: [String]
configOverrideGccPath :: Maybe (Path Abs File)
configJobs :: Int
configRequireStackVersion :: VersionRange
configLocalBin :: Path Abs Dir
configCompilerRepository :: CompilerRepository
configCompilerCheck :: VersionCheck
configSkipMsys :: Bool
configSkipGHCCheck :: Bool
configInstallGHC :: Bool
configSystemGHC :: Bool
configLatestSnapshot :: Text
configGHCBuild :: Maybe CompilerBuild
configGHCVariant :: Maybe GHCVariant
configPlatformVariant :: PlatformVariant
configPlatform :: Platform
configPrefixTimestamps :: Bool
configHideTHLoading :: Bool
configLocalPrograms :: Path Abs Dir
configLocalProgramsBase :: Path Abs Dir
configProcessContextSettings :: EnvSettings -> IO ProcessContext
configNix :: NixOpts
configDocker :: DockerOpts
configBuild :: BuildOpts
configUserConfigPath :: Path Abs File
configWorkDir :: Path Rel Dir
configCompilerCheck :: Config -> VersionCheck
configInstallGHC :: Config -> Bool
..} <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
  Bool
sandboxedGhc <- CompilerPaths -> Bool
cpSandboxed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasBuildConfig env, HasGHCVariant env) =>
SetupOpts -> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys SetupOpts
    { soptsInstallIfMissing :: Bool
soptsInstallIfMissing = Bool
True
    , soptsUseSystem :: Bool
soptsUseSystem = Bool
configSystemGHC Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
scoForceReinstall
    , soptsWantedCompiler :: WantedCompiler
soptsWantedCompiler = WantedCompiler
wantedCompiler
    , soptsCompilerCheck :: VersionCheck
soptsCompilerCheck = VersionCheck
compilerCheck
    , soptsStackYaml :: Maybe (Path Abs File)
soptsStackYaml = Maybe (Path Abs File)
mstack
    , soptsForceReinstall :: Bool
soptsForceReinstall = Bool
scoForceReinstall
    , soptsSanityCheck :: Bool
soptsSanityCheck = Bool
True
    , soptsSkipGhcCheck :: Bool
soptsSkipGhcCheck = Bool
False
    , soptsSkipMsys :: Bool
soptsSkipMsys = Bool
configSkipMsys
    , soptsResolveMissingGHC :: Maybe Text
soptsResolveMissingGHC = forall a. Maybe a
Nothing
    , soptsGHCBindistURL :: Maybe String
soptsGHCBindistURL = Maybe String
scoGHCBindistURL
    }
  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") forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
        , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack ghci") forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
        , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack runghc") forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
        , StyleDoc
"or"
        , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack exec") forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
        ]
  if Bool
sandboxedGhc
    then 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 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") forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
      , StyleDoc
compilerHelpMsg
      ]