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

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

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

import           Codec.Archive                  ( ArchiveResult )
import           Control.Applicative
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.ByteString                ( ByteString )
import           Data.Either
import           Data.List
import           Data.Maybe
import           Data.String                    ( fromString )
import           Data.Text                      ( Text )
import           Data.Versions                hiding ( patch )
import           Distribution.Types.Version   hiding ( Version )
import           Distribution.Types.PackageId
import           Distribution.Types.PackageDescription
import           Distribution.Types.GenericPackageDescription
import           Distribution.PackageDescription.Parsec
import           GHC.IO.Exception
import           Haskus.Utils.Variant.Excepts
import           Optics
import           Prelude                 hiding ( abs
                                                , writeFile
                                                )
import           Safe                    hiding ( at )
import           System.FilePath
import           System.IO.Error
import           Text.Regex.Posix
import           URI.ByteString

import qualified Data.List.NonEmpty            as NE
import qualified Data.ByteString               as B
import qualified Data.Text                     as T
import qualified Text.Megaparsec               as MP
import Text.PrettyPrint.HughesPJClass (prettyShow)


data HLSVer = SourceDist Version
            | GitDist GitBranch
            | HackageDist Version
            | RemoteDist URI



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


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

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

  Bool
regularHLSInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     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
ver

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

    | Bool
forceInstall
    , Bool
regularHLSInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do        -- regular forced install
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of HLS before force installing!"
        Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ 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
ver

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

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

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

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

  if
    | Bool -> Bool
not Bool
forceInstall
    , Bool -> Bool
not Bool
legacy
    , (IsolateDir FilePath
fp) <- InstallDir
installDir -> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DirNotEmpty] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadMask m) =>
InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
fp)
    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  case InstallDir
installDir of
    IsolateDir FilePath
isoDir -> do
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      if Bool
legacy
      then Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
      else Excepts
  '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
    MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
     MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction GHCupPath
tmpUnpack (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
     MergeFileTreeError]
   m
   ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
 HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m,
 MonadResource m, HasPlatformReq env) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
installHLSUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall

    InstallDir
GHCupInternal -> do
      if Bool
legacy
      then Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
workdir (FilePath -> InstallDirResolved
GHCupBinDir FilePath
binDir) Version
ver Bool
forceInstall
      else do
        GHCupPath
inst <- Version
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m GHCupPath
ghcupHLSDir Version
ver
        Excepts
  '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
    MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
     MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction GHCupPath
tmpUnpack
              (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
     MergeFileTreeError]
   m
   ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
 HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m,
 MonadResource m, HasPlatformReq env) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
installHLSUnpacked FilePath
workdir (GHCupPath -> InstallDirResolved
GHCupDir GHCupPath
inst) Version
ver Bool
forceInstall
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
ver SetHLS
SetHLS_XYZ Maybe FilePath
forall a. Maybe a
Nothing


isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
                   -> IO Bool
isLegacyHLSBindist :: FilePath -> IO Bool
isLegacyHLSBindist FilePath
path = do
  Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"GNUmakefile")

-- | Install an unpacked hls distribution.
installHLSUnpacked :: ( MonadMask m
                      , MonadUnliftIO m
                      , MonadReader env m
                      , MonadFail m
                      , HasLog env
                      , HasDirs env
                      , HasSettings env
                      , MonadCatch m
                      , MonadIO m
                      , MonadResource m
                      , HasPlatformReq env
                      )
                   => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
                   -> InstallDirResolved      -- ^ Path to install to
                   -> Version
                   -> Bool
                   -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled, MergeFileTreeError] m ()
installHLSUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
installHLSUnpacked FilePath
path InstallDirResolved
inst Version
ver Bool
forceInstall = do
  PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
  m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing HLS"
  GHCupPath
tmpInstallDest <- m GHCupPath
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     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
  m (Either ProcessError ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"DESTDIR=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpInstallDest, FilePath
"PREFIX=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst, FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
  Excepts '[] m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpInstallDest)
  Excepts '[MergeFileTreeError] m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
        MergeFileTreeError]
      m
      ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled,
       MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (FilePath -> FilePath -> m ())
-> Excepts '[MergeFileTreeError] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadAsync m, MonadReader env m, HasDirs env,
 HasLog env, MonadCatch m) =>
GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (FilePath -> FilePath -> m ())
-> Excepts '[MergeFileTreeError] m ()
mergeFileTree (GHCupPath
tmpInstallDest GHCupPath -> FilePath -> GHCupPath
`appendGHCupPath` FilePath -> FilePath
dropDrive (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst))
                   InstallDirResolved
inst
                   Tool
HLS
                   (Version -> GHCTargetVersion
mkTVer Version
ver)
                   (\FilePath
f FilePath
t -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                       Maybe UTCTime
mtime <- IO Bool
-> IO (Maybe UTCTime) -> IO (Maybe UTCTime) -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
pathIsSymbolicLink FilePath
f) (Maybe UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing) (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime FilePath
f)
                       FilePath -> FilePath -> Bool -> IO ()
install FilePath
f FilePath
t (Bool -> Bool
not Bool
forceInstall)
                       Maybe UTCTime -> (UTCTime -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UTCTime
mtime ((UTCTime -> IO ()) -> IO ()) -> (UTCTime -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> UTCTime -> IO ()
setModificationTime FilePath
t)

-- | Install an unpacked hls distribution (legacy).
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
                         => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
                         -> InstallDirResolved      -- ^ Path to install to
                         -> Version
                         -> Bool          -- ^ is it a force install
                         -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
path InstallDirResolved
installDir Version
ver Bool
forceInstall = do
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing HLS"
  IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir)

  -- install haskell-language-server-<ghcver>
  bins :: [FilePath]
bins@(FilePath
_:[FilePath]
_) <- IO [FilePath]
-> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath])
-> IO [FilePath]
-> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
    FilePath
path
    (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                   ExecOption
execBlank
                   ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
    )
  [FilePath]
-> (FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> (FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
    let toF :: FilePath
toF = FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt FilePath
f
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
                   IsolateDirResolved FilePath
_ -> FilePath
""
                   InstallDirResolved
_ -> (FilePath
"~" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
                 )
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

    let srcPath :: FilePath
srcPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
f
    let destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
toF

    -- destination could be an existing symlink
    -- for new make-based HLSes
    IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadMask m, MonadIO m) => FilePath -> m ()
rmFileForce FilePath
destPath

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

  -- install haskell-language-server-wrapper
  let wrapper :: FilePath
wrapper = FilePath
"haskell-language-server-wrapper"
      toF :: FilePath
toF = FilePath
wrapper
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
                 IsolateDirResolved FilePath
_ -> FilePath
""
                 InstallDirResolved
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
               )
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      srcWrapperPath :: FilePath
srcWrapperPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
wrapper FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      destWrapperPath :: FilePath
destWrapperPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
toF

  IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadMask m, MonadIO m) => FilePath -> m ()
rmFileForce FilePath
destWrapperPath
  FilePath
-> FilePath
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE
    FilePath
srcWrapperPath
    FilePath
destWrapperPath
    (Bool -> Bool
not Bool
forceInstall)

  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
chmod_755 FilePath
destWrapperPath



-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m
                 , MonadCatch m
                 , MonadReader env m
                 , HasPlatformReq env
                 , HasGHCupInfo env
                 , HasDirs env
                 , HasSettings env
                 , HasLog env
                 , MonadResource m
                 , MonadIO m
                 , MonadUnliftIO m
                 , MonadFail m
                 )
              => Version
              -> InstallDir
              -> Bool            -- force install
              -> Excepts
                   '[ AlreadyInstalled
                    , CopyError
                    , DigestError
                    , GPGError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
                    , ArchiveResult
                    , FileAlreadyExistsError
                    , ProcessError
                    , DirNotEmpty
                    , UninstallFailed
                    , MergeFileTreeError
                    ]
                   m
                   ()
installHLSBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
installHLSBin Version
ver InstallDir
installDir Bool
forceInstall = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     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
HLS Version
ver
  DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
 HasDirs env, HasSettings env, HasLog env, MonadResource m,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError]
     m
     ()
installHLSBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall


compileHLS :: ( MonadMask m
              , MonadCatch m
              , MonadReader env m
              , HasDirs env
              , HasSettings env
              , HasPlatformReq env
              , HasGHCupInfo env
              , HasLog env
              , MonadResource m
              , MonadIO m
              , MonadUnliftIO m
              , MonadFail m
              )
           => HLSVer
           -> [Version]
           -> Maybe Int
           -> Either Bool Version
           -> InstallDir
           -> Maybe (Either FilePath URI)
           -> Maybe URI
           -> Bool
           -> Maybe (Either FilePath [URI])  -- ^ patches
           -> [Text]                   -- ^ additional args to cabal install
           -> Excepts '[ NoDownload
                       , GPGError
                       , DownloadFailed
                       , DigestError
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , ArchiveResult
                       , BuildFailed
                       , NotInstalled
                       ] m Version
compileHLS :: HLSVer
-> [Version]
-> Maybe Int
-> Either Bool Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
-> Bool
-> Maybe (Either FilePath [URI])
-> [Text]
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
compileHLS HLSVer
targetHLS [Version]
ghcs Maybe Int
jobs Either Bool Version
ov InstallDir
installDir Maybe (Either FilePath URI)
cabalProject Maybe URI
cabalProjectLocal Bool
updateCabal Maybe (Either FilePath [URI])
patches [Text]
cabalArgs = do
  PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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
  Dirs { FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
.. } <- m Dirs
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       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

  Bool
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updateCabal (Excepts
   '[NoDownload, GPGError, DownloadFailed, DigestError,
     UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
     NotInstalled]
   m
   ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ (V '[ProcessError] -> DownloadFailed)
-> Excepts '[ProcessError] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[ProcessError] V '[ProcessError] -> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[ProcessError] m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
    m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] 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
"Updating cabal DB"
    m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec FilePath
"cabal" [FilePath
"update"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpDir) Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing

  (GHCupPath
workdir, GHCupPath
tmpUnpack, Version
tver, Maybe Text
git_describe) <- case HLSVer
targetHLS of
    -- unpack from version tarball
    SourceDist Version
tver -> do
      m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

      -- download source tarball
      DownloadInfo
dlInfo <-
        Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
-> GHCupDownloads -> Maybe DownloadInfo
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
HLS Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     VersionInfo
     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
% Index (Map Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
tver Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
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
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
viSourceDL Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
-> Optic
     A_Prism
     '[]
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
     DownloadInfo
     DownloadInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
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
% Optic
  A_Prism
  '[]
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
  DownloadInfo
  DownloadInfo
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
          Maybe DownloadInfo
-> NoDownload
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
      FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlInfo Maybe FilePath
forall a. Maybe a
Nothing

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

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

      (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (GHCupPath, GHCupPath, Version, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
workdir, GHCupPath
tmpUnpack, Version
tver, Maybe Text
forall a. Maybe a
Nothing)

    HackageDist Version
tver -> do
      m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile (from hackage): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

      -- download source tarball
      GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
      let hls :: FilePath
hls = FilePath
"haskell-language-server-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
tver)
      (V '[ProcessError] -> DownloadFailed)
-> Excepts '[ProcessError] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[ProcessError] V '[ProcessError] -> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[ProcessError] m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
        -- unpack
        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec FilePath
"cabal" [FilePath
"unpack", FilePath
hls] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack) Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing

      let workdir :: GHCupPath
workdir = GHCupPath -> FilePath -> GHCupPath
appendGHCupPath GHCupPath
tmpUnpack FilePath
hls

      (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (GHCupPath, GHCupPath, Version, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
workdir, GHCupPath
tmpUnpack, Version
tver, Maybe Text
forall a. Maybe a
Nothing)

    RemoteDist URI
uri -> do
      m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile (from uri): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (URI -> FilePath
forall a. Show a => a -> FilePath
show URI
uri)

      -- download source tarball
      GHCupPath
tmpDownload <- m GHCupPath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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
      GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
      FilePath
tar <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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 URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpDownload) Maybe FilePath
forall a. Maybe a
Nothing Bool
False
      (FilePath
cf, Version
tver) <- Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (FilePath, Version)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      (FilePath, Version))
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (FilePath, Version)
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError GHCupPath
tmpUnpack (Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
 -> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version))
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
forall a b. (a -> b) -> a -> b
$ do
        FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack) FilePath
tar
        let regex :: ByteString
regex = [s|^(.*/)*haskell-language-server\.cabal$|] :: B.ByteString
        [FilePath
cabalFile] <- IO [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Excepts '[UnknownArchive, ArchiveResult] m [FilePath])
-> IO [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall a b. (a -> b) -> a -> b
$ GHCupPath -> Regex -> IO [FilePath]
findFilesDeep
          GHCupPath
tmpUnpack
          (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
          )
        Version
tver <- FilePath -> Excepts '[UnknownArchive, ArchiveResult] m Version
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
FilePath -> m Version
getCabalVersion (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack FilePath -> FilePath -> FilePath
</> FilePath
cabalFile)
        (FilePath, Version)
-> Excepts '[UnknownArchive, ArchiveResult] m (FilePath, Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
cabalFile, Version
tver)

      let workdir :: GHCupPath
workdir = GHCupPath -> FilePath -> GHCupPath
appendGHCupPath GHCupPath
tmpUnpack (FilePath -> FilePath
takeDirectory FilePath
cf)

      (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (GHCupPath, GHCupPath, Version, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
workdir, GHCupPath
tmpUnpack, Version
tver, Maybe Text
forall a. Maybe a
Nothing)

    -- clone from git
    GitDist GitBranch{FilePath
Maybe FilePath
$sel:repo:GitBranch :: GitBranch -> Maybe FilePath
$sel:ref:GitBranch :: GitBranch -> FilePath
repo :: Maybe FilePath
ref :: FilePath
..} -> do
      GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     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, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
      let git :: [FilePath] -> m (Either ProcessError ())
git [FilePath]
args = FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"git" (FilePath
"--no-pager"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
args) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack) FilePath
"git" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
      (V '[ProcessError] -> DownloadFailed)
-> Excepts
     '[ProcessError] m (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (GHCupPath, GHCupPath, Version, Maybe Text)
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[ProcessError] V '[ProcessError] -> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts
   '[ProcessError] m (GHCupPath, GHCupPath, Version, Maybe Text)
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      (GHCupPath, GHCupPath, Version, Maybe Text))
-> Excepts
     '[ProcessError] m (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     (GHCupPath, GHCupPath, Version, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
        let rep :: FilePath
rep = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"https://github.com/haskell/haskell-language-server.git" Maybe FilePath
repo
        m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Fetching git repo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (this may take a while)"
        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"init" ]
        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"remote"
                  , FilePath
"add"
                  , FilePath
"origin"
                  , FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
rep ]

        -- figure out if we can do a shallow clone
        [FilePath]
remoteBranches <- (ProcessError -> Excepts '[] m [FilePath])
-> Excepts '[ProcessError] m [FilePath]
-> Excepts '[ProcessError] m [FilePath]
forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchE @ProcessError @'[ProcessError] @'[] (\ProcessError
_ -> [FilePath] -> Excepts '[] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
            (Excepts '[ProcessError] m [FilePath]
 -> Excepts '[ProcessError] m [FilePath])
-> Excepts '[ProcessError] m [FilePath]
-> Excepts '[ProcessError] m [FilePath]
forall a b. (a -> b) -> a -> b
$ (Text -> [FilePath])
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [FilePath]
processBranches (Excepts '[ProcessError] m Text
 -> Excepts '[ProcessError] m [FilePath])
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[FilePath] -> FilePath -> Excepts '[ProcessError] m Text
gitOut [FilePath
"ls-remote", FilePath
"--heads", FilePath
"origin"] (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack)
        let shallow_clone :: Bool
shallow_clone
              | Bool
gitDescribeRequested                 = Bool
False
              | FilePath -> Bool
isCommitHash FilePath
ref                     = Bool
True
              | FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
remoteBranches = Bool
True
              | Bool
otherwise                            = Bool
False

        m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] 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
"Shallow clone: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Bool -> FilePath
forall a. Show a => a -> FilePath
show Bool
shallow_clone)

        -- fetch
        let fetch_args :: [FilePath]
fetch_args
              | Bool
shallow_clone = [FilePath
"fetch", FilePath
"--depth", FilePath
"1", FilePath
"--quiet", FilePath
"origin", FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref]
              | Bool
otherwise     = [FilePath
"fetch", FilePath
"--tags",       FilePath
"--quiet", FilePath
"origin"                ]
        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [FilePath]
fetch_args

        -- checkout
        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"checkout", FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]

        -- gather some info
        Maybe Text
git_describe <- if Bool
shallow_clone
                        then Maybe Text -> Excepts '[ProcessError] m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
                        else (Text -> Maybe Text)
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (Excepts '[ProcessError] m Text
 -> Excepts '[ProcessError] m (Maybe Text))
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[FilePath] -> FilePath -> Excepts '[ProcessError] m Text
gitOut [FilePath
"describe", FilePath
"--tags"] (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack)
        Text
chash <- [FilePath] -> FilePath -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[FilePath] -> FilePath -> Excepts '[ProcessError] m Text
gitOut [FilePath
"rev-parse", FilePath
"HEAD" ] (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack)
        Version
tver <- FilePath -> Excepts '[ProcessError] m Version
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
FilePath -> m Version
getCabalVersion (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server.cabal")

        Excepts '[] m () -> Excepts '[ProcessError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m () -> Excepts '[ProcessError] m ())
-> Excepts '[] m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack)
        m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Examining git ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                    Text
"HLS version (from cabal file): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                    (if Bool -> Bool
not Bool
shallow_clone then Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'git describe' output: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
git_describe else Text
forall a. Monoid a => a
mempty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                    (if FilePath -> Bool
isCommitHash FilePath
ref then Text
forall a. Monoid a => a
mempty else Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"commit hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
chash)

        (GHCupPath, GHCupPath, Version, Maybe Text)
-> Excepts
     '[ProcessError] m (GHCupPath, GHCupPath, Version, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
tmpUnpack, GHCupPath
tmpUnpack, Version
tver, Maybe Text
git_describe)

  -- the version that's installed may differ from the
  -- compiled version, so the user can overwrite it
  Version
installVer <- case Either Bool Version
ov of
                  Left Bool
True -> case Maybe Text
git_describe of
                                 -- git describe
                                 Just Text
h -> (ParsingError
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      Version)
-> (Version
    -> Excepts
         '[NoDownload, GPGError, DownloadFailed, DigestError,
           UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
           NotInstalled]
         m
         Version)
-> Either ParsingError Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      Version)
-> (ParsingError -> FilePath)
-> ParsingError
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> FilePath
forall e. Exception e => e -> FilePath
displayException) Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParsingError Version
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      Version)
-> (Text -> Either ParsingError Version)
-> Text
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
version (Text
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      Version)
-> Text
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall a b. (a -> b) -> a -> b
$ Text
h
                                 -- git describe, but not building from git, lol
                                 Maybe Text
Nothing -> Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
tver
                  -- default: use detected version
                  Left Bool
False -> Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
tver
                  -- overwrite version with users value
                  Right Version
v -> Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

  Excepts '[BuildFailed] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts '[BuildFailed] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction
    GHCupPath
tmpUnpack
    ((V '[GPGError, DownloadFailed, DigestError, PatchFailed,
     ProcessError, FileAlreadyExistsError, CopyError]
 -> BuildFailed)
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
-> Excepts '[BuildFailed] m ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (FilePath
-> V '[GPGError, DownloadFailed, DigestError, PatchFailed,
       ProcessError, FileAlreadyExistsError, CopyError]
-> BuildFailed
forall (es :: [*]).
(ToVariantMaybe BuildFailed es, PopVariant BuildFailed es,
 Pretty (V es), Show (V es)) =>
FilePath -> V es -> BuildFailed
BuildFailed (FilePath
 -> V '[GPGError, DownloadFailed, DigestError, PatchFailed,
        ProcessError, FileAlreadyExistsError, CopyError]
 -> BuildFailed)
-> FilePath
-> V '[GPGError, DownloadFailed, DigestError, PatchFailed,
       ProcessError, FileAlreadyExistsError, CopyError]
-> BuildFailed
forall a b. (a -> b) -> a -> b
$ GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir) (Excepts
   '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
     FileAlreadyExistsError, CopyError]
   m
   ()
 -> Excepts '[BuildFailed] m ())
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
-> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
      let tmpInstallDir :: FilePath
tmpInstallDir = GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"out"
      IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
tmpInstallDir

      -- apply patches
      Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
patches (GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir)

      -- set up project files
      FilePath
cp <- case Maybe (Either FilePath URI)
cabalProject of
        Just (Left FilePath
cp)
          | FilePath -> Bool
isAbsolute FilePath
cp -> do
              FilePath
-> FilePath
-> Bool
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE FilePath
cp (GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project") Bool
False
              FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
          | Bool
otherwise -> FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath
takeFileName FilePath
cp)
        Just (Right URI
uri) -> do
          GHCupPath
tmpUnpack' <- m GHCupPath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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
          FilePath
cp <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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 URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack') (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"cabal.project") Bool
False
          FilePath
-> FilePath
-> Bool
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE FilePath
cp (GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project") Bool
False
          FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
        Maybe (Either FilePath URI)
Nothing
          | HackageDist Version
_ <- HLSVer
targetHLS -> do
              IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project") ByteString
"packages: ./"
              FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
          | RemoteDist URI
_ <- HLSVer
targetHLS -> do
              let cabalFile :: FilePath
cabalFile = GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project"
              IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
cabalFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile FilePath
cabalFile ByteString
"packages: ./"
              FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
          | Bool
otherwise -> FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
      Maybe URI
-> (URI
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe URI
cabalProjectLocal ((URI
  -> Excepts
       '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
         FileAlreadyExistsError, CopyError]
       m
       ())
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> (URI
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \URI
uri -> do
        GHCupPath
tmpUnpack' <- m GHCupPath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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
        FilePath
cpl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     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 URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (GHCupPath -> FilePath
fromGHCupPath GHCupPath
tmpUnpack') (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")) Bool
False
        FilePath
-> FilePath
-> Bool
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Bool -> Excepts xs m ()
copyFileE FilePath
cpl (GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir FilePath -> FilePath -> FilePath
</> FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local") Bool
False
      [FilePath]
artifacts <- [Version]
-> (Version
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         FilePath)
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort [Version]
ghcs) ((Version
  -> Excepts
       '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
         FileAlreadyExistsError, CopyError]
       m
       FilePath)
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      [FilePath])
-> (Version
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         FilePath)
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     [FilePath]
forall a b. (a -> b) -> a -> b
$ \Version
ghc -> do
        let ghcInstallDir :: FilePath
ghcInstallDir = FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
        IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
tmpInstallDir
        m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Building HLS " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
installVer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ghc
        Excepts '[ProcessError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$
          FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"cabal" ( [ FilePath
"v2-install"
                               , FilePath
"-w"
                               , FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
                               , FilePath
"--install-method=copy"
                               ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                               [FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"--jobs=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j]) Maybe Int
jobs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                               [ FilePath
"--overwrite-policy=always"
                               , FilePath
"--disable-profiling"
                               , FilePath
"--disable-tests"
                               , FilePath
"--installdir=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcInstallDir
                               , FilePath
"--project-file=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cp
                               ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
cabalArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [
                                 FilePath
"exe:haskell-language-server"
                               , FilePath
"exe:haskell-language-server-wrapper"]
                             )
                             (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ GHCupPath -> FilePath
fromGHCupPath GHCupPath
workdir)
                             FilePath
"cabal"
                             Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
        FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
ghcInstallDir

      [FilePath]
-> (FilePath
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
artifacts ((FilePath
  -> Excepts
       '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
         FileAlreadyExistsError, CopyError]
       m
       ())
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> (FilePath
    -> Excepts
         '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
           FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \FilePath
artifact -> do
        Text
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> Text
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
artifact)
        IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
          (FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
takeFileName FilePath
artifact FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
        IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
          (FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)

      case InstallDir
installDir of
        IsolateDir FilePath
isoDir -> do
          m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
          Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
tmpInstallDir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
installVer Bool
True
        InstallDir
GHCupInternal -> do
          Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
        FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
tmpInstallDir (FilePath -> InstallDirResolved
GHCupBinDir FilePath
binDir) Version
installVer Bool
True
    )

  Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
installVer
 where
  gitDescribeRequested :: Bool
gitDescribeRequested = case Either Bool Version
ov of
                           Left Bool
b -> Bool
b
                           Either Bool Version
_      -> Bool
False


    -----------------
    --[ Set/Unset ]--
    -----------------

-- | Set the haskell-language-server symlinks.
setHLS :: ( MonadReader env m
          , HasDirs env
          , HasLog env
          , MonadIO m
          , MonadMask m
          , MonadFail m
          , MonadUnliftIO m
          )
       => Version
       -> SetHLS
       -> Maybe FilePath  -- if set, signals that we're not operating in ~/.ghcup/bin
                          -- and don't want mess with other versions
       -> Excepts '[NotInstalled] m ()
setHLS :: Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
ver SetHLS
shls Maybe FilePath
mBinDir = 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
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver) (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
ver)))

  -- symlink destination
  FilePath
binDir <- case Maybe FilePath
mBinDir of
    Just FilePath
x -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x
    Maybe FilePath
Nothing -> do
      Dirs {$sel:binDir:Dirs :: Dirs -> FilePath
binDir = FilePath
f} <- 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
      FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
f

  -- first delete the old symlinks
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
    case SetHLS
shls of
      -- not for legacy
      SetHLS
SetHLS_XYZ -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] 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] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
Version -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks Version
ver
      -- legacy and new
      SetHLS
SetHLSOnly -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Excepts '[NotInstalled] m ()
rmPlainHLS

  case SetHLS
shls of
    -- not for legacy
    SetHLS
SetHLS_XYZ -> do
      [FilePath]
bins <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
ver Maybe Version
forall a. Maybe a
Nothing

      [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
        let fname :: FilePath
fname = FilePath -> FilePath
takeFileName FilePath
f
        FilePath
destL <- FilePath -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
binarySymLinkDestination FilePath
binDir FilePath
f
        let target :: FilePath
target = if FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fname
                     then FilePath
fname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
                     else FilePath
fname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"~" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
        m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
target)

    -- legacy and new
    SetHLS
SetHLSOnly -> do
      -- set haskell-language-server-<ghcver> symlinks
      [FilePath]
bins <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
ver Maybe Version
forall a. Maybe a
Nothing
      Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
bins) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

      [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
        let destL :: FilePath
destL = FilePath
f
        let target :: FilePath
target = (FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"~" (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
f
        m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
target)

      -- set haskell-language-server-wrapper symlink
      let destL :: FilePath
destL = FilePath
"haskell-language-server-wrapper-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      let wrapper :: FilePath
wrapper = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

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

      Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
        m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadCatch m, MonadIO m) =>
m ()
warnAboutHlsCompatibility

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


unsetHLS :: ( MonadMask m
            , MonadReader env m
            , HasDirs env
            , MonadIO m)
         => m ()
unsetHLS :: m ()
unsetHLS = do
  Dirs {FilePath
GHCupPath
tmpDir :: GHCupPath
recycleDir :: GHCupPath
dbDir :: GHCupPath
confDir :: GHCupPath
logsDir :: GHCupPath
cacheDir :: GHCupPath
binDir :: FilePath
baseDir :: GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> GHCupPath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let wrapper :: FilePath
wrapper = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  [FilePath]
bins   <- 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
$ FilePath -> Parsec Void Text Text -> IO [FilePath]
forall a. FilePath -> Parsec Void Text a -> IO [FilePath]
findFiles'
    FilePath
binDir
    (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"haskell-language-server-" Parsec Void Text Text
-> ParsecT Void Text Identity PVP -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity PVP
pvp' Parsec Void Text Text
-> Parsec Void Text Text -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk (FilePath -> Text
T.pack FilePath
exeExt) Parsec Void Text Text
-> ParsecT Void Text Identity () -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)
  [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins (IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
binDir FilePath -> FilePath -> FilePath
</>))
  IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
wrapper




    ---------------
    --[ Removal ]--
    ---------------


-- | Delete a hls version. Will try to fix the hls symlinks
-- after removal (e.g. setting it to an older version).
rmHLSVer :: ( 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 -> Excepts '[NotInstalled, UninstallFailed] m ()
rmHLSVer Version
ver = do
  Excepts '[NotInstalled, UninstallFailed] m Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool)
-> m Bool -> Excepts '[NotInstalled, UninstallFailed] 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
ver) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled, UninstallFailed] 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
ver))

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

  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 env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
Version -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks Version
ver

  Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
    -- delete all set symlinks
    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 ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Excepts '[NotInstalled] m ()
rmPlainHLS

  GHCupPath
hlsDir' <- Version -> Excepts '[NotInstalled, UninstallFailed] m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m GHCupPath
ghcupHLSDir Version
ver
  let hlsDir :: FilePath
hlsDir = GHCupPath -> FilePath
fromGHCupPath GHCupPath
hlsDir'
  m (Maybe [FilePath])
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe [FilePath])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Tool -> GHCTargetVersion -> m (Maybe [FilePath])
forall (m :: * -> *) env.
(MonadIO m, MonadCatch m, MonadReader env m, HasDirs env,
 MonadFail m) =>
Tool -> GHCTargetVersion -> m (Maybe [FilePath])
getInstalledFiles Tool
HLS (Version -> GHCTargetVersion
mkTVer Version
ver)) Excepts '[NotInstalled, UninstallFailed] m (Maybe [FilePath])
-> (Maybe [FilePath]
    -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just [FilePath]
files -> do
      m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing files safely from: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
hlsDir
      [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]
files (m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> (FilePath -> m ())
-> FilePath
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\FilePath
f -> FilePath
hlsDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropDrive FilePath
f))
      FilePath -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadCatch m) =>
FilePath -> m ()
removeEmptyDirsRecursive FilePath
hlsDir
      [FilePath]
survivors <- IO [FilePath]
-> Excepts '[NotInstalled, UninstallFailed] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Excepts '[NotInstalled, UninstallFailed] m [FilePath])
-> IO [FilePath]
-> Excepts '[NotInstalled, UninstallFailed] m [FilePath]
forall a b. (a -> b) -> a -> b
$ [IOErrorType] -> [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] [] (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
hlsDir
      FilePath
f <- Tool
-> GHCTargetVersion
-> Excepts '[NotInstalled, UninstallFailed] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
Tool -> GHCTargetVersion -> m FilePath
recordedInstallationFile Tool
HLS (Version -> GHCTargetVersion
mkTVer Version
ver)
      m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] 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
f
      Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
survivors)) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ UninstallFailed -> Excepts '[NotInstalled, UninstallFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (UninstallFailed -> Excepts '[NotInstalled, UninstallFailed] m ())
-> UninstallFailed -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> UninstallFailed
UninstallFailed FilePath
hlsDir [FilePath]
survivors
    Maybe [FilePath]
Nothing -> do
      Bool
isDir <- IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool)
-> IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
hlsDir
      Bool
isSyml <- IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool)
-> IO Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall a b. (a -> b) -> a -> b
$ (IOException -> IO Bool) -> IO Bool -> IO Bool
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
pathIsSymbolicLink FilePath
hlsDir
      Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isSyml) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
        m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing legacy directory recursively: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
hlsDir
        GHCupPath -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
GHCupPath -> m ()
recyclePathForcibly GHCupPath
hlsDir'

  Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
    -- set latest hls
    [Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled, UninstallFailed] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
 -> Excepts '[NotInstalled, UninstallFailed] m [Version])
-> m [Version]
-> Excepts '[NotInstalled, UninstallFailed] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers of
      Just Version
latestver -> 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 -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
latestver SetHLS
SetHLSOnly Maybe FilePath
forall a. Maybe a
Nothing
      Maybe Version
Nothing        -> () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


getCabalVersion :: (MonadIO m, MonadFail m) => FilePath -> m Version
getCabalVersion :: FilePath -> m Version
getCabalVersion FilePath
fp = do
  ByteString
contents <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
fp
  GenericPackageDescription
gpd <- case ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe ByteString
contents of
           Maybe GenericPackageDescription
Nothing -> FilePath -> m GenericPackageDescription
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m GenericPackageDescription)
-> FilePath -> m GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath
"could not parse cabal file: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp
           Just GenericPackageDescription
r -> GenericPackageDescription -> m GenericPackageDescription
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenericPackageDescription
r
  let tver :: Version
tver = (\NonEmpty VChunk
c -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> Maybe Text -> Version
Version Maybe Word
forall a. Maybe a
Nothing NonEmpty VChunk
c [] Maybe Text
forall a. Maybe a
Nothing)
           (NonEmpty VChunk -> Version)
-> (GenericPackageDescription -> NonEmpty VChunk)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VChunk] -> NonEmpty VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VChunk] -> NonEmpty VChunk)
-> (GenericPackageDescription -> [VChunk])
-> GenericPackageDescription
-> NonEmpty VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> VChunk) -> [Int] -> [VChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([VUnit] -> VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VUnit] -> VChunk) -> (Int -> [VUnit]) -> Int -> VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VUnit -> [VUnit] -> [VUnit]
forall a. a -> [a] -> [a]
:[]) (VUnit -> [VUnit]) -> (Int -> VUnit) -> Int -> [VUnit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> VUnit
digits (Word -> VUnit) -> (Int -> Word) -> Int -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
           ([Int] -> [VChunk])
-> (GenericPackageDescription -> [Int])
-> GenericPackageDescription
-> [VChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers
           (Version -> [Int])
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion
           (PackageIdentifier -> Version)
-> (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
           (PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
           (GenericPackageDescription -> Version)
-> GenericPackageDescription -> Version
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
gpd
  Version -> m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
tver