{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Cabal 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 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.Ord
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
installCabalBindist :: ( 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
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBindist :: 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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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 cabal version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver
PlatformRequest {Maybe Versioning
Platform
Architecture
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
..} <- m PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
PlatformRequest
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
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
baseDir :: GHCupPath
binDir :: FilePath
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Dirs
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
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
regularCabalInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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
cabalInstalled Version
ver
if
| Bool -> Bool
not Bool
forceInstall
, Bool
regularCabalInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Cabal Version
ver
| Bool
forceInstall
, Bool
regularCabalInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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 first!"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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 ()
rmCabalVer Version
ver
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a.
a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FilePath
dl <- Excepts
'[DigestError, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath)
-> Excepts
'[DigestError, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts
'[DigestError, ContentLengthError, 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, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
downloadCached DownloadInfo
dlinfo Maybe FilePath
forall a. Maybe a
Nothing
GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
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, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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), HFErrorProject (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
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)
FilePath
workdir <- GHCupPath -> FilePath
fromGHCupPath (GHCupPath -> FilePath)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath)
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath
forall a.
a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupPath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m GHCupPath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
GHCupPath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath)
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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 Cabal 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, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
InstallDir
GHCupInternal -> do
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupBinDir FilePath
binDir) Version
ver Bool
forceInstall
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
=> FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked :: forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
path InstallDirResolved
inst Version
ver Bool
forceInstall = do
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[CopyError, FileAlreadyExistsError] m a
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 cabal"
let cabalFile :: FilePath
cabalFile = FilePath
"cabal"
IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a. IO a -> Excepts '[CopyError, FileAlreadyExistsError] m a
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
inst)
let destFileName :: FilePath
destFileName = FilePath
cabalFile
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
inst 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
let destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst 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
(FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
cabalFile 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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[CopyError, FileAlreadyExistsError] m a
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
installCabalBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBin :: forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) =>
Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBin Version
ver InstallDir
installDir Bool
forceInstall = do
DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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
Cabal Version
ver
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
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, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall
setCabal :: ( MonadMask m
, MonadReader env m
, HasDirs env
, HasLog env
, MonadFail m
, MonadIO m
, MonadUnliftIO m)
=> Version
-> Excepts '[NotInstalled] m ()
setCabal :: forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver = do
let targetFile :: FilePath
targetFile = FilePath
"cabal-" 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
Dirs {FilePath
GHCupPath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> FilePath
baseDir :: GHCupPath
binDir :: FilePath
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 a. IO a -> Excepts '[NotInstalled] m a
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
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)
let cabalbin :: FilePath
cabalbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let destL :: FilePath
destL = FilePath
targetFile
m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
destL FilePath
cabalbin
IO (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a. IO a -> Excepts '[NotInstalled] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
isShadowed FilePath
cabalbin) Excepts '[NotInstalled] m (Maybe FilePath)
-> (Maybe FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b.
Excepts '[NotInstalled] m a
-> (a -> Excepts '[NotInstalled] m b)
-> Excepts '[NotInstalled] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> () -> Excepts '[NotInstalled] m ()
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just FilePath
pa -> m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 e. (Pretty e, HFErrorProject e) => e -> FilePath
prettyHFError (Tool -> FilePath -> FilePath -> Version -> ToolShadowed
ToolShadowed Tool
Cabal FilePath
pa FilePath
cabalbin Version
ver)
() -> Excepts '[NotInstalled] m ()
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
unsetCabal :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadIO m)
=> m ()
unsetCabal :: forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadIO m) =>
m ()
unsetCabal = do
Dirs {FilePath
GHCupPath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> FilePath
baseDir :: GHCupPath
binDir :: FilePath
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let cabalbin :: FilePath
cabalbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" 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
cabalbin
rmCabalVer :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadFail m
, MonadCatch m
, MonadUnliftIO m
)
=> Version
-> Excepts '[NotInstalled] m ()
rmCabalVer :: 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 ()
rmCabalVer 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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 a b. (a -> b) -> m a -> m b
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
cabalInstalled 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
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))
Maybe Version
cSet <- m (Maybe Version) -> Excepts '[NotInstalled] m (Maybe Version)
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe Version)
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadIO m,
MonadThrow m, MonadCatch m) =>
m (Maybe Version)
cabalSet
Dirs {FilePath
GHCupPath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> FilePath
baseDir :: GHCupPath
binDir :: FilePath
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 cabalFile :: FilePath
cabalFile = FilePath
"cabal-" 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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
cabalFile)
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
cSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
[Version]
cVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 a b. (a -> b) -> m a -> m b
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]
getInstalledCabals
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 -> Ordering) -> [Version] -> [Version]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Version -> Down Version) -> Version -> Version -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Version -> Down Version
forall a. a -> Down a
Down) ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
cVers of
Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
latestver
Maybe Version
Nothing -> m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)