{-# 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           Control.Monad.Reader
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 String
scoGHCBindistURL   :: !(Maybe String)
    , SetupCmdOpts -> [String]
scoGHCJSBootOpts   :: ![String]
    , SetupCmdOpts -> Bool
scoGHCJSBootClean  :: !Bool
    }

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

setup
    :: (HasBuildConfig env, HasGHCVariant env)
    => SetupCmdOpts
    -> WantedCompiler
    -> VersionCheck
    -> Maybe (Path Abs File)
    -> RIO env ()
setup :: 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]
Maybe (Path Abs File)
Maybe CompilerBuild
Maybe AbstractResolver
Maybe TemplateName
Maybe GHCVariant
Maybe SCM
Platform
VersionRange
Map (Maybe PackageName) Bool
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
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
configAllowNewer :: Config -> Bool
configApplyGhcOptions :: Config -> ApplyGhcOptions
configRebuildGhcOptions :: Config -> Bool
configExplicitSetupDeps :: Config -> Map (Maybe PackageName) 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
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
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
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
configAllowNewer :: Bool
configApplyGhcOptions :: ApplyGhcOptions
configRebuildGhcOptions :: Bool
configExplicitSetupDeps :: Map (Maybe PackageName) 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
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
..} <- 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
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 :: Bool
-> Bool
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> Maybe String
-> SetupOpts
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 :: 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"