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

-- | Install GHC/GHCJS and Cabal.

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

import           Control.Applicative
import qualified Data.Text as T
import qualified Options.Applicative as OA
import qualified Options.Applicative.Builder.Extra as OA
import qualified Options.Applicative.Types as OA
import           Path
import           Stack.Prelude
import           Stack.Setup
import           Stack.Types.Config
import           Stack.Types.Version

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

setupParser :: OA.Parser SetupCmdOpts
setupParser :: Parser SetupCmdOpts
setupParser = Maybe WantedCompiler
-> Bool -> Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts
SetupCmdOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument ReadM WantedCompiler
readVersion
            (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"GHC_VERSION" forall a. Semigroup a => a -> a -> a
<>
             forall (f :: * -> *) a. [Char] -> Mod f a
OA.help ([Char]
"Version of GHC to install, e.g. 7.10.2. " forall a. [a] -> [a] -> [a]
++
                      [Char]
"The default is to install the version implied by the resolver.")))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> [Char] -> [Char] -> Mod FlagFields Bool -> Parser Bool
OA.boolFlags Bool
False
            [Char]
"reinstall"
            [Char]
"reinstalling GHC, even if available (incompatible with --system-ghc)"
            forall m. Monoid m => m
OA.idm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
            (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
OA.long [Char]
"ghc-bindist"
           forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"URL"
           forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
OA.help [Char]
"Alternate GHC binary distribution (requires custom --ghc-variant)"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
OA.many (forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
            (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
OA.long [Char]
"ghcjs-boot-options"
           forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"GHCJS_BOOT"
           forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
OA.help [Char]
"Additional ghcjs-boot options"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> [Char] -> [Char] -> Mod FlagFields Bool -> Parser Bool
OA.boolFlags Bool
True
            [Char]
"ghcjs-boot-clean"
            [Char]
"Control if ghcjs-boot should have --clean option present"
            forall m. Monoid m => m
OA.idm
  where
    readVersion :: ReadM WantedCompiler
readVersion = do
        [Char]
s <- ReadM [Char]
OA.readerAsk
        case Text -> Either PantryException WantedCompiler
parseWantedCompiler (Text
"ghc-" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
s) of
            Left PantryException
_ ->
                case Text -> Either PantryException WantedCompiler
parseWantedCompiler ([Char] -> Text
T.pack [Char]
s) of
                    Left PantryException
_ -> forall a. [Char] -> ReadM a
OA.readerError forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid version: " forall a. [a] -> [a] -> [a]
++ [Char]
s
                    Right WantedCompiler
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x
            Right WantedCompiler
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x

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
[[Char]]
Maybe [Char]
Maybe WantedCompiler
scoGHCJSBootClean :: Bool
scoGHCJSBootOpts :: [[Char]]
scoGHCBindistURL :: Maybe [Char]
scoForceReinstall :: Bool
scoCompilerVersion :: Maybe WantedCompiler
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoGHCJSBootOpts :: SetupCmdOpts -> [[Char]]
scoGHCBindistURL :: SetupCmdOpts -> Maybe [Char]
scoForceReinstall :: SetupCmdOpts -> Bool
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
..} WantedCompiler
wantedCompiler VersionCheck
compilerCheck Maybe (Path Abs File)
mstack = do
    Config{Bool
Int
[[Char]]
[Text]
Maybe [PackageName]
Maybe (Path Abs File)
Maybe CompilerBuild
Maybe AbstractResolver
Maybe TemplateName
Maybe GHCVariant
Maybe SCM
Platform
VersionRange
Map PackageName [Text]
Map Text Text
Map ApplyGhcOptions [Text]
Map CabalConfigKey [Text]
Text
PantryConfig
Path Abs File
Path Abs Dir
Path Rel Dir
BuildOpts
NixOpts
VersionCheck
DockerOpts
CompilerRepository
PvpBounds
SetupInfo
PlatformVariant
ProjectConfig (Project, Path Abs File)
DumpLogs
ApplyGhcOptions
UserStorage
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
configApplyGhcOptions :: Config -> ApplyGhcOptions
configRebuildGhcOptions :: Config -> Bool
configModifyCodePage :: Config -> Bool
configPvpBounds :: Config -> PvpBounds
configSetupInfoInline :: Config -> SetupInfo
configSetupInfoLocations :: Config -> [[Char]]
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 -> [[Char]]
configExtraIncludeDirs :: Config -> [[Char]]
configOverrideGccPath :: Config -> Maybe (Path Abs File)
configJobs :: Config -> Int
configRequireStackVersion :: Config -> VersionRange
configLocalBin :: Config -> Path Abs Dir
configCompilerRepository :: Config -> CompilerRepository
configCompilerCheck :: Config -> VersionCheck
configSkipMsys :: Config -> Bool
configSkipGHCCheck :: Config -> Bool
configInstallGHC :: 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
configApplyGhcOptions :: ApplyGhcOptions
configRebuildGhcOptions :: Bool
configModifyCodePage :: Bool
configPvpBounds :: PvpBounds
configSetupInfoInline :: SetupInfo
configSetupInfoLocations :: [[Char]]
configCabalConfigOpts :: Map CabalConfigKey [Text]
configGhcOptionsByCat :: Map ApplyGhcOptions [Text]
configGhcOptionsByName :: Map PackageName [Text]
configScmInit :: Maybe SCM
configTemplateParams :: Map Text Text
configConcurrentTests :: Bool
configCustomPreprocessorExts :: [Text]
configExtraLibDirs :: [[Char]]
configExtraIncludeDirs :: [[Char]]
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
..} <- 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 [Char]
soptsGHCBindistURL = Maybe [Char]
scoGHCBindistURL
        }
    let compiler :: Utf8Builder
compiler = case WantedCompiler
wantedCompiler of
            WCGhc Version
_ -> Utf8Builder
"GHC"
            WCGhcGit{} -> Utf8Builder
"GHC (built from source)"
            WCGhcjs {} -> Utf8Builder
"GHCJS"
    if Bool
sandboxedGhc
        then forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Stack will use a sandboxed " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" it installed."
        else forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Stack will use the " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on your PATH."
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"For more information on paths, see 'stack path' and 'stack exec env'."
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"To use this " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" and packages outside of a project, consider using:"
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"'stack ghc', 'stack ghci', 'stack runghc', or 'stack exec'."