{-# 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
    (Maybe WantedCompiler
 -> Bool -> Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts)
-> Parser (Maybe WantedCompiler)
-> Parser
     (Bool -> Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser WantedCompiler -> Parser (Maybe WantedCompiler)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (ReadM WantedCompiler
-> Mod ArgumentFields WantedCompiler -> Parser WantedCompiler
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument ReadM WantedCompiler
readVersion
            ([Char] -> Mod ArgumentFields WantedCompiler
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"GHC_VERSION" Mod ArgumentFields WantedCompiler
-> Mod ArgumentFields WantedCompiler
-> Mod ArgumentFields WantedCompiler
forall a. Semigroup a => a -> a -> a
<>
             [Char] -> Mod ArgumentFields WantedCompiler
forall (f :: * -> *) a. [Char] -> Mod f a
OA.help ([Char]
"Version of GHC to install, e.g. 7.10.2. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                      [Char]
"The default is to install the version implied by the resolver.")))
    Parser (Bool -> Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts)
-> Parser Bool
-> Parser (Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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)"
            Mod FlagFields Bool
forall m. Monoid m => m
OA.idm
    Parser (Maybe [Char] -> [[Char]] -> Bool -> SetupCmdOpts)
-> Parser (Maybe [Char])
-> Parser ([[Char]] -> Bool -> SetupCmdOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
            ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
OA.long [Char]
"ghc-bindist"
           Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"URL"
           Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
OA.help [Char]
"Alternate GHC binary distribution (requires custom --ghc-variant)"))
    Parser ([[Char]] -> Bool -> SetupCmdOpts)
-> Parser [[Char]] -> Parser (Bool -> SetupCmdOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser [[Char]]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
OA.many (Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
            ([Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
OA.long [Char]
"ghcjs-boot-options"
           Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
OA.metavar [Char]
"GHCJS_BOOT"
           Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
OA.help [Char]
"Additional ghcjs-boot options"))
    Parser (Bool -> SetupCmdOpts) -> Parser Bool -> Parser SetupCmdOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
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"
            Mod FlagFields Bool
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-" Text -> Text -> Text
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
_ -> [Char] -> ReadM WantedCompiler
forall a. [Char] -> ReadM a
OA.readerError ([Char] -> ReadM WantedCompiler) -> [Char] -> ReadM WantedCompiler
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid version: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
                    Right WantedCompiler
x -> WantedCompiler -> ReadM WantedCompiler
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WantedCompiler
x
            Right WantedCompiler
x -> WantedCompiler -> ReadM WantedCompiler
forall a. a -> ReadM a
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
scoCompilerVersion :: SetupCmdOpts -> Maybe WantedCompiler
scoForceReinstall :: SetupCmdOpts -> Bool
scoGHCBindistURL :: SetupCmdOpts -> Maybe [Char]
scoGHCJSBootOpts :: SetupCmdOpts -> [[Char]]
scoGHCJSBootClean :: SetupCmdOpts -> Bool
scoCompilerVersion :: Maybe WantedCompiler
scoForceReinstall :: Bool
scoGHCBindistURL :: Maybe [Char]
scoGHCJSBootOpts :: [[Char]]
scoGHCJSBootClean :: Bool
..} 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
Text
Map Text Text
Map PackageName [Text]
Map ApplyGhcOptions [Text]
Map CabalConfigKey [Text]
Path Abs File
Path Abs Dir
Path Rel Dir
PantryConfig
VersionRange
Platform
BuildOpts
NixOpts
VersionCheck
DockerOpts
CompilerRepository
PvpBounds
SetupInfo
PlatformVariant
ProjectConfig (Project, Path Abs File)
DumpLogs
ApplyGhcOptions
UserStorage
Runner
EnvSettings -> IO ProcessContext
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 :: [[Char]]
configExtraLibDirs :: [[Char]]
configCustomPreprocessorExts :: [Text]
configConcurrentTests :: Bool
configTemplateParams :: Map Text Text
configScmInit :: Maybe SCM
configGhcOptionsByName :: Map PackageName [Text]
configGhcOptionsByCat :: Map ApplyGhcOptions [Text]
configCabalConfigOpts :: Map CabalConfigKey [Text]
configSetupInfoLocations :: [[Char]]
configSetupInfoInline :: SetupInfo
configPvpBounds :: PvpBounds
configModifyCodePage :: Bool
configRebuildGhcOptions :: Bool
configApplyGhcOptions :: ApplyGhcOptions
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
configNoRunCompile :: Bool
configStackDeveloperMode :: Bool
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
configInstallGHC :: Config -> Bool
configSkipGHCCheck :: Config -> Bool
configSkipMsys :: Config -> Bool
configCompilerCheck :: Config -> VersionCheck
configCompilerRepository :: Config -> CompilerRepository
configLocalBin :: Config -> Path Abs Dir
configRequireStackVersion :: Config -> VersionRange
configJobs :: Config -> Int
configOverrideGccPath :: Config -> Maybe (Path Abs File)
configExtraIncludeDirs :: Config -> [[Char]]
configExtraLibDirs :: Config -> [[Char]]
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 -> [[Char]]
configSetupInfoInline :: Config -> SetupInfo
configPvpBounds :: Config -> PvpBounds
configModifyCodePage :: Config -> Bool
configRebuildGhcOptions :: Config -> Bool
configApplyGhcOptions :: Config -> ApplyGhcOptions
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
configNoRunCompile :: Config -> Bool
configStackDeveloperMode :: Config -> Bool
..} <- 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 [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 Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Stack will use a sandboxed " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" it installed."
        else Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Stack will use the " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" on your PATH."
    Utf8Builder -> RIO env ()
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'."
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Utf8Builder
"To use this " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
compiler Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" and packages outside of a project, consider using:"
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"'stack ghc', 'stack ghci', 'stack runghc', or 'stack exec'."