{-# 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 "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 ("Version of GHC to install, e.g. 7.10.2. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      "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
            "reinstall"
            "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 "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 "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 "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 "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 "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 "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
            "ghcjs-boot-clean"
            "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 ("ghc-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
s) of
            Left _ ->
                case Text -> Either PantryException WantedCompiler
parseWantedCompiler (String -> Text
T.pack String
s) of
                    Left _ -> String -> ReadM WantedCompiler
forall a. String -> ReadM a
OA.readerError (String -> ReadM WantedCompiler) -> String -> ReadM WantedCompiler
forall a b. (a -> b) -> a -> b
$ "Invalid version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
                    Right x :: WantedCompiler
x -> WantedCompiler -> ReadM WantedCompiler
forall (m :: * -> *) a. Monad m => a -> m a
return WantedCompiler
x
            Right x :: 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{..} wantedCompiler :: WantedCompiler
wantedCompiler compilerCheck :: VersionCheck
compilerCheck mstack :: Maybe (Path Abs File)
mstack = do
    Config{..} <- 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 $WSetupOpts :: 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 _ -> "GHC"
            WCGhcGit{} -> "GHC (built from source)"
            WCGhcjs {} -> "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
$ "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
<> " 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
$ "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
<> " on your PATH"
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "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
$ "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
<> " 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 "stack ghc, stack ghci, stack runghc, or stack exec"