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

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

This module contains the main functions that correspond
to the command line interface, like installation, listing versions
and so on.

These are the entry points.
-}
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)




    ---------------------
    --[ Tool fetching ]--
    ---------------------


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



    ------------
    --[ Nuke ]--
    ------------




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

  -- for xdg dirs, the order matters here
  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)

  -- report files in baseDir that are left-over after
  -- the standard location deletions above
  [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)




    ------------------
    --[ Debug info ]--
    ------------------


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
.. }




    -------------------------
    --[ GHCup upgrade etc ]--
    -------------------------


-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided.
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    -- ^ full file destination to write ghcup into
             -> Bool              -- ^ whether to force update regardless
                                  --   of currently installed version
             -> Bool              -- ^ whether to throw an error if ghcup is shadowed
             -> 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


-- assuming the current scheme of having just 1 ghcup bin, no version info is required.
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

  -- if paths do no exist, warn user, and continue to compare them, as is,
  -- which should eventually fail and result in a non-standard install warning

  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
    -- since it doesn't seem possible to delete a running exe on windows
    -- we move it to temp dir, to be deleted at next reboot
    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
    -- delete it.
    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."



    ---------------
    --[ Whereis ]--
    ---------------



-- | Reports the binary location of a given tool:
--
--   * for GHC, this reports: @~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * for cabal, this reports @~\/.ghcup\/bin\/cabal-\<ver\>@
--   * for hls, this reports @~\/.ghcup\/bin\/haskell-language-server-wrapper-\<ver\>@
--   * for stack, this reports @~\/.ghcup\/bin\/stack-\<ver\>@
--   * for ghcup, this reports the location of the currently running executable
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


-- | Doesn't work for cross GHC.
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




    --------------------------
    --[ Garbage collection ]--
    --------------------------


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
      -- TODO: audit findFilesDeep
      [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