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