{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module GHCup (
module GHCup,
module GHCup.Cabal,
module GHCup.GHC,
module GHCup.HLS,
module GHCup.Stack,
module GHCup.List
) where
import GHCup.Cabal
import GHCup.GHC hiding ( GHCVer(..) )
import GHCup.HLS hiding ( HLSVer(..) )
import GHCup.Stack
import GHCup.List
import GHCup.Download
import GHCup.Errors
import GHCup.Platform
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 GHCup.Prelude.String.QQ
import GHCup.Version
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.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Maybe
import Data.Versions hiding ( patch )
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts
import Optics
import Prelude hiding ( abs
, writeFile
)
import System.Environment
import System.FilePath
import System.IO.Error
import System.IO.Temp
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Streamly.Prelude as S
fetchToolBindist :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
)
=> Version
-> Tool
-> Maybe FilePath
-> Excepts
'[ DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, NoDownload
]
m
FilePath
fetchToolBindist :: forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env,
HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) =>
Version
-> Tool
-> Maybe FilePath
-> Excepts
'[DigestError, ContentLengthError, GPGError, DownloadFailed,
NoDownload]
m
FilePath
fetchToolBindist Version
v Tool
t Maybe FilePath
mfp = do
DownloadInfo
dlinfo <- forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
t Version
v
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts
'[DigestError, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
downloadCached' DownloadInfo
dlinfo forall a. Maybe a
Nothing Maybe FilePath
mfp
rmTool :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadFail m
, MonadMask m
, MonadUnliftIO m)
=> ListResult
-> Excepts '[NotInstalled, UninstallFailed] m ()
rmTool :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadFail m,
MonadMask m, MonadUnliftIO m) =>
ListResult -> Excepts '[NotInstalled, UninstallFailed] m ()
rmTool ListResult {Version
lVer :: ListResult -> Version
lVer :: Version
lVer, Tool
lTool :: ListResult -> Tool
lTool :: Tool
lTool, Maybe Text
lCross :: ListResult -> Maybe Text
lCross :: Maybe Text
lCross} = do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"removing " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall a. Show a => a -> FilePath
show Tool
lTool) forall a. Semigroup a => a -> a -> a
<> Text
" version " forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
lVer
case Tool
lTool of
Tool
GHC ->
let ghcTargetVersion :: GHCTargetVersion
ghcTargetVersion = Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
lCross Version
lVer
in forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled, UninstallFailed] m ()
rmGHCVer GHCTargetVersion
ghcTargetVersion
Tool
HLS -> 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, UninstallFailed] m ()
rmHLSVer Version
lVer
Tool
Cabal -> forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ 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
lVer
Tool
Stack -> forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ 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
lVer
Tool
GHCup -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m,
HasLog env, MonadMask m, MonadUnliftIO m) =>
m ()
rmGhcup
rmGhcupDirs :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadCatch m
, MonadMask m )
=> m [FilePath]
rmGhcupDirs :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadCatch m, MonadMask m) =>
m [FilePath]
rmGhcupDirs = do
Dirs
{ GHCupPath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
baseDir :: GHCupPath
baseDir
, FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
binDir :: FilePath
binDir
, GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
logsDir :: GHCupPath
logsDir
, GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
cacheDir :: GHCupPath
cacheDir
, GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
recycleDir :: GHCupPath
recycleDir
, GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
dbDir :: GHCupPath
dbDir
, GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
tmpDir :: GHCupPath
tmpDir
} <- forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let envFilePath :: FilePath
envFilePath = GHCupPath -> FilePath
fromGHCupPath GHCupPath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"env"
FilePath
confFilePath <- forall (m :: * -> *). MonadIO m => m FilePath
getConfigFilePath
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmEnvFile FilePath
envFilePath
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmConfFile FilePath
confFilePath
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
logsDir
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
tmpDir
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
cacheDir
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
rmBinDir FilePath
binDir
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
recycleDir
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
dbDir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWindows forall a b. (a -> b) -> a -> b
$ do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"removing " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCupPath -> FilePath
fromGHCupPath GHCupPath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"msys64")
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly (GHCupPath
baseDir GHCupPath -> FilePath -> GHCupPath
`appendGHCupPath` FilePath
"msys64")
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadCatch m) =>
FilePath -> m ()
removeEmptyDirsRecursive (GHCupPath -> FilePath
fromGHCupPath GHCupPath
baseDir)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] [] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
FilePath -> m [FilePath]
reportRemainingFiles (GHCupPath -> FilePath
fromGHCupPath GHCupPath
baseDir)
where
handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m) => m () -> m ()
handleRm :: forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm = forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Part of the cleanup action failed with error: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall e. Exception e => e -> FilePath
displayException IOException
e) forall a. Semigroup a => a -> a -> a
<> Text
"\n"
forall a. Semigroup a => a -> a -> a
<> Text
"continuing regardless...")
rmEnvFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmEnvFile :: forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmEnvFile FilePath
enFilePath = do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing Ghcup Environment File"
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
permissionErrorType] () forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadMask m, MonadIO m) => FilePath -> m ()
rmFileForce FilePath
enFilePath
rmConfFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmConfFile :: forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmConfFile FilePath
confFilePath = do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"removing Ghcup Config File"
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
permissionErrorType] () forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadMask m, MonadIO m) => FilePath -> m ()
rmFileForce FilePath
confFilePath
rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmBinDir :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
rmBinDir FilePath
binDir
| Bool
isWindows = forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
| Bool
otherwise = do
Bool
isXDGStyle <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
useXDG
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isXDGStyle) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
reportRemainingFiles :: (MonadMask m, MonadIO m) => FilePath -> m [FilePath]
reportRemainingFiles :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
FilePath -> m [FilePath]
reportRemainingFiles FilePath
dir = do
[FilePath]
remainingFiles <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => SerialT m a -> m [a]
S.toList (forall (m :: * -> *).
(MonadCatch m, MonadAsync m, MonadMask m) =>
FilePath -> SerialT m FilePath
getDirectoryContentsRecursiveUnsafe FilePath
dir)
let normalizedFilePaths :: [FilePath]
normalizedFilePaths = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
normalise [FilePath]
remainingFiles
let sortedByDepthRemainingFiles :: [FilePath]
sortedByDepthRemainingFiles = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Ordering
compareFn) [FilePath]
normalizedFilePaths
let remainingFilesAbsolute :: [FilePath]
remainingFilesAbsolute = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) [FilePath]
sortedByDepthRemainingFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
remainingFilesAbsolute
where
calcDepth :: FilePath -> Int
calcDepth :: FilePath -> Int
calcDepth = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isPathSeparator
compareFn :: FilePath -> FilePath -> Ordering
compareFn :: FilePath -> FilePath -> Ordering
compareFn FilePath
fp1 FilePath
fp2 = forall a. Ord a => a -> a -> Ordering
compare (FilePath -> Int
calcDepth FilePath
fp1) (FilePath -> Int
calcDepth FilePath
fp2)
getDebugInfo :: ( Alternative m
, MonadFail m
, MonadReader env m
, HasDirs env
, HasLog env
, MonadCatch m
, MonadIO m
)
=> Excepts
'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
m
DebugInfo
getDebugInfo :: forall (m :: * -> *) env.
(Alternative m, MonadFail m, MonadReader env m, HasDirs env,
HasLog env, MonadCatch m, MonadIO m) =>
Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
DebugInfo
getDebugInfo = do
Dirs {FilePath
GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let diBaseDir :: FilePath
diBaseDir = GHCupPath -> FilePath
fromGHCupPath GHCupPath
baseDir
let diBinDir :: FilePath
diBinDir = FilePath
binDir
FilePath
diGHCDir <- GHCupPath -> FilePath
fromGHCupPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m GHCupPath
ghcupGHCBaseDir
let diCacheDir :: FilePath
diCacheDir = GHCupPath -> FilePath
fromGHCupPath GHCupPath
cacheDir
Architecture
diArch <- forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE Either NoCompatibleArch Architecture
getArchitecture
PlatformResult
diPlatform <- forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall (m :: * -> *) env.
(Alternative m, MonadReader env m, HasLog env, MonadCatch m,
MonadIO m, MonadFail m) =>
Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
getPlatform
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DebugInfo { FilePath
PlatformResult
Architecture
$sel:diPlatform:DebugInfo :: PlatformResult
$sel:diArch:DebugInfo :: Architecture
$sel:diCacheDir:DebugInfo :: FilePath
$sel:diGHCDir:DebugInfo :: FilePath
$sel:diBinDir:DebugInfo :: FilePath
$sel:diBaseDir:DebugInfo :: FilePath
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: FilePath
diGHCDir :: FilePath
diBinDir :: FilePath
diBaseDir :: FilePath
.. }
upgradeGHCup :: ( MonadMask m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
, HasSettings env
, MonadCatch m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadResource m
, MonadIO m
, MonadUnliftIO m
)
=> Maybe FilePath
-> Bool
-> Bool
-> Excepts
'[ CopyError
, DigestError
, ContentLengthError
, GPGError
, GPGError
, DownloadFailed
, NoDownload
, NoUpdate
, ToolShadowed
]
m
Version
upgradeGHCup :: forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasPlatformReq env,
HasGHCupInfo env, HasSettings env, MonadCatch m, HasLog env,
MonadThrow m, MonadFail m, MonadResource m, MonadIO m,
MonadUnliftIO m) =>
Maybe FilePath
-> Bool
-> Bool
-> Excepts
'[CopyError, DigestError, ContentLengthError, GPGError, GPGError,
DownloadFailed, NoDownload, NoUpdate, ToolShadowed]
m
Version
upgradeGHCup Maybe FilePath
mtarget Bool
force' Bool
fatal = do
Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Upgrading GHCup..."
let latestVer :: Version
latestVer = GHCTargetVersion -> Version
_tvVersion forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (forall a. HasCallStack => Maybe a -> a
fromJust (GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup))
(Just Version
ghcupPVPVer) <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
ghcUpVer Text
""
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force' Bool -> Bool -> Bool
&& (Version
latestVer forall a. Ord a => a -> a -> Bool
<= Version
ghcupPVPVer)) forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE NoUpdate
NoUpdate
DownloadInfo
dli <- forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
GHCup Version
latestVer
FilePath
tmp <- GHCupPath -> FilePath
fromGHCupPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
let fn :: FilePath
fn = FilePath
"ghcup" forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
FilePath
p <- forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts
'[DigestError, ContentLengthError, DownloadFailed, GPGError]
m
FilePath
download (DownloadInfo -> URI
_dlUri DownloadInfo
dli) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) (DownloadInfo -> Maybe Integer
_dlCSize DownloadInfo
dli) FilePath
tmp (forall a. a -> Maybe a
Just FilePath
fn) Bool
False
let destDir :: FilePath
destDir = FilePath -> FilePath
takeDirectory FilePath
destFile
destFile :: FilePath
destFile = forall a. a -> Maybe a -> a
fromMaybe (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fn) Maybe FilePath
mtarget
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"mkdir -p " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destDir
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
destDir
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm -f " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile FilePath
destFile
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"cp " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE FilePath
p FilePath
destFile Bool
False
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
chmod_755 FilePath
destFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
isInPath FilePath
destFile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b forall a b. (a -> b) -> a -> b
$
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> FilePath
takeFileName FilePath
destFile) forall a. Semigroup a => a -> a -> a
<> Text
" is not in PATH! You have to add it in order to use ghcup."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
isShadowed FilePath
destFile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just FilePath
pa
| Bool
fatal -> forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> FilePath -> FilePath -> Version -> ToolShadowed
ToolShadowed Tool
GHCup FilePath
pa FilePath
destFile Version
latestVer)
| Bool
otherwise ->
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall e. (Pretty e, HFErrorProject e) => e -> FilePath
prettyHFError (Tool -> FilePath -> FilePath -> Version -> ToolShadowed
ToolShadowed Tool
GHCup FilePath
pa FilePath
destFile Version
latestVer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
latestVer
rmGhcup :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadCatch m
, HasLog env
, MonadMask m
, MonadUnliftIO m
)
=> m ()
rmGhcup :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m,
HasLog env, MonadMask m, MonadUnliftIO m) =>
m ()
rmGhcup = do
Dirs { FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
.. } <- forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let ghcupFilename :: FilePath
ghcupFilename = FilePath
"ghcup" forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let ghcupFilepath :: FilePath
ghcupFilepath = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
ghcupFilename
FilePath
currentRunningExecPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
FilePath
p1 <- forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
(forall {m :: * -> *} {env} {p}.
(MonadReader env m,
LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
currentRunningExecPath)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath)
FilePath
p2 <- forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
(forall {m :: * -> *} {env} {p}.
(MonadReader env m,
LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
ghcupFilepath)
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
ghcupFilepath)
let areEqualPaths :: Bool
areEqualPaths = FilePath -> FilePath -> Bool
equalFilePath FilePath
p1 FilePath
p2
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
areEqualPaths forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ FilePath -> Text
nonStandardInstallLocationMsg FilePath
currentRunningExecPath
if Bool
isWindows
then do
FilePath
tmp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO FilePath
getCanonicalTemporaryDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
t -> FilePath -> FilePath -> IO FilePath
createTempDirectory FilePath
t FilePath
"ghcup"
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"mv " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ghcupFilepath forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath
tmp FilePath -> FilePath -> FilePath
</> FilePath
"ghcup")
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
UnsupportedOperation forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> IO ()
moveFile FilePath
ghcupFilepath (FilePath
tmp FilePath -> FilePath -> FilePath
</> FilePath
"ghcup")
else
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
ghcupFilepath
where
handlePathNotPresent :: FilePath -> p -> m FilePath
handlePathNotPresent FilePath
fp p
_err = do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Error: The path does not exist, " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fp
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fp
nonStandardInstallLocationMsg :: FilePath -> Text
nonStandardInstallLocationMsg FilePath
path = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$
FilePath
"current ghcup is invoked from a non-standard location: \n"
forall a. Semigroup a => a -> a -> a
<> FilePath
path forall a. Semigroup a => a -> a -> a
<>
FilePath
"\n you may have to uninstall it manually."
whereIsTool :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
, MonadMask m
, MonadUnliftIO m
)
=> Tool
-> GHCTargetVersion
-> Excepts '[NotInstalled] m FilePath
whereIsTool :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
Tool -> GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
whereIsTool Tool
tool ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
..} = do
Dirs
dirs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
case Tool
tool of
Tool
GHC -> do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver)
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver)
FilePath
bdir <- GHCupPath -> FilePath
fromGHCupPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
ver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> GHCTargetVersion -> FilePath
ghcBinaryName GHCTargetVersion
ver)
Tool
Cabal -> do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
_tvVersion)
forall a b. (a -> b) -> a -> b
$ 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 forall a. Maybe a
Nothing Version
_tvVersion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"cabal-" forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
HLS -> do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
_tvVersion)
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion forall a. Maybe a
Nothing Version
_tvVersion))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
_tvVersion)
(forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper-" forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt))
forall a b. (a -> b) -> a -> b
$ do
FilePath
bdir <- GHCupPath -> FilePath
fromGHCupPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m GHCupPath
ghcupHLSDir Version
_tvVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
Stack -> do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
_tvVersion)
forall a b. (a -> b) -> a -> b
$ 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 forall a. Maybe a
Nothing Version
_tvVersion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"stack-" forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
GHCup -> do
FilePath
currentRunningExecPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath
checkIfToolInstalled :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
Version ->
m Bool
checkIfToolInstalled :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
tool Version
ver = forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool (Version -> GHCTargetVersion
mkTVer Version
ver)
checkIfToolInstalled' :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
GHCTargetVersion ->
m Bool
checkIfToolInstalled' :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool GHCTargetVersion
ver =
case Tool
tool of
Tool
Cabal -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
HLS -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
Stack -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
GHC -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver
Tool
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
rmOldGHC :: ( MonadReader env m
, HasGHCupInfo env
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmOldGHC :: forall env (m :: * -> *).
(MonadReader env m, HasGHCupInfo env, HasDirs env, HasLog env,
MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m) =>
Excepts '[NotInstalled, UninstallFailed] m ()
rmOldGHC = do
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
let oldGHCs :: [GHCTargetVersion]
oldGHCs = forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Tool
GHC forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag
-> Fold
(Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo)
getTagged Tag
Old forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s a. (s -> a) -> Getter s a
to forall a b. (a, b) -> a
fst) GHCupDownloads
dls
[GHCTargetVersion]
ghcs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> [b]
rights forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GHCTargetVersion
ghc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GHCTargetVersion]
oldGHCs) forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled, UninstallFailed] m ()
rmGHCVer GHCTargetVersion
ghc
rmProfilingLibs :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> m ()
rmProfilingLibs :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadFail m, MonadMask m, MonadUnliftIO m) =>
m ()
rmProfilingLibs = do
[GHCTargetVersion]
ghcs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> [b]
rights forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
let regexes :: [ByteString]
regexes :: [ByteString]
regexes = [[s|.*_p\.a$|], [s|.*\.p_hi$|]]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
regexes forall a b. (a -> b) -> a -> b
$ \ByteString
regex ->
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
GHCupPath
d <- forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
ghc
[FilePath]
matches <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall a b. (a -> b) -> a -> b
$ GHCupPath -> Regex -> IO [FilePath]
findFilesDeep
GHCupPath
d
(forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
ByteString
regex
)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
matches forall a b. (a -> b) -> a -> b
$ \FilePath
m -> do
let p :: FilePath
p = GHCupPath -> FilePath
fromGHCupPath GHCupPath
d FilePath -> FilePath -> FilePath
</> FilePath
m
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p
rmShareDir :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> m ()
rmShareDir :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadFail m, MonadMask m, MonadUnliftIO m) =>
m ()
rmShareDir = do
[GHCTargetVersion]
ghcs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> [b]
rights forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
GHCupPath
d <- forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
ghc
let p :: GHCupPath
p = GHCupPath
d GHCupPath -> FilePath -> GHCupPath
`appendGHCupPath` FilePath
"share"
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCupPath -> FilePath
fromGHCupPath GHCupPath
p)
forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
p
rmHLSNoGHC :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
, MonadFail m
, MonadUnliftIO m
)
=> Excepts '[NotInstalled, UninstallFailed] m ()
rmHLSNoGHC :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m, MonadFail m, MonadUnliftIO m) =>
Excepts '[NotInstalled, UninstallFailed] m ()
rmHLSNoGHC = do
Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[GHCTargetVersion]
ghcs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> [b]
rights forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
[Version]
hlses <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. [Either a b] -> [b]
rights forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version]
hlses forall a b. (a -> b) -> a -> b
$ \Version
hls -> do
[GHCTargetVersion]
hlsGHCs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> GHCTargetVersion
mkTVer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadCatch m) =>
Version -> m [Version]
hlsGHCVersions' Version
hls
let candidates :: [GHCTargetVersion]
candidates = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCTargetVersion]
ghcs) [GHCTargetVersion]
hlsGHCs
if (forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
hlsGHCs forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
candidates) forall a. Ord a => a -> a -> Bool
<= Int
0
then 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, UninstallFailed] m ()
rmHLSVer Version
hls
else
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
candidates forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
[FilePath]
bins1 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
binDir FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
hls (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
bins2 <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
hls) (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall a b. (a -> b) -> a -> b
$ do
[FilePath]
shs <- forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
hls (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
bins <- forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadFail m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerBinaries Version
hls (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
libs <- forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadFail m) =>
Version -> Version -> m [FilePath]
hlsInternalServerLibs Version
hls (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
shs forall a. [a] -> [a] -> [a]
++ [FilePath]
bins forall a. [a] -> [a] -> [a]
++ [FilePath]
libs)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath]
bins1 forall a. [a] -> [a] -> [a]
++ [FilePath]
bins2) forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
f
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
f
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
rmCache :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
)
=> m ()
rmCache :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m) =>
m ()
rmCache = do
Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory (GHCupPath -> FilePath
fromGHCupPath GHCupPath
cacheDir)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let p :: FilePath
p = GHCupPath -> FilePath
fromGHCupPath GHCupPath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
f
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p
rmTmp :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
)
=> m ()
rmTmp :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m) =>
m ()
rmTmp = do
[GHCupPath]
ghcup_dirs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [GHCupPath]
getGHCupTmpDirs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCupPath]
ghcup_dirs forall a b. (a -> b) -> a -> b
$ \GHCupPath
f -> do
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCupPath -> FilePath
fromGHCupPath GHCupPath
f)
forall (m :: * -> *). (MonadIO m, MonadMask m) => GHCupPath -> m ()
rmPathForcibly GHCupPath
f