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

-- | Types and functions related to Stack's @setup@ command.

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

import           Stack.Prelude
import           Stack.Runners
                   ( ShouldReexec (..), withBuildConfig, withConfig )
import           Stack.Setup ( SetupOpts (..), ensureCompilerAndMsys )
import           Stack.Types.BuildConfig
                   ( HasBuildConfig, stackYamlL, 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.Version ( VersionCheck (..) )

-- | Type representing command line options for the @stack setup@ command.

data SetupCmdOpts = SetupCmdOpts
  { SetupCmdOpts -> Maybe WantedCompiler
compilerVersion :: !(Maybe WantedCompiler)
  , SetupCmdOpts -> Bool
forceReinstall  :: !Bool
  , SetupCmdOpts -> Maybe String
ghcBindistUrl   :: !(Maybe String)
  , SetupCmdOpts -> [String]
ghcjsBootOpts   :: ![String]
  , SetupCmdOpts -> Bool
ghcjsBootClean  :: !Bool
  }

-- | 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
  Bool
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)
  if Bool
installGHC
    then
       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
wantedCompiler, VersionCheck
compilerCheck, Maybe (Path Abs File)
mstack) <-
         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 -> (,,)
             (WantedCompiler
 -> VersionCheck
 -> Maybe (Path Abs File)
 -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig WantedCompiler
-> RIO
     BuildConfig
     (VersionCheck
      -> Maybe (Path Abs File)
      -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
             RIO
  BuildConfig
  (VersionCheck
   -> Maybe (Path Abs File)
   -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig VersionCheck
-> RIO
     BuildConfig
     (Maybe (Path Abs File)
      -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
forall a b.
RIO BuildConfig (a -> b) -> RIO BuildConfig a -> RIO BuildConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Getting VersionCheck BuildConfig VersionCheck
-> RIO BuildConfig VersionCheck
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Config -> Const VersionCheck Config)
-> BuildConfig -> Const VersionCheck BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> Const VersionCheck Config)
 -> BuildConfig -> Const VersionCheck BuildConfig)
-> ((VersionCheck -> Const VersionCheck VersionCheck)
    -> Config -> Const VersionCheck Config)
-> Getting VersionCheck BuildConfig VersionCheck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> VersionCheck) -> SimpleGetter Config VersionCheck
forall s a. (s -> a) -> SimpleGetter s a
to (.compilerCheck))
             RIO
  BuildConfig
  (Maybe (Path Abs File)
   -> (WantedCompiler, VersionCheck, Maybe (Path Abs File)))
-> RIO BuildConfig (Maybe (Path Abs File))
-> RIO
     BuildConfig (WantedCompiler, VersionCheck, Maybe (Path Abs File))
forall a b.
RIO BuildConfig (a -> b) -> RIO BuildConfig a -> RIO BuildConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just (Path Abs File -> Maybe (Path Abs File))
-> RIO BuildConfig (Path Abs File)
-> RIO BuildConfig (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Path Abs File) BuildConfig (Path Abs File)
-> RIO BuildConfig (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs File) BuildConfig (Path Abs File)
forall env. HasBuildConfig env => Lens' env (Path Abs File)
Lens' BuildConfig (Path Abs File)
stackYamlL)
       SetupCmdOpts
-> WantedCompiler
-> VersionCheck
-> Maybe (Path Abs File)
-> RIO BuildConfig ()
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)
mstack
    else
      [StyleDoc] -> RIO Config ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ StyleDoc
"The"
        , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-install-ghc"
        , String -> StyleDoc
flow String
"flag is 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)
  -> 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)
stackYaml = do
  Config
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
  Bool
sandboxedGhc <- (.sandboxed) (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
    { $sel:installIfMissing:SetupOpts :: Bool
installIfMissing = Bool
True
    , $sel:useSystem:SetupOpts :: Bool
useSystem = Config
config.systemGHC Bool -> Bool -> Bool
&& Bool -> Bool
not SetupCmdOpts
sco.forceReinstall
    , WantedCompiler
wantedCompiler :: WantedCompiler
$sel:wantedCompiler:SetupOpts :: WantedCompiler
wantedCompiler
    , VersionCheck
compilerCheck :: VersionCheck
$sel:compilerCheck:SetupOpts :: VersionCheck
compilerCheck
    , Maybe (Path Abs File)
stackYaml :: Maybe (Path Abs File)
$sel:stackYaml:SetupOpts :: Maybe (Path Abs File)
stackYaml
    , $sel:forceReinstall:SetupOpts :: Bool
forceReinstall = SetupCmdOpts
sco.forceReinstall
    , $sel:sanityCheck:SetupOpts :: Bool
sanityCheck = Bool
True
    , $sel:skipGhcCheck:SetupOpts :: Bool
skipGhcCheck = Bool
False
    , $sel:skipMsys:SetupOpts :: Bool
skipMsys = Config
config.skipMsys
    , $sel:resolveMissingGHC:SetupOpts :: Maybe StyleDoc
resolveMissingGHC = Maybe StyleDoc
forall a. Maybe a
Nothing
    , $sel:ghcBindistURL:SetupOpts :: Maybe String
ghcBindistURL = SetupCmdOpts
sco.ghcBindistUrl
    }
  let compiler :: StyleDoc
compiler = case WantedCompiler
wantedCompiler of
        WCGhc Version
_ -> StyleDoc
"GHC"
        WCGhcGit{} -> StyleDoc
"GHC (built from source)"
        WCGhcjs {} -> StyleDoc
"GHCJS"
      compilerHelpMsg :: StyleDoc
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 Bool
sandboxedGhc
    then [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
      [ String -> StyleDoc
flow String
"Stack will use a sandboxed"
      , StyleDoc
compiler
      , String -> StyleDoc
flow String
"it installed."
      , StyleDoc
compilerHelpMsg
      ]
    else [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL
      [ String -> StyleDoc
flow String
"Stack will use the"
      , StyleDoc
compiler
      , String -> StyleDoc
flow String
"on your PATH. For more information on paths, see"
      , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack path")
      , StyleDoc
"and"
      , Style -> StyleDoc -> StyleDoc
style Style
Shell (String -> StyleDoc
flow String
"stack exec env") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
      , StyleDoc
compilerHelpMsg
      ]