{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

{-|
Module      : GHCup.Stack
Description : GHCup installation functions for Stack
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Stack where

import           GHCup.Download
import           GHCup.Errors
import           GHCup.Types
import           GHCup.Types.JSON               ( )
import           GHCup.Types.Optics
import           GHCup.Utils
import           GHCup.Prelude
import           GHCup.Prelude.File
import           GHCup.Prelude.Logger

import           Codec.Archive                  ( ArchiveResult )
import           Control.Applicative
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.Either
import           Data.List
import           Data.Maybe
import           Data.Versions                hiding ( patch )
import           Haskus.Utils.Variant.Excepts
import           Optics
import           Prelude                 hiding ( abs
                                                , writeFile
                                                )
import           Safe                    hiding ( at )
import           System.FilePath
import           System.IO.Error

import qualified Data.Text                     as T
import Text.PrettyPrint.HughesPJClass (prettyShow)



    --------------------
    --[ Installation ]--
    --------------------


-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
-- creates a default @stack -> stack-x.y.z.q@ symlink for
-- the latest installed version.
installStackBin :: ( MonadMask m
                   , MonadCatch m
                   , MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , HasPlatformReq env
                   , HasGHCupInfo env
                   , HasLog env
                   , MonadResource m
                   , MonadIO m
                   , MonadUnliftIO m
                   , MonadFail m
                   )
                => Version
                -> InstallDir
                -> Bool            -- ^ Force install
                -> Excepts
                     '[ AlreadyInstalled
                      , CopyError
                      , DigestError
                      , GPGError
                      , DownloadFailed
                      , NoDownload
                      , NotInstalled
                      , UnknownArchive
                      , TarDirDoesNotExist
                      , ArchiveResult
                      , FileAlreadyExistsError
                      ]
                     m
                     ()
installStackBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBin Version
ver InstallDir
installDir Bool
forceInstall = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Stack Version
ver
  DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
 HasDirs env, HasSettings env, HasLog env, MonadResource m,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall


-- | Like 'installStackBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installStackBindist :: ( MonadMask m
                       , MonadCatch m
                       , MonadReader env m
                       , HasPlatformReq env
                       , HasDirs env
                       , HasSettings env
                       , HasLog env
                       , MonadResource m
                       , MonadIO m
                       , MonadUnliftIO m
                       , MonadFail m
                       )
                    => DownloadInfo
                    -> Version
                    -> InstallDir
                    -> Bool           -- ^ Force install
                    -> Excepts
                         '[ AlreadyInstalled
                          , CopyError
                          , DigestError
                          , GPGError
                          , DownloadFailed
                          , NoDownload
                          , NotInstalled
                          , UnknownArchive
                          , TarDirDoesNotExist
                          , ArchiveResult
                          , FileAlreadyExistsError
                          ]
                         m
                         ()
installStackBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
  m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install stack version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver

  PlatformRequest {Maybe Versioning
Platform
Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
..} <- m PlatformRequest
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
  Dirs {FilePath
GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
..} <- m Dirs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  Bool
regularStackInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
ver

  if
    | Bool -> Bool
not Bool
forceInstall
    , Bool
regularStackInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do
        AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Stack Version
ver

    | Bool
forceInstall
    , Bool
regularStackInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of Stack first!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
ver

    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  -- download (or use cached version)
  FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlinfo Maybe FilePath
forall a. Maybe a
Nothing

  -- unpack
  GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     GHCupPath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
m GHCupPath
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError GHCupPath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack) FilePath
dl)
  Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack)

  -- the subdir of the archive where we do the work
  GHCupPath
workdir <- Excepts
  '[AlreadyInstalled, CopyError, DigestError, GPGError,
    DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
  m
  GHCupPath
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, CopyError, DigestError, GPGError,
           DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
           TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
         m
         GHCupPath)
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     GHCupPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GHCupPath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     GHCupPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupPath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m GHCupPath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     GHCupPath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m GHCupPath
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      GHCupPath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath)
-> TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     GHCupPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCupPath -> TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
GHCupPath -> TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath
intoSubdir GHCupPath
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)

  case InstallDir
installDir of
    IsolateDir FilePath
isoDir -> do                 -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Stack to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
GHCupPath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked GHCupPath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
    InstallDir
GHCupInternal -> do                     -- regular install
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
GHCupPath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked GHCupPath
workdir (FilePath -> InstallDirResolved
GHCupBinDir FilePath
binDir) Version
ver Bool
forceInstall


-- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
              => GHCupPath      -- ^ Path to the unpacked stack bindist (where the executable resides)
              -> InstallDirResolved
              -> Version
              -> Bool          -- ^ Force install
              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked :: GHCupPath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked GHCupPath
path InstallDirResolved
installDir Version
ver Bool
forceInstall = do
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing stack"
  let stackFile :: FilePath
stackFile = FilePath
"stack"
  IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir)
  let destFileName :: FilePath
destFileName = FilePath
stackFile
                     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
                          IsolateDirResolved FilePath
_ -> FilePath
""
                          InstallDirResolved
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
                        )
                     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
destFileName

  FilePath
-> FilePath
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE
    (GHCupPath -> FilePath
fromGHCupPath GHCupPath
path FilePath -> FilePath -> FilePath
</> FilePath
stackFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    FilePath
destPath
    (Bool -> Bool
not Bool
forceInstall)
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
chmod_755 FilePath
destPath



    -----------------
    --[ Set stack ]--
    -----------------


-- | Set the @~\/.ghcup\/bin\/stack@ symlink.
setStack :: ( MonadMask m
            , MonadReader env m
            , HasDirs env
            , HasLog env
            , MonadThrow m
            , MonadFail m
            , MonadIO m
            , MonadUnliftIO m
            )
         => Version
         -> Excepts '[NotInstalled] m ()
setStack :: Version -> Excepts '[NotInstalled] m ()
setStack Version
ver = do
  let targetFile :: FilePath
targetFile = FilePath
"stack-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

  -- symlink destination
  Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled] m Bool)
-> IO Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile))
    (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
    (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

  let stackbin :: FilePath
stackbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
targetFile FilePath
stackbin

  IO (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
isShadowed FilePath
stackbin) Excepts '[NotInstalled] m (Maybe FilePath)
-> (Maybe FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe FilePath
Nothing -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just FilePath
pa -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ToolShadowed -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Tool -> FilePath -> FilePath -> Version -> ToolShadowed
ToolShadowed Tool
Cabal FilePath
pa FilePath
stackbin Version
ver)

  () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


unsetStack :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadIO m)
           => m ()
unsetStack :: m ()
unsetStack = do
  Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let stackbin :: FilePath
stackbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
stackbin


    ----------------
    --[ Rm stack ]--
    ----------------

-- | Delete a stack version. Will try to fix the @stack@ symlink
-- after removal (e.g. setting it to an older version).
rmStackVer :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadThrow m
              , HasLog env
              , MonadIO m
              , MonadFail m
              , MonadCatch m
              , MonadUnliftIO m
              )
           => Version
           -> Excepts '[NotInstalled] m ()
rmStackVer :: Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

  Maybe Version
sSet      <- m (Maybe Version) -> Excepts '[NotInstalled] m (Maybe Version)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m, HasLog env) =>
m (Maybe Version)
stackSet

  Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  let stackFile :: FilePath
stackFile = FilePath
"stack-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
stackFile)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
sSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    [Version]
sVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledStacks
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
sVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
latestver
      Maybe Version
Nothing        -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)