{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE OverloadedRecordDot   #-}
{-# LANGUAGE OverloadedStrings     #-}

{-|
Module      : Stack.SetupCmd
Description : Function related to Stack's @setup@ command.
License     : BSD-3-Clause

Function related to Stack's @setup@ command.
-}

module Stack.SetupCmd
  ( setupCmd
  ) where

import qualified Data.Either.Extra as EE
import           Stack.Prelude
import           Stack.Runners
                   ( ShouldReexec (..), withBuildConfig, withConfig )
import           Stack.Setup ( SetupOpts (..), ensureCompilerAndMsys )
import           Stack.Types.BuildConfig
                   ( HasBuildConfig, configFileL, 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.SetupOpts ( SetupCmdOpts (..) )
import           Stack.Types.Version ( VersionCheck (..) )

-- | Function underlying the @stack setup@ command.

setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd :: SetupCmdOpts -> RIO Runner ()
setupCmd SetupCmdOpts
sco = 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
  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 (.installGHC)
  installMsys <- view $ configL . to (.installMsys)
  case (installGHC, installMsys) of
    (Bool
True, Bool
True) -> 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, compilerCheck, mConfigFile) <-
        case SetupCmdOpts
sco.compilerVersion 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 -> do
           wantedCompilerVersion <- 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
           compilerCheck <- view (configL . to (.compilerCheck))
           configFile <- view configFileL
           -- We are indifferent as to whether the configuration file is a

           -- user-specific global or a project-level one.

           let eitherConfigFile = Either (Path Abs File) (Path Abs File) -> Path Abs File
forall a. Either a a -> a
EE.fromEither Either (Path Abs File) (Path Abs File)
configFile
           pure
             ( wantedCompilerVersion
             , compilerCheck
             , Just eitherConfigFile
             )
      setup sco wantedCompiler compilerCheck mConfigFile
    (Bool
False, Bool
True) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
      [ StyleDoc
styledNoInstallGHC
      , StyleDoc
singleFlag
      ]
    (Bool
True, Bool
False) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
      [ StyleDoc
styledNoInstallMsys
      , StyleDoc
singleFlag
      ]
    (Bool
False, Bool
False) -> [StyleDoc] -> RIO Config ()
forall {env} {m :: * -> *}.
(HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
warn
      [ StyleDoc
styledNoInstallGHC
      , StyleDoc
"and"
      , StyleDoc
styledNoInstallMsys
      , String -> StyleDoc
flow String
"flags are"
      ]
 where
  styledNoInstallGHC :: StyleDoc
styledNoInstallGHC = Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-ghc"
  styledNoInstallMsys :: StyleDoc
styledNoInstallMsys = Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-msys"
  singleFlag :: StyleDoc
singleFlag = String -> StyleDoc
flow String
"flag is"
  warn :: [StyleDoc] -> m ()
warn [StyleDoc]
docs = [StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL ([StyleDoc] -> m ()) -> [StyleDoc] -> m ()
forall a b. (a -> b) -> a -> b
$
       [StyleDoc
"The"]
    [StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [StyleDoc]
docs
    [StyleDoc] -> [StyleDoc] -> [StyleDoc]
forall a. Semigroup a => a -> a -> a
<> [ String -> StyleDoc
flow String
"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)
     -- ^ If we got the desired GHC version from that configuration file, which

     -- may be either a user-specific global or a project-level one.

  -> RIO env ()
setup :: 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)
configFile = 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
Lens' env Config
configL
  sandboxedGhc <- (.sandboxed) . fst <$> ensureCompilerAndMsys SetupOpts
    { installGhcIfMissing = True
    , installMsysIfMissing = True
    , useSystem = config.systemGHC && not sco.forceReinstall
    , wantedCompiler
    , compilerCheck
    , configFile
    , forceReinstall = sco.forceReinstall
    , sanityCheck = True
    , skipGhcCheck = False
    , skipMsys = config.skipMsys
    , resolveMissingGHC = Nothing
    , ghcBindistURL = sco.ghcBindistUrl
    }
  let compiler = case WantedCompiler
wantedCompiler of
        WCGhc Version
_ -> StyleDoc
"GHC"
        WCGhcGit{} -> StyleDoc
"GHC (built from source)"
        WCGhcjs {} -> StyleDoc
"GHCJS"
      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 sandboxedGhc
    then prettyInfoL
      [ flow "Stack will use a sandboxed"
      , compiler
      , flow "it installed."
      , compilerHelpMsg
      ]
    else prettyInfoL
      [ flow "Stack will use the"
      , compiler
      , flow "on your PATH. For more information on paths, see"
      , style Shell (flow "stack path")
      , "and"
      , style Shell (flow "stack exec env") <> "."
      , compilerHelpMsg
      ]