{-# 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
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
scoForceReinstall :: SetupCmdOpts -> Bool
scoGHCBindistURL :: SetupCmdOpts -> Maybe String
scoGHCJSBootOpts :: SetupCmdOpts -> [String]
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoCompilerVersion :: Maybe WantedCompiler
scoForceReinstall :: Bool
scoGHCBindistURL :: Maybe String
scoGHCJSBootOpts :: [String]
scoGHCJSBootClean :: Bool
..} = 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 Config -> Bool
configInstallGHC
  if Bool
installGHC
    then
       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)
mstack) <-
         case Maybe WantedCompiler
scoCompilerVersion 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 -> (,,)
             (WantedCompiler
 -> VersionCheck
 -> Maybe (Path Abs File)
 -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig WantedCompiler
-> RIO
     BuildConfig
     (VersionCheck
      -> Maybe (Path Abs File)
      -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
             RIO
  BuildConfig
  (VersionCheck
   -> Maybe (Path Abs File)
   -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig VersionCheck
-> RIO
     BuildConfig
     (Maybe (Path Abs File)
      -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
forall a b.
RIO BuildConfig (a -> b) -> RIO BuildConfig a -> RIO BuildConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 Config -> VersionCheck
configCompilerCheck)
             RIO
  BuildConfig
  (Maybe (Path Abs File)
   -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig (Maybe (Path Abs File))
-> RIO
     BuildConfig (WantedCompiler, VersionCheck, Maybe (Path Abs File))
forall a b.
RIO BuildConfig (a -> b) -> RIO BuildConfig a -> RIO BuildConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just (Path Abs File -> Maybe (Path Abs File))
-> RIO BuildConfig (Path Abs File)
-> RIO BuildConfig (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Path Abs File) BuildConfig (Path Abs File)
-> RIO BuildConfig (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs File) BuildConfig (Path Abs File)
forall env. HasBuildConfig env => Lens' env (Path Abs File)
Lens' BuildConfig (Path Abs File)
stackYamlL)
       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)
mstack
    else
      [StyleDoc] -> RIO Config ()
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") 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{Bool
[String]
Maybe String
Maybe WantedCompiler
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
scoForceReinstall :: SetupCmdOpts -> Bool
scoGHCBindistURL :: SetupCmdOpts -> Maybe String
scoGHCJSBootOpts :: SetupCmdOpts -> [String]
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoCompilerVersion :: Maybe WantedCompiler
scoForceReinstall :: Bool
scoGHCBindistURL :: Maybe String
scoGHCJSBootOpts :: [String]
scoGHCJSBootClean :: Bool
..} WantedCompiler
wantedCompiler VersionCheck
compilerCheck Maybe (Path Abs File)
mstack = do
  Config{Bool
Int
[String]
[Text]
Maybe [PackageName]
Maybe (CasaRepoPrefix, Int)
Maybe (Path Abs File)
Maybe CompilerBuild
Maybe GHCVariant
Maybe AbstractResolver
Maybe SCM
Maybe TemplateName
Map PackageName [Text]
Map Text Text
Map ApplyGhcOptions [Text]
Map CabalConfigKey [Text]
Platform
VersionRange
Text
PantryConfig
Path Rel Dir
Path Abs Dir
Path Abs File
ApplyGhcOptions
ApplyProgOptions
BuildOpts
DumpLogs
NixOpts
PlatformVariant
ProjectConfig (Project, Path Abs File)
PvpBounds
UserStorage
VersionCheck
CompilerRepository
SetupInfo
DockerOpts
Runner
EnvSettings -> IO ProcessContext
configInstallGHC :: Config -> Bool
configCompilerCheck :: Config -> VersionCheck
configWorkDir :: Path Rel Dir
configUserConfigPath :: Path Abs File
configBuild :: BuildOpts
configDocker :: DockerOpts
configNix :: NixOpts
configProcessContextSettings :: EnvSettings -> IO ProcessContext
configLocalProgramsBase :: Path Abs Dir
configLocalPrograms :: Path Abs Dir
configHideTHLoading :: Bool
configPrefixTimestamps :: Bool
configPlatform :: Platform
configPlatformVariant :: PlatformVariant
configGHCVariant :: Maybe GHCVariant
configGHCBuild :: Maybe CompilerBuild
configLatestSnapshot :: Text
configSystemGHC :: Bool
configInstallGHC :: Bool
configSkipGHCCheck :: Bool
configSkipMsys :: Bool
configCompilerCheck :: VersionCheck
configCompilerRepository :: CompilerRepository
configLocalBin :: Path Abs Dir
configRequireStackVersion :: VersionRange
configJobs :: Int
configOverrideGccPath :: Maybe (Path Abs File)
configExtraIncludeDirs :: [String]
configExtraLibDirs :: [String]
configCustomPreprocessorExts :: [Text]
configConcurrentTests :: Bool
configTemplateParams :: Map Text Text
configScmInit :: Maybe SCM
configGhcOptionsByName :: Map PackageName [Text]
configGhcOptionsByCat :: Map ApplyGhcOptions [Text]
configCabalConfigOpts :: Map CabalConfigKey [Text]
configSetupInfoLocations :: [String]
configSetupInfoInline :: SetupInfo
configPvpBounds :: PvpBounds
configModifyCodePage :: Bool
configRebuildGhcOptions :: Bool
configApplyGhcOptions :: ApplyGhcOptions
configApplyProgOptions :: ApplyProgOptions
configAllowNewer :: Bool
configAllowNewerDeps :: Maybe [PackageName]
configDefaultTemplate :: Maybe TemplateName
configAllowDifferentUser :: Bool
configDumpLogs :: DumpLogs
configProject :: ProjectConfig (Project, Path Abs File)
configAllowLocals :: Bool
configSaveHackageCreds :: Bool
configHackageBaseUrl :: Text
configRunner :: Runner
configPantryConfig :: PantryConfig
configStackRoot :: Path Abs Dir
configResolver :: Maybe AbstractResolver
configUserStorage :: UserStorage
configHideSourcePaths :: Bool
configRecommendUpgrade :: Bool
configNotifyIfNixOnPath :: Bool
configNoRunCompile :: Bool
configStackDeveloperMode :: Bool
configCasa :: Maybe (CasaRepoPrefix, Int)
configWorkDir :: Config -> Path Rel Dir
configUserConfigPath :: Config -> Path Abs File
configBuild :: Config -> BuildOpts
configDocker :: Config -> DockerOpts
configNix :: Config -> NixOpts
configProcessContextSettings :: Config -> EnvSettings -> IO ProcessContext
configLocalProgramsBase :: Config -> Path Abs Dir
configLocalPrograms :: Config -> Path Abs Dir
configHideTHLoading :: Config -> Bool
configPrefixTimestamps :: Config -> Bool
configPlatform :: Config -> Platform
configPlatformVariant :: Config -> PlatformVariant
configGHCVariant :: Config -> Maybe GHCVariant
configGHCBuild :: Config -> Maybe CompilerBuild
configLatestSnapshot :: Config -> Text
configSystemGHC :: Config -> Bool
configSkipGHCCheck :: Config -> Bool
configSkipMsys :: Config -> Bool
configCompilerRepository :: Config -> CompilerRepository
configLocalBin :: Config -> Path Abs Dir
configRequireStackVersion :: Config -> VersionRange
configJobs :: Config -> Int
configOverrideGccPath :: Config -> Maybe (Path Abs File)
configExtraIncludeDirs :: Config -> [String]
configExtraLibDirs :: Config -> [String]
configCustomPreprocessorExts :: Config -> [Text]
configConcurrentTests :: Config -> Bool
configTemplateParams :: Config -> Map Text Text
configScmInit :: Config -> Maybe SCM
configGhcOptionsByName :: Config -> Map PackageName [Text]
configGhcOptionsByCat :: Config -> Map ApplyGhcOptions [Text]
configCabalConfigOpts :: Config -> Map CabalConfigKey [Text]
configSetupInfoLocations :: Config -> [String]
configSetupInfoInline :: Config -> SetupInfo
configPvpBounds :: Config -> PvpBounds
configModifyCodePage :: Config -> Bool
configRebuildGhcOptions :: Config -> Bool
configApplyGhcOptions :: Config -> ApplyGhcOptions
configApplyProgOptions :: Config -> ApplyProgOptions
configAllowNewer :: Config -> Bool
configAllowNewerDeps :: Config -> Maybe [PackageName]
configDefaultTemplate :: Config -> Maybe TemplateName
configAllowDifferentUser :: Config -> Bool
configDumpLogs :: Config -> DumpLogs
configProject :: Config -> ProjectConfig (Project, Path Abs File)
configAllowLocals :: Config -> Bool
configSaveHackageCreds :: Config -> Bool
configHackageBaseUrl :: Config -> Text
configRunner :: Config -> Runner
configPantryConfig :: Config -> PantryConfig
configStackRoot :: Config -> Path Abs Dir
configResolver :: Config -> Maybe AbstractResolver
configUserStorage :: Config -> UserStorage
configHideSourcePaths :: Config -> Bool
configRecommendUpgrade :: Config -> Bool
configNotifyIfNixOnPath :: Config -> Bool
configNoRunCompile :: Config -> Bool
configStackDeveloperMode :: Config -> Bool
configCasa :: Config -> Maybe (CasaRepoPrefix, Int)
..} <- 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 <- CompilerPaths -> Bool
cpSandboxed (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
    { 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 = Maybe Text
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") 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
      ]