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

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

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

These are the entry points.
-}
module GHCup where


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

import           Codec.Archive                  ( ArchiveResult )
import           Control.Applicative
import           Control.DeepSeq                ( force )
import           Control.Exception              ( evaluate )
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           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
import           Data.ByteString                ( ByteString )
import           Data.Either
import           Data.List
import           Data.Maybe
import           Data.List.NonEmpty             ( NonEmpty((:|)) )
import           Data.String                    ( fromString )
import           Data.Text                      ( Text )
import           Data.Time.Clock
import           Data.Time.Format.ISO8601
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           Language.Haskell.TH
import           Language.Haskell.TH.Syntax     ( Quasi(qAddDependentFile) )
import           Optics
import           Prelude                 hiding ( abs
                                                , writeFile
                                                )
import           Safe                    hiding ( at )
import           System.Directory        hiding ( findFiles )
import           System.Environment
import           System.FilePath
import           System.IO.Error
import           System.IO.Temp
import           Text.PrettyPrint.HughesPJClass ( prettyShow )
import           Text.Regex.Posix
import           URI.ByteString

import qualified Crypto.Hash.SHA256            as SHA256
import qualified Data.List.NonEmpty            as NE
import qualified Data.ByteString.Base16        as B16
import qualified Data.ByteString               as B
import qualified Data.ByteString.Lazy          as BL
import qualified Data.Map.Strict               as Map
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T
import qualified Data.Text.Encoding            as E
import qualified Text.Megaparsec               as MP
import GHCup.Utils.MegaParsec
import Control.Concurrent (threadDelay)


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


fetchToolBindist :: ( MonadFail m
                    , MonadMask m
                    , MonadCatch m
                    , MonadReader env m
                    , HasDirs env
                    , HasSettings env
                    , HasPlatformReq env
                    , HasGHCupInfo env
                    , HasLog env
                    , MonadResource m
                    , MonadIO m
                    , MonadUnliftIO m
                    )
                 => Version
                 -> Tool
                 -> Maybe FilePath
                 -> Excepts
                      '[ DigestError
                       , GPGError
                       , DownloadFailed
                       , NoDownload
                       ]
                      m
                      FilePath
fetchToolBindist :: Version
-> Tool
-> Maybe FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
fetchToolBindist Version
v Tool
t Maybe FilePath
mfp = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[DigestError, GPGError, DownloadFailed, NoDownload]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
t Version
v
  Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
dlinfo Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
mfp


fetchGHCSrc :: ( MonadFail m
               , MonadMask m
               , MonadCatch m
               , MonadReader env m
               , HasDirs env
               , HasSettings env
               , HasPlatformReq env
               , HasGHCupInfo env
               , HasLog env
               , MonadResource m
               , MonadIO m
               , MonadUnliftIO m
               )
            => Version
            -> Maybe FilePath
            -> Excepts
                 '[ DigestError
                  , GPGError
                  , DownloadFailed
                  , NoDownload
                  ]
                 m
                 FilePath
fetchGHCSrc :: Version
-> Maybe FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
fetchGHCSrc Version
v Maybe FilePath
mfp = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] 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
  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
GHC 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
v 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
     '[DigestError, GPGError, DownloadFailed, NoDownload] m DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
  Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
dlInfo Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
mfp



    -------------------------
    --[ Tool installation ]--
    -------------------------


-- | Like 'installGHCBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installGHCBindist :: ( MonadFail m
                     , MonadMask m
                     , MonadCatch m
                     , MonadReader env m
                     , HasDirs env
                     , HasSettings env
                     , HasPlatformReq env
                     , HasLog env
                     , MonadResource m
                     , MonadIO m
                     , MonadUnliftIO m
                     )
                  => DownloadInfo    -- ^ where/how to download
                  -> Version         -- ^ the version to install
                  -> InstallDir
                  -> Bool            -- ^ Force install
                  -> Excepts
                       '[ AlreadyInstalled
                        , BuildFailed
                        , DigestError
                        , GPGError
                        , DownloadFailed
                        , NoDownload
                        , NotInstalled
                        , UnknownArchive
                        , TarDirDoesNotExist
                        , DirNotEmpty
                        , ArchiveResult
                        , ProcessError
                        ]
                       m
                       ()
installGHCBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
installGHCBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
  let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
ver

  m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, 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
"Requested to install GHC with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver

  Bool
regularGHCInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
GHC Version
ver

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

    | Bool
forceInstall
    , Bool
regularGHCInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, 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
"Removing the currently installed GHC version first!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
 MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
tver

    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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


  Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
    DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
  m
  ()
toolchainSanityChecks

  case InstallDir
installDir of
    IsolateDir FilePath
isoDir -> do                        -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, 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
"isolated installing GHC to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
     ArchiveResult, ProcessError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
 HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
installPackedGHC FilePath
dl (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) (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
    InstallDir
GHCupInternal -> do                            -- regular install
      -- prepare paths
      FilePath
ghcdir <- m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      FilePath)
-> m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
tver

      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
     ArchiveResult, ProcessError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
 HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
installPackedGHC FilePath
dl (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) (FilePath -> InstallDirResolved
GHCupDir FilePath
ghcdir) Version
ver Bool
forceInstall

      -- make symlinks & stuff when regular install,
      Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver

 where
  toolchainSanityChecks :: Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
    DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
  m
  ()
toolchainSanityChecks = do
    [Maybe FilePath]
r <- [FilePath]
-> (FilePath
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
           TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
         m
         (Maybe FilePath))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath
"CC", FilePath
"LD"] (IO (Maybe FilePath)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      (Maybe FilePath))
-> (FilePath -> IO (Maybe FilePath))
-> FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
lookupEnv)
    case [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
r of
      [] -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [FilePath]
_ -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, 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 ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"CC/LD environment variable is set. This will change the compiler/linker"
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"environments). If you encounter problems, unset CC and LD and reinstall."


-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else.
installPackedGHC :: ( MonadMask m
                    , MonadCatch m
                    , MonadReader env m
                    , HasDirs env
                    , HasPlatformReq env
                    , HasSettings env
                    , MonadThrow m
                    , HasLog env
                    , MonadIO m
                    , MonadUnliftIO m
                    , MonadFail m
                    )
                 => FilePath          -- ^ Path to the packed GHC bindist
                 -> Maybe TarDir      -- ^ Subdir of the archive
                 -> InstallDirResolved
                 -> Version           -- ^ The GHC version
                 -> Bool              -- ^ Force install
                 -> Excepts
                      '[ BuildFailed
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , DirNotEmpty
                       , ArchiveResult
                       , ProcessError
                       ] m ()
installPackedGHC :: FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
installPackedGHC FilePath
dl Maybe TarDir
msubdir InstallDirResolved
inst Version
ver Bool
forceInstall = do
  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
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     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

  Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DirNotEmpty] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck InstallDirResolved
inst)

  -- unpack
  FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     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
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
tmpUnpack FilePath
dl)
  Excepts '[] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, 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 FilePath
tmpUnpack

  -- the subdir of the archive where we do the work
  FilePath
workdir <- Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
           ArchiveResult, ProcessError]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
                   (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
                   Maybe TarDir
msubdir

  Excepts '[ProcessError] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts '[ProcessError] m ()
-> Excepts '[ProcessError] 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) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack
                         (case InstallDirResolved
inst of
                           IsolateDirResolved FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing -- don't clean up for isolated installs, since that'd potentially delete other
                                                   -- user files if '--force' is supplied
                           GHCupDir FilePath
d -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
d
                           )
                         (FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m) =>
FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
workdir InstallDirResolved
inst Version
ver)


-- | Install an unpacked GHC distribution. This only deals with the GHC
-- build system and nothing else.
installUnpackedGHC :: ( MonadReader env m
                      , HasPlatformReq env
                      , HasDirs env
                      , HasSettings env
                      , MonadThrow m
                      , HasLog env
                      , MonadIO m
                      , MonadUnliftIO m
                      , MonadMask m
                      )
                   => FilePath            -- ^ Path to the unpacked GHC bindist (where the configure script resides)
                   -> InstallDirResolved  -- ^ Path to install to
                   -> Version             -- ^ The GHC version
                   -> Excepts '[ProcessError] m ()
installUnpackedGHC :: FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
path InstallDirResolved
inst Version
ver
  | Bool
isWindows = 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
"Installing GHC (this may take a while)"
      -- Windows bindists are relocatable and don't need
      -- to run configure.
      -- We also must make sure to preserve mtime to not confuse ghc-pkg.
      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
$ ((forall a. m a -> IO a) -> IO ()) -> m ()
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (case InstallDirResolved
inst of
                                                      IsolateDirResolved FilePath
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                                      GHCupDir FilePath
d -> m () -> IO ()
forall a. m a -> IO a
run (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
d
                                                    ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
copyDirectoryRecursive FilePath
path (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst) ((FilePath -> FilePath -> IO ()) -> IO ())
-> (FilePath -> FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
source FilePath
dest -> do
        UTCTime
mtime <- FilePath -> IO UTCTime
getModificationTime FilePath
source
        FilePath -> FilePath -> IO ()
moveFilePortable FilePath
source FilePath
dest
        FilePath -> UTCTime -> IO ()
setModificationTime FilePath
dest UTCTime
mtime
  | Bool
otherwise = 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] 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

      let alpineArgs :: [FilePath]
alpineArgs
           | Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.2.2|], Linux LinuxDistro
Alpine <- Platform
_rPlatform
           = [FilePath
"--disable-ld-override"]
           | Bool
otherwise
           = []

      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
"Installing GHC (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
-> [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
"sh"
                       (FilePath
"./configure" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst)
                        FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
alpineArgs
                       )
                       (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
                       FilePath
"ghc-configure"
                       Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
      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] -> 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
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
      () -> Excepts '[ProcessError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
-- following symlinks in @~\/.ghcup\/bin@:
--
--   * @ghc-x.y.z -> ..\/ghc\/x.y.z\/bin/ghc@
--   * @ghc-x.y   -> ..\/ghc\/x.y.z\/bin/ghc@ (if x.y.z is the latest x.y version)
installGHCBin :: ( MonadFail m
                 , MonadMask m
                 , MonadCatch m
                 , MonadReader env m
                 , HasPlatformReq env
                 , HasGHCupInfo env
                 , HasDirs env
                 , HasSettings env
                 , HasLog env
                 , MonadResource m
                 , MonadIO m
                 , MonadUnliftIO m
                 )
              => Version         -- ^ the version to install
              -> InstallDir
              -> Bool            -- ^ force install
              -> Excepts
                   '[ AlreadyInstalled
                    , BuildFailed
                    , DigestError
                    , GPGError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
                    , DirNotEmpty
                    , ArchiveResult
                    , ProcessError
                    ]
                   m
                   ()
installGHCBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
installGHCBin Version
ver InstallDir
installDir Bool
forceInstall = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     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
GHC Version
ver
  Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
    DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
     TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
 HasDirs env, HasSettings env, HasPlatformReq env, HasLog env,
 MonadResource m, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
     m
     ()
installGHCBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall


-- | Like 'installCabalBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installCabalBindist :: ( MonadMask m
                       , MonadCatch m
                       , MonadReader env m
                       , HasPlatformReq env
                       , HasDirs env
                       , HasSettings env
                       , HasLog env
                       , MonadResource m
                       , MonadIO m
                       , MonadUnliftIO m
                       , MonadFail m
                       )
                    => DownloadInfo
                    -> Version
                    -> InstallDir
                    -> Bool           -- ^ Force install
                    -> Excepts
                         '[ AlreadyInstalled
                          , CopyError
                          , DigestError
                          , GPGError
                          , DownloadFailed
                          , NoDownload
                          , NotInstalled
                          , UnknownArchive
                          , TarDirDoesNotExist
                          , ArchiveResult
                          , FileAlreadyExistsError
                          ]
                         m
                         ()
installCabalBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
  m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install cabal version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver

  PlatformRequest {Maybe Versioning
Platform
Architecture
_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
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
..} <- m Dirs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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

  -- check if we already have a regular cabal already installed
  Bool
regularCabalInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
Cabal Version
ver

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

    | Bool
forceInstall
    , Bool
regularCabalInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version first!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
ver

    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
     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]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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
  FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
tmpUnpack FilePath
dl)
  Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), 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 FilePath
tmpUnpack

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

  case InstallDir
installDir of
    IsolateDir FilePath
isoDir -> do             -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Cabal to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall

    InstallDir
GHCupInternal -> do                 -- regular install
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall


-- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
              => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
              -> InstallDirResolved      -- ^ Path to install to
              -> Version
              -> Bool          -- ^ Force Install
              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
path InstallDirResolved
inst 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 cabal"
  let cabalFile :: FilePath
cabalFile = FilePath
"cabal"
  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
inst)
  let destFileName :: FilePath
destFileName = FilePath
cabalFile
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
inst of
              IsolateDirResolved FilePath
_ -> FilePath
""
              GHCupDir FilePath
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
           )
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  let destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst FilePath -> FilePath -> FilePath
</> FilePath
destFileName

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall          -- Overwrite it when it IS a force install
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)

  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    FilePath
destPath
  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 env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath

-- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
-- creates a default @cabal -> cabal-x.y.z.q@ symlink for
-- the latest installed version.
installCabalBin :: ( MonadMask m
                   , MonadCatch m
                   , MonadReader env m
                   , HasPlatformReq env
                   , HasGHCupInfo env
                   , HasDirs env
                   , HasSettings env
                   , HasLog env
                   , MonadResource m
                   , MonadIO m
                   , MonadUnliftIO m
                   , MonadFail m
                   )
                => Version
                -> InstallDir
                -> Bool           -- force install
                -> Excepts
                     '[ AlreadyInstalled
                      , CopyError
                      , DigestError
                      , GPGError
                      , DownloadFailed
                      , NoDownload
                      , NotInstalled
                      , UnknownArchive
                      , TarDirDoesNotExist
                      , ArchiveResult
                      , FileAlreadyExistsError
                      ]
                     m
                     ()
installCabalBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installCabalBin Version
ver InstallDir
installDir Bool
forceInstall = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Cabal Version
ver
  DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
 HasDirs env, HasSettings env, HasLog env, MonadResource m,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall


-- | 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
                        ]
                       m
                       ()
installHLSBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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
_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
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
HLS 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]
     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]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver

    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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
  FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
tmpUnpack FilePath
dl)
  Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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 FilePath
tmpUnpack

  -- the subdir of the archive where we do the work
  FilePath
workdir <- Excepts
  '[AlreadyInstalled, CopyError, DigestError, GPGError,
    DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
    ProcessError, DirNotEmpty]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, CopyError, DigestError, GPGError,
           DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
           TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
           ProcessError, DirNotEmpty]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
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]
     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]
      m
      Bool)
-> IO Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      ())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     ()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch 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]
     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]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
  m
  ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     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) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack Maybe FilePath
forall a. Maybe a
Nothing (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
   m
   ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
 HasLog env, HasDirs env, HasSettings env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
installHLSUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver

    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]
     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]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall
      else do
        FilePath
inst <- Version
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
        Excepts
  '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
  m
  ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
        ProcessError, DirNotEmpty]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     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) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
inst)
              (Excepts
   '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
   m
   ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
      m
      ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
 HasLog env, HasDirs env, HasSettings env, MonadCatch m,
 MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
installHLSUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
inst) Version
ver
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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)
                   => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
                   -> InstallDirResolved      -- ^ Path to install to
                   -> Version
                   -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
installHLSUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
installHLSUnpacked FilePath
path (InstallDirResolved -> FilePath
fromInstallDir -> FilePath
inst) Version
_ = do
  m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
      m
      ())
-> m ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, 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 ()
logInfo Text
"Installing HLS"
  IO ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
      m
      ())
-> IO ()
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
inst
  m (Either ProcessError ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     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]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
     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
"PREFIX=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inst, FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)

-- | 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
""
                   GHCupDir FilePath
_ -> (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

    Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall   -- if it is a force install, overwrite it.
      (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)

    FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
      FilePath
srcPath
      FilePath
destPath
    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 env (m :: * -> *).
(MonadReader env m, HasLog env, 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
""
                 GHCupDir FilePath
_ -> (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

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destWrapperPath)

  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    FilePath
srcWrapperPath
    FilePath
destWrapperPath

  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 env (m :: * -> *).
(MonadReader env m, HasLog env, 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
                    ]
                   m
                   ()
installHLSBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
       ProcessError, DirNotEmpty]
     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]
     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]
     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
              )
           => Either Version GitBranch
           -> [Version]
           -> Maybe Int
           -> Maybe Version
           -> InstallDir
           -> Maybe (Either FilePath URI)
           -> Maybe URI
           -> Maybe (Either FilePath [URI])  -- ^ patches
           -> [Text]                   -- ^ additional args to cabal install
           -> Excepts '[ NoDownload
                       , GPGError
                       , DownloadFailed
                       , DigestError
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , ArchiveResult
                       , BuildFailed
                       , NotInstalled
                       ] m Version
compileHLS :: Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
-> Maybe (Either FilePath [URI])
-> [Text]
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
compileHLS Either Version GitBranch
targetHLS [Version]
ghcs Maybe Int
jobs Maybe Version
ov InstallDir
installDir Maybe (Either FilePath URI)
cabalProject Maybe URI
cabalProjectLocal 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
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
.. } <- 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


  (FilePath
workdir, Version
tver) <- case Either Version GitBranch
targetHLS of
    -- unpack from version tarball
    Left 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
      FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
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
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
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 FilePath
tmpUnpack

      FilePath
workdir <- Excepts
  '[NoDownload, GPGError, DownloadFailed, DigestError,
    UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
    NotInstalled]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[NoDownload, GPGError, DownloadFailed, DigestError,
           UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
           NotInstalled]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
                       (Excepts '[TarDirDoesNotExist] 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 '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
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)

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

    -- clone from git
    Right GitBranch{FilePath
Maybe FilePath
$sel:repo:GitBranch :: GitBranch -> Maybe FilePath
$sel:ref:GitBranch :: GitBranch -> FilePath
repo :: Maybe FilePath
ref :: FilePath
..} -> do
      FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
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
tmpUnpack) FilePath
"git" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
      Version
tver <- (V '[ProcessError] -> DownloadFailed)
-> Excepts '[ProcessError] m Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
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 Version
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      Version)
-> Excepts '[ProcessError] m Version
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
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 ]

        let fetch_args :: [FilePath]
fetch_args =
                  [ FilePath
"fetch"
                  , FilePath
"--depth"
                  , FilePath
"1"
                  , FilePath
"--quiet"
                  , FilePath
"origin"
                  , FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]
        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

        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
"FETCH_HEAD" ]
        (Just GenericPackageDescription
gpd) <- ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> Maybe GenericPackageDescription)
-> Excepts '[ProcessError] m ByteString
-> Excepts '[ProcessError] m (Maybe GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Excepts '[ProcessError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
B.readFile (FilePath
tmpUnpack FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server.cabal"))
        Version -> Excepts '[ProcessError] m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Excepts '[ProcessError] m Version)
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> Excepts '[ProcessError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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 -> Excepts '[ProcessError] m Version)
-> GenericPackageDescription -> Excepts '[ProcessError] m Version
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
gpd

      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 FilePath
tmpUnpack
      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 ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Git version " 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
" corresponds to HLS version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

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

  -- the version that's installed may differ from the
  -- compiled version, so the user can overwrite it
  let installVer :: Version
installVer = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
tver Maybe Version
ov

  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
$ FilePath
-> Maybe FilePath
-> 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) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction
    FilePath
workdir
    Maybe FilePath
forall a. Maybe a
Nothing
    ((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
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 = FilePath
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 FilePath
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
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cp (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
              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
          FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
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 FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"cabal.project") Bool
False
          FilePath
-> FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cp (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
          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 -> 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
        FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
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 FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")) Bool
False
        FilePath
-> FilePath
-> Excepts
     '[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
       FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cpl (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")
      [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
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
        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)
        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 ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
artifact

      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
GHCupDir 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



-- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
-- creates a default @stack -> stack-x.y.z.q@ symlink for
-- the latest installed version.
installStackBin :: ( 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
                   )
                => Version
                -> InstallDir
                -> Bool            -- ^ Force install
                -> Excepts
                     '[ AlreadyInstalled
                      , CopyError
                      , DigestError
                      , GPGError
                      , DownloadFailed
                      , NoDownload
                      , NotInstalled
                      , UnknownArchive
                      , TarDirDoesNotExist
                      , ArchiveResult
                      , FileAlreadyExistsError
                      ]
                     m
                     ()
installStackBin :: Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBin 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]
     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]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Stack Version
ver
  DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
 HasDirs env, HasSettings env, HasLog env, MonadResource m,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall


-- | Like 'installStackBin', except takes the 'DownloadInfo' as
-- argument instead of looking it up from 'GHCupDownloads'.
installStackBindist :: ( 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           -- ^ Force install
                    -> Excepts
                         '[ AlreadyInstalled
                          , CopyError
                          , DigestError
                          , GPGError
                          , DownloadFailed
                          , NoDownload
                          , NotInstalled
                          , UnknownArchive
                          , TarDirDoesNotExist
                          , ArchiveResult
                          , FileAlreadyExistsError
                          ]
                         m
                         ()
installStackBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
  m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install stack version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver

  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
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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
regularStackInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
Stack Version
ver

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

    | Bool
forceInstall
    , Bool
regularStackInstalled
    , InstallDir
GHCupInternal <- InstallDir
installDir -> do
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of Stack first!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
ver

    | Bool
otherwise -> ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
     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]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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
  FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
tmpUnpack FilePath
dl)
  Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), 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 FilePath
tmpUnpack

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

  case InstallDir
installDir of
    IsolateDir FilePath
isoDir -> do                 -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     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]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Stack to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
    InstallDir
GHCupInternal -> do                     -- regular install
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall


-- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
              => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
              -> InstallDirResolved
              -> Version
              -> Bool          -- ^ Force install
              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked 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 stack"
  let stackFile :: FilePath
stackFile = FilePath
"stack"
  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)
  let destFileName :: FilePath
destFileName = FilePath
stackFile
                     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
                          IsolateDirResolved FilePath
_ -> FilePath
""
                          GHCupDir FilePath
_ -> (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
      destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
destFileName

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)

  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
stackFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    FilePath
destPath
  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 env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath


    ---------------------
    --[ Set GHC/cabal ]--
    ---------------------



-- | Set GHC symlinks in @~\/.ghcup\/bin@ for the requested GHC version. The behavior depends
-- on `SetGHC`:
--
--   * SetGHCOnly: @~\/.ghcup\/bin\/ghc -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\<ver\> -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--
-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
-- for 'SetGHCOnly' constructor.
setGHC :: ( MonadReader env m
          , HasDirs env
          , HasLog env
          , MonadThrow m
          , MonadFail m
          , MonadIO m
          , MonadCatch m
          , MonadMask m
          , MonadUnliftIO m
          )
       => GHCTargetVersion
       -> SetGHC
       -> Maybe FilePath  -- if set, signals that we're not operating in ~/.ghcup/bin
                          -- and don't want mess with other versions
       -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC :: GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc Maybe FilePath
mBinDir = do
  let verS :: FilePath
verS = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  FilePath
ghcdir                        <- 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
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver

  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
<$> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
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
GHC GHCTargetVersion
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 (this fixes compatibility issues
  -- with old ghcup)
  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 SetGHC
sghc of
      SetGHC
SetGHCOnly -> 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
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
      SetGHC
SetGHC_XY  -> 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
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks GHCTargetVersion
ver
      SetGHC
SetGHC_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
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks GHCTargetVersion
ver

  -- for ghc tools (ghc, ghci, haddock, ...)
  [FilePath]
verfiles <- GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
 MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
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]
verfiles ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
    Maybe FilePath
mTargetFile <- case SetGHC
sghc of
      SetGHC
SetGHCOnly -> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file
      SetGHC
SetGHC_XY  -> do
        (ParseError -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Excepts '[NotInstalled] m (Maybe FilePath)
-> Excepts '[NotInstalled] m (Maybe FilePath)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
            (\(ParseError
e :: ParseError) -> m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath))
-> m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
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 (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing)
          (Excepts '[NotInstalled] m (Maybe FilePath)
 -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Excepts '[NotInstalled] m (Maybe FilePath)
-> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
            (Int
mj, Int
mi) <- Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
            let major' :: Text
major' = Int -> Text
forall a. Integral a => a -> Text
intToText Int
mj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Integral a => a -> Text
intToText Int
mi
            Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
file 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 Text
major')
      SetGHC
SetGHC_XYZ ->
        Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
verS)

    -- create symlink
    Maybe FilePath
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
mTargetFile ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
targetFile -> do
      FilePath
bindir <- GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
 MonadIO m) =>
GHCTargetVersion -> m FilePath
ghcInternalBinDir GHCTargetVersion
ver
      let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
          fileWithExt :: FilePath
fileWithExt = FilePath
bindir FilePath -> FilePath -> FilePath
</> FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      FilePath
destL <- FilePath -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
binarySymLinkDestination FilePath
binDir FilePath
fileWithExt
      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
fullF

  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
$ do
    -- create symlink for share dir
    Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (GHCTargetVersion -> Maybe Text) -> GHCTargetVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Maybe Text
_tvTarget (GHCTargetVersion -> Bool) -> GHCTargetVersion -> Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
ver) (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 () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadCatch m, MonadMask m) =>
FilePath -> FilePath -> m ()
symlinkShareDir FilePath
ghcdir FilePath
verS

    Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetGHC
sghc SetGHC -> SetGHC -> Bool
forall a. Eq a => a -> a -> Bool
== SetGHC
SetGHCOnly) (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

  GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
ver

 where

  symlinkShareDir :: ( MonadReader env m
                     , HasDirs env
                     , MonadIO m
                     , HasLog env
                     , MonadCatch m
                     , MonadMask m
                     )
                  => FilePath
                  -> String
                  -> m ()
  symlinkShareDir :: FilePath -> FilePath -> m ()
symlinkShareDir FilePath
ghcdir FilePath
ver' = do
    Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
    let destdir :: FilePath
destdir = FilePath
baseDir
    case SetGHC
sghc of
      SetGHC
SetGHCOnly -> do
        let sharedir :: FilePath
sharedir     = FilePath
"share"
        let fullsharedir :: FilePath
fullsharedir = FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
sharedir
        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
"Checking for sharedir existence: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullsharedir
        m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
fullsharedir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          let fullF :: FilePath
fullF   = FilePath
destdir FilePath -> FilePath -> FilePath
</> FilePath
sharedir
          let targetF :: FilePath
targetF = FilePath
"." FilePath -> FilePath -> FilePath
</> FilePath
"ghc" FilePath -> FilePath -> FilePath
</> FilePath
ver' FilePath -> FilePath -> FilePath
</> FilePath
sharedir
          Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF
          IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
rmDirectoryLink FilePath
fullF
          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
"ln -s " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
targetF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF

          if Bool
isWindows
          then IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                 -- On windows we need to be more permissive
                 -- in case symlinks can't be created, be just
                 -- give up here. This symlink isn't strictly necessary.
                 (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
permissionErrorType
                 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
illegalOperationErrorType
                 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
targetF FilePath
fullF
          else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                 (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
targetF FilePath
fullF
      SetGHC
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

unsetGHC :: ( MonadReader env m
            , HasDirs env
            , HasLog env
            , MonadThrow m
            , MonadFail m
            , MonadIO m
            , MonadMask m
            )
         => Maybe Text
         -> Excepts '[NotInstalled] m ()
unsetGHC :: Maybe Text -> Excepts '[NotInstalled] m ()
unsetGHC = Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC


-- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
setCabal :: ( MonadMask m
            , MonadReader env m
            , HasDirs env
            , HasLog env
            , MonadFail m
            , MonadIO m
            , MonadUnliftIO m)
         => Version
         -> Excepts '[NotInstalled] m ()
setCabal :: Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver = do
  let targetFile :: FilePath
targetFile = FilePath
"cabal-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

  -- symlink destination
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled] m Bool)
-> IO Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile))
    (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
    (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

  let cabalbin :: FilePath
cabalbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

  -- create link
  let destL :: FilePath
destL = FilePath
targetFile
  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
cabalbin

  () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

unsetCabal :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadIO m)
           => m ()
unsetCabal :: m ()
unsetCabal = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let cabalbin :: FilePath
cabalbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
cabalbin


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


unsetHLS :: ( MonadMask m
            , MonadReader env m
            , HasDirs env
            , MonadIO m)
         => m ()
unsetHLS :: m ()
unsetHLS = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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


-- | Set the @~\/.ghcup\/bin\/stack@ symlink.
setStack :: ( MonadMask m
            , MonadReader env m
            , HasDirs env
            , HasLog env
            , MonadThrow m
            , MonadFail m
            , MonadIO m
            , MonadUnliftIO m
            )
         => Version
         -> Excepts '[NotInstalled] m ()
setStack :: Version -> Excepts '[NotInstalled] m ()
setStack Version
ver = do
  let targetFile :: FilePath
targetFile = FilePath
"stack-" 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

  -- symlink destination
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled] m Bool)
-> IO Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile))
    (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
    (NotInstalled -> Excepts '[NotInstalled] m ())
-> NotInstalled -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)

  let stackbin :: FilePath
stackbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" 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
targetFile FilePath
stackbin

  () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


unsetStack :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadIO m)
           => m ()
unsetStack :: m ()
unsetStack = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let stackbin :: FilePath
stackbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
stackbin


-- | Warn if the installed and set HLS is not compatible with the installed and
-- set GHC version.
warnAboutHlsCompatibility :: ( MonadReader env m
                             , HasDirs env
                             , HasLog env
                             , MonadThrow m
                             , MonadCatch m
                             , MonadIO m
                             )
                          => m ()
warnAboutHlsCompatibility :: m ()
warnAboutHlsCompatibility = do
  [Version]
supportedGHC <- m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m [Version]
hlsGHCVersions
  Maybe Version
currentGHC   <- (GHCTargetVersion -> Version)
-> Maybe GHCTargetVersion -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHCTargetVersion -> Version
_tvVersion (Maybe GHCTargetVersion -> Maybe Version)
-> m (Maybe GHCTargetVersion) -> m (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
  Maybe Version
currentHLS   <- m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m (Maybe Version)
hlsSet

  case (Maybe Version
currentGHC, Maybe Version
currentHLS) of
    (Just Version
gv, Just Version
hv) | Version
gv Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
supportedGHC -> do
      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
$
        Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
gv) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not compatible with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Haskell Language Server " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
hv) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Haskell IDE support may not work until this is fixed." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Install a different HLS version, or install and set one of the following GHCs:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Text
T.pack ([Version] -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow [Version]
supportedGHC)

    (Maybe Version, Maybe Version)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    ------------------
    --[ List tools ]--
    ------------------


-- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled
                  | ListSet
                  | ListAvailable
                  deriving Int -> ListCriteria -> FilePath -> FilePath
[ListCriteria] -> FilePath -> FilePath
ListCriteria -> FilePath
(Int -> ListCriteria -> FilePath -> FilePath)
-> (ListCriteria -> FilePath)
-> ([ListCriteria] -> FilePath -> FilePath)
-> Show ListCriteria
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ListCriteria] -> FilePath -> FilePath
$cshowList :: [ListCriteria] -> FilePath -> FilePath
show :: ListCriteria -> FilePath
$cshow :: ListCriteria -> FilePath
showsPrec :: Int -> ListCriteria -> FilePath -> FilePath
$cshowsPrec :: Int -> ListCriteria -> FilePath -> FilePath
Show

-- | A list result describes a single tool version
-- and various of its properties.
data ListResult = ListResult
  { ListResult -> Tool
lTool      :: Tool
  , ListResult -> Version
lVer       :: Version
  , ListResult -> Maybe Text
lCross     :: Maybe Text -- ^ currently only for GHC
  , ListResult -> [Tag]
lTag       :: [Tag]
  , ListResult -> Bool
lInstalled :: Bool
  , ListResult -> Bool
lSet       :: Bool -- ^ currently active version
  , ListResult -> Bool
fromSrc    :: Bool -- ^ compiled from source
  , ListResult -> Bool
lStray     :: Bool -- ^ not in download info
  , ListResult -> Bool
lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
  , ListResult -> Bool
hlsPowered :: Bool
  }
  deriving (ListResult -> ListResult -> Bool
(ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool) -> Eq ListResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListResult -> ListResult -> Bool
$c/= :: ListResult -> ListResult -> Bool
== :: ListResult -> ListResult -> Bool
$c== :: ListResult -> ListResult -> Bool
Eq, Eq ListResult
Eq ListResult
-> (ListResult -> ListResult -> Ordering)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> Bool)
-> (ListResult -> ListResult -> ListResult)
-> (ListResult -> ListResult -> ListResult)
-> Ord ListResult
ListResult -> ListResult -> Bool
ListResult -> ListResult -> Ordering
ListResult -> ListResult -> ListResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListResult -> ListResult -> ListResult
$cmin :: ListResult -> ListResult -> ListResult
max :: ListResult -> ListResult -> ListResult
$cmax :: ListResult -> ListResult -> ListResult
>= :: ListResult -> ListResult -> Bool
$c>= :: ListResult -> ListResult -> Bool
> :: ListResult -> ListResult -> Bool
$c> :: ListResult -> ListResult -> Bool
<= :: ListResult -> ListResult -> Bool
$c<= :: ListResult -> ListResult -> Bool
< :: ListResult -> ListResult -> Bool
$c< :: ListResult -> ListResult -> Bool
compare :: ListResult -> ListResult -> Ordering
$ccompare :: ListResult -> ListResult -> Ordering
$cp1Ord :: Eq ListResult
Ord, Int -> ListResult -> FilePath -> FilePath
[ListResult] -> FilePath -> FilePath
ListResult -> FilePath
(Int -> ListResult -> FilePath -> FilePath)
-> (ListResult -> FilePath)
-> ([ListResult] -> FilePath -> FilePath)
-> Show ListResult
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ListResult] -> FilePath -> FilePath
$cshowList :: [ListResult] -> FilePath -> FilePath
show :: ListResult -> FilePath
$cshow :: ListResult -> FilePath
showsPrec :: Int -> ListResult -> FilePath -> FilePath
$cshowsPrec :: Int -> ListResult -> FilePath -> FilePath
Show)


-- | Extract all available tool versions and their tags.
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
availableToolVersions :: GHCupDownloads -> Tool -> Map Version VersionInfo
availableToolVersions GHCupDownloads
av Tool
tool = Optic' A_Lens '[] GHCupDownloads (Map Version VersionInfo)
-> GHCupDownloads -> Map Version VersionInfo
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  (Index GHCupDownloads
-> Lens' GHCupDownloads (Maybe (IxValue GHCupDownloads))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index GHCupDownloads
Tool
tool Optic
  A_Lens
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe (Map Version VersionInfo))
  (Maybe (Map Version VersionInfo))
-> Optic
     An_Iso
     '[]
     (Maybe (Map Version VersionInfo))
     (Maybe (Map Version VersionInfo))
     (Map Version VersionInfo)
     (Map Version VersionInfo)
-> Optic' A_Lens '[] GHCupDownloads (Map Version VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Map Version VersionInfo
-> Optic
     An_Iso
     '[]
     (Maybe (Map Version VersionInfo))
     (Maybe (Map Version VersionInfo))
     (Map Version VersionInfo)
     (Map Version VersionInfo)
forall a. Eq a => a -> Iso' (Maybe a) a
non Map Version VersionInfo
forall k a. Map k a
Map.empty)
  GHCupDownloads
av


-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: ( MonadCatch m
                , HasLog env
                , MonadThrow m
                , HasLog env
                , MonadIO m
                , MonadReader env m
                , HasDirs env
                , HasPlatformReq env
                , HasGHCupInfo env
                )
             => Maybe Tool
             -> Maybe ListCriteria
             -> m [ListResult]
listVersions :: Maybe Tool -> Maybe ListCriteria -> m [ListResult]
listVersions Maybe Tool
lt' Maybe ListCriteria
criteria = do
  -- some annoying work to avoid too much repeated IO
  Maybe Version
cSet <- m (Maybe Version)
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadIO m,
 MonadThrow m, MonadCatch m) =>
m (Maybe Version)
cabalSet
  [Either FilePath Version]
cabals <- m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledCabals
  Maybe Version
hlsSet' <- m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m (Maybe Version)
hlsSet
  [Either FilePath Version]
hlses <- m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
  Maybe Version
sSet <- m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m, HasLog env) =>
m (Maybe Version)
stackSet
  [Either FilePath Version]
stacks <- m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledStacks

  Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
forall env (m :: * -> *).
(MonadReader env m, MonadIO m, MonadCatch m,
 LabelOptic "dirs" A_Lens env env Dirs Dirs,
 LabelOptic "ghcupInfo" A_Lens env env GHCupInfo GHCupInfo,
 LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
 LabelOptic
   "pfreq" A_Lens env env PlatformRequest PlatformRequest) =>
Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go Maybe Tool
lt' Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
 where
  go :: Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go Maybe Tool
lt Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks = do
    case Maybe Tool
lt of
      Just Tool
t -> do
        GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
        -- get versions from GHCupDownloads
        let avTools :: Map Version VersionInfo
avTools = GHCupDownloads -> Tool -> Map Version VersionInfo
availableToolVersions GHCupDownloads
dls Tool
t
        [ListResult]
lr <- [ListResult] -> [ListResult]
filter' ([ListResult] -> [ListResult]) -> m [ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Version, VersionInfo)]
-> ((Version, VersionInfo) -> m ListResult) -> m [ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Version VersionInfo -> [(Version, VersionInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version VersionInfo
avTools) (Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> (Version, VersionInfo)
-> m ListResult
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, HasGHCupInfo env,
 HasPlatformReq env, MonadIO m, MonadCatch m) =>
Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> (Version, VersionInfo)
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks)

        case Tool
t of
          Tool
GHC -> do
            [ListResult]
slr <- Map Version VersionInfo -> m [ListResult]
forall (m :: * -> *) env.
(MonadCatch m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m) =>
Map Version VersionInfo -> m [ListResult]
strayGHCs Map Version VersionInfo
avTools
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
Cabal -> do
            [ListResult]
slr <- Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadCatch m, MonadThrow m,
 HasLog env, MonadIO m) =>
Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayCabals Map Version VersionInfo
avTools Maybe Version
cSet [Either FilePath Version]
cabals
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
HLS -> do
            [ListResult]
slr <- Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadCatch m, MonadThrow m,
 HasLog env, MonadIO m) =>
Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayHLS Map Version VersionInfo
avTools Maybe Version
hlsSet' [Either FilePath Version]
hlses
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
Stack -> do
            [ListResult]
slr <- Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadCatch m, MonadThrow m,
 HasLog env, MonadIO m) =>
Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayStacks Map Version VersionInfo
avTools Maybe Version
sSet [Either FilePath Version]
stacks
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
slr [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
          Tool
GHCup -> do
            let cg :: [ListResult]
cg = Maybe ListResult -> [ListResult]
forall a. Maybe a -> [a]
maybeToList (Maybe ListResult -> [ListResult])
-> Maybe ListResult -> [ListResult]
forall a b. (a -> b) -> a -> b
$ Map Version VersionInfo -> Maybe ListResult
currentGHCup Map Version VersionInfo
avTools
            [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult] -> [ListResult]
forall a. Ord a => [a] -> [a]
sort ([ListResult]
cg [ListResult] -> [ListResult] -> [ListResult]
forall a. [a] -> [a] -> [a]
++ [ListResult]
lr))
      Maybe Tool
Nothing -> do
        [ListResult]
ghcvers   <- Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC) Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
        [ListResult]
cabalvers <- Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Cabal) Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
        [ListResult]
hlsvers   <- Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
HLS) Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
        [ListResult]
ghcupvers <- Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHCup) Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
        [ListResult]
stackvers <- Maybe Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Stack) Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
sSet [Either FilePath Version]
stacks
        [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ListResult]
ghcvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
cabalvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
hlsvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
stackvers [ListResult] -> [ListResult] -> [ListResult]
forall a. Semigroup a => a -> a -> a
<> [ListResult]
ghcupvers)
  strayGHCs :: ( MonadCatch m
               , MonadReader env m
               , HasDirs env
               , MonadThrow m
               , HasLog env
               , MonadIO m
               )
            => Map.Map Version VersionInfo
            -> m [ListResult]
  strayGHCs :: Map Version VersionInfo -> m [ListResult]
strayGHCs Map Version VersionInfo
avTools = do
    [Either FilePath GHCTargetVersion]
ghcs <- m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either FilePath GHCTargetVersion]
-> (Either FilePath GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either FilePath GHCTargetVersion]
ghcs ((Either FilePath GHCTargetVersion -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either FilePath GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right tver :: GHCTargetVersion
tver@GHCTargetVersion{ $sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
_tvTarget = Maybe Text
Nothing, Version
_tvVersion :: Version
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
.. } -> do
        case Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version VersionInfo
avTools of
          Just VersionInfo
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe VersionInfo
Nothing -> do
            Bool
lSet    <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v ) -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
_tvVersion)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
            Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
            Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
_tvVersion) m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m [Version]
hlsGHCVersions
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
GHC
              , lVer :: Version
lVer       = Version
_tvVersion
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version VersionInfo
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
..
              }
      Right tver :: GHCTargetVersion
tver@GHCTargetVersion{ Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
.. } -> do
        Bool
lSet    <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v ) -> Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
_tvVersion)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
_tvTarget
        Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
        Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
_tvVersion) m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m [Version]
hlsGHCVersions
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
          { lTool :: Tool
lTool      = Tool
GHC
          , lVer :: Version
lVer       = Version
_tvVersion
          , lCross :: Maybe Text
lCross     = Maybe Text
_tvTarget
          , lTag :: [Tag]
lTag       = []
          , lInstalled :: Bool
lInstalled = Bool
True
          , lStray :: Bool
lStray     = Bool
True -- NOTE: cross currently cannot be installed via bindist
          , lNoBindist :: Bool
lNoBindist = Bool
False
          , Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
hlsPowered :: Bool
fromSrc :: Bool
lSet :: Bool
..
          }
      Left FilePath
e -> do
        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
$ Text
"Could not parse version of stray directory" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
e
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  strayCabals :: ( MonadReader env m
                 , HasDirs env
                 , MonadCatch m
                 , MonadThrow m
                 , HasLog env
                 , MonadIO m
                 )
            => Map.Map Version VersionInfo
            -> Maybe Version
            -> [Either FilePath Version]
            -> m [ListResult]
  strayCabals :: Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayCabals Map Version VersionInfo
avTools Maybe Version
cSet [Either FilePath Version]
cabals = do
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version]
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either FilePath Version]
cabals ((Either FilePath Version -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right Version
ver ->
        case Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools of
          Just VersionInfo
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe VersionInfo
Nothing -> do
            let lSet :: Bool
lSet = Maybe Version
cSet Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
Cabal
              , lVer :: Version
lVer       = Version
ver
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , fromSrc :: Bool
fromSrc    = Bool
False -- actually, we don't know :>
              , hlsPowered :: Bool
hlsPowered = Bool
False
              , Bool
lSet :: Bool
lSet :: Bool
..
              }
      Left FilePath
e -> do
        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
$ Text
"Could not parse version of stray directory" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
e
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  strayHLS :: ( MonadReader env m
              , HasDirs env
              , MonadCatch m
              , MonadThrow m
              , HasLog env
              , MonadIO m)
           => Map.Map Version VersionInfo
           -> Maybe Version
           -> [Either FilePath Version]
           -> m [ListResult]
  strayHLS :: Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayHLS Map Version VersionInfo
avTools Maybe Version
hlsSet' [Either FilePath Version]
hlss = do
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version]
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either FilePath Version]
hlss ((Either FilePath Version -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right Version
ver ->
        case Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools of
          Just VersionInfo
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe VersionInfo
Nothing -> do
            let lSet :: Bool
lSet = Maybe Version
hlsSet' Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
HLS
              , lVer :: Version
lVer       = Version
ver
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , fromSrc :: Bool
fromSrc    = Bool
False -- actually, we don't know :>
              , hlsPowered :: Bool
hlsPowered = Bool
False
              , Bool
lSet :: Bool
lSet :: Bool
..
              }
      Left FilePath
e -> do
        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
$ Text
"Could not parse version of stray directory" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
e
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  strayStacks :: ( MonadReader env m
                 , HasDirs env
                 , MonadCatch m
                 , MonadThrow m
                 , HasLog env
                 , MonadIO m
                 )
              => Map.Map Version VersionInfo
              -> Maybe Version
              -> [Either FilePath Version]
              -> m [ListResult]
  strayStacks :: Map Version VersionInfo
-> Maybe Version -> [Either FilePath Version] -> m [ListResult]
strayStacks Map Version VersionInfo
avTools Maybe Version
stackSet' [Either FilePath Version]
stacks = do
    ([Maybe ListResult] -> [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe ListResult] -> [ListResult]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe ListResult] -> m [ListResult])
-> m [Maybe ListResult] -> m [ListResult]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version]
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Either FilePath Version]
stacks ((Either FilePath Version -> m (Maybe ListResult))
 -> m [Maybe ListResult])
-> (Either FilePath Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
      Right Version
ver ->
        case Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools of
          Just VersionInfo
_  -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
          Maybe VersionInfo
Nothing -> do
            let lSet :: Bool
lSet = Maybe Version
stackSet' Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver
            Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ListResult -> m (Maybe ListResult))
-> Maybe ListResult -> m (Maybe ListResult)
forall a b. (a -> b) -> a -> b
$ ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult
              { lTool :: Tool
lTool      = Tool
Stack
              , lVer :: Version
lVer       = Version
ver
              , lCross :: Maybe Text
lCross     = Maybe Text
forall a. Maybe a
Nothing
              , lTag :: [Tag]
lTag       = []
              , lInstalled :: Bool
lInstalled = Bool
True
              , lStray :: Bool
lStray     = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version VersionInfo
avTools)
              , lNoBindist :: Bool
lNoBindist = Bool
False
              , fromSrc :: Bool
fromSrc    = Bool
False -- actually, we don't know :>
              , hlsPowered :: Bool
hlsPowered = Bool
False
              , Bool
lSet :: Bool
lSet :: Bool
..
              }
      Left FilePath
e -> do
        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
$ Text
"Could not parse version of stray directory" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
e
        Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing

  currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
  currentGHCup :: Map Version VersionInfo -> Maybe ListResult
currentGHCup Map Version VersionInfo
av =
    let currentVer :: Version
currentVer = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ PVP -> Text -> Maybe Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
ghcUpVer Text
""
        listVer :: Maybe VersionInfo
listVer    = Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
currentVer Map Version VersionInfo
av
        latestVer :: Maybe Version
latestVer  = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Map Version VersionInfo -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Tag
-> Optic'
     A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Latest) Map Version VersionInfo
av
        recommendedVer :: Maybe Version
recommendedVer = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Map Version VersionInfo -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Tag
-> Optic'
     A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Latest) Map Version VersionInfo
av
        isOld :: Bool
isOld  = Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
currentVer) Maybe Version
latestVer Bool -> Bool -> Bool
&& Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
currentVer) Maybe Version
recommendedVer
    in if | Version -> Map Version VersionInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Version
currentVer Map Version VersionInfo
av -> Maybe ListResult
forall a. Maybe a
Nothing
          | Bool
otherwise -> ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
currentVer
                                           , lTag :: [Tag]
lTag    = [Tag] -> (VersionInfo -> [Tag]) -> Maybe VersionInfo -> [Tag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Bool
isOld then [Tag
Old] else []) VersionInfo -> [Tag]
_viTags Maybe VersionInfo
listVer
                                           , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                                           , lTool :: Tool
lTool   = Tool
GHCup
                                           , fromSrc :: Bool
fromSrc = Bool
False
                                           , lStray :: Bool
lStray  = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe VersionInfo
listVer
                                           , lSet :: Bool
lSet    = Bool
True
                                           , lInstalled :: Bool
lInstalled = Bool
True
                                           , lNoBindist :: Bool
lNoBindist = Bool
False
                                           , hlsPowered :: Bool
hlsPowered = Bool
False
                                           }

  -- NOTE: this are not cross ones, because no bindists
  toListResult :: ( HasLog env
                  , MonadReader env m
                  , HasDirs env
                  , HasGHCupInfo env
                  , HasPlatformReq env
                  , MonadIO m
                  , MonadCatch m
                  )
               => Tool
               -> Maybe Version
               -> [Either FilePath Version]
               -> Maybe Version
               -> [Either FilePath Version]
               -> Maybe Version
               -> [Either FilePath Version]
               -> (Version, VersionInfo)
               -> m ListResult
  toListResult :: Tool
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> Maybe Version
-> [Either FilePath Version]
-> (Version, VersionInfo)
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either FilePath Version]
cabals Maybe Version
hlsSet' [Either FilePath Version]
hlses Maybe Version
stackSet' [Either FilePath Version]
stacks (Version
v, VersionInfo -> [Tag]
_viTags -> [Tag]
tags) = do
    case Tool
t of
      Tool
GHC -> do
        Bool
lNoBindist <- (VEither '[NoDownload] DownloadInfo -> Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (V '[NoDownload]) DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either (V '[NoDownload]) DownloadInfo -> Bool)
-> (VEither '[NoDownload] DownloadInfo
    -> Either (V '[NoDownload]) DownloadInfo)
-> VEither '[NoDownload] DownloadInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither '[NoDownload] DownloadInfo
-> Either (V '[NoDownload]) DownloadInfo
forall (es :: [*]) a. VEither es a -> Either (V es) a
veitherToEither) (m (VEither '[NoDownload] DownloadInfo) -> m Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
forall a (m :: * -> *).
Excepts '[NoDownload] m a -> m (VEither '[NoDownload] a)
runE @'[NoDownload] (Excepts '[NoDownload] m DownloadInfo
 -> m (VEither '[NoDownload] DownloadInfo))
-> Excepts '[NoDownload] m DownloadInfo
-> m (VEither '[NoDownload] 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
GHC Version
v
        let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
v
        Bool
lSet       <- (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
-> (GHCTargetVersion -> Bool) -> Maybe GHCTargetVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\(GHCTargetVersion Maybe Text
_ Version
v') -> Version
v' Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v)) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
        Bool
lInstalled <- GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver
        Bool
fromSrc    <- GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
tver
        Bool
hlsPowered <- ([Version] -> Bool) -> m [Version] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v) m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
m [Version]
hlsGHCVersions
        ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer = Version
v, lCross :: Maybe Text
lCross = Maybe Text
forall a. Maybe a
Nothing , lTag :: [Tag]
lTag = [Tag]
tags, lTool :: Tool
lTool = Tool
t, lStray :: Bool
lStray = Bool
False, Bool
hlsPowered :: Bool
fromSrc :: Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
hlsPowered :: Bool
lNoBindist :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
.. }
      Tool
Cabal -> do
        Bool
lNoBindist <- (VEither '[NoDownload] DownloadInfo -> Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (V '[NoDownload]) DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either (V '[NoDownload]) DownloadInfo -> Bool)
-> (VEither '[NoDownload] DownloadInfo
    -> Either (V '[NoDownload]) DownloadInfo)
-> VEither '[NoDownload] DownloadInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither '[NoDownload] DownloadInfo
-> Either (V '[NoDownload]) DownloadInfo
forall (es :: [*]) a. VEither es a -> Either (V es) a
veitherToEither) (m (VEither '[NoDownload] DownloadInfo) -> m Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
forall a (m :: * -> *).
Excepts '[NoDownload] m a -> m (VEither '[NoDownload] a)
runE @'[NoDownload] (Excepts '[NoDownload] m DownloadInfo
 -> m (VEither '[NoDownload] DownloadInfo))
-> Excepts '[NoDownload] m DownloadInfo
-> m (VEither '[NoDownload] DownloadInfo)
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Cabal Version
v
        let lSet :: Bool
lSet = Maybe Version
cSet Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
        let lInstalled :: Bool
lInstalled = Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v ([Version] -> Bool) -> [Version] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either FilePath Version]
cabals
        ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                        , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                        , lTag :: [Tag]
lTag    = [Tag]
tags
                        , lTool :: Tool
lTool   = Tool
t
                        , fromSrc :: Bool
fromSrc = Bool
False
                        , lStray :: Bool
lStray  = Bool
False
                        , hlsPowered :: Bool
hlsPowered = Bool
False
                        , Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
lNoBindist :: Bool
lSet :: Bool
lInstalled :: Bool
..
                        }
      Tool
GHCup -> do
        let lSet :: Bool
lSet       = PVP -> Text
prettyPVP PVP
ghcUpVer Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Text
prettyVer Version
v
        let lInstalled :: Bool
lInstalled = Bool
lSet
        ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                        , lTag :: [Tag]
lTag    = [Tag]
tags
                        , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                        , lTool :: Tool
lTool   = Tool
t
                        , fromSrc :: Bool
fromSrc = Bool
False
                        , lStray :: Bool
lStray  = Bool
False
                        , lNoBindist :: Bool
lNoBindist = Bool
False
                        , hlsPowered :: Bool
hlsPowered = Bool
False
                        , Bool
lInstalled :: Bool
lSet :: Bool
lSet :: Bool
lInstalled :: Bool
..
                        }
      Tool
HLS -> do
        Bool
lNoBindist <- (VEither '[NoDownload] DownloadInfo -> Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (V '[NoDownload]) DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either (V '[NoDownload]) DownloadInfo -> Bool)
-> (VEither '[NoDownload] DownloadInfo
    -> Either (V '[NoDownload]) DownloadInfo)
-> VEither '[NoDownload] DownloadInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither '[NoDownload] DownloadInfo
-> Either (V '[NoDownload]) DownloadInfo
forall (es :: [*]) a. VEither es a -> Either (V es) a
veitherToEither) (m (VEither '[NoDownload] DownloadInfo) -> m Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
forall a (m :: * -> *).
Excepts '[NoDownload] m a -> m (VEither '[NoDownload] a)
runE @'[NoDownload] (Excepts '[NoDownload] m DownloadInfo
 -> m (VEither '[NoDownload] DownloadInfo))
-> Excepts '[NoDownload] m DownloadInfo
-> m (VEither '[NoDownload] 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
v
        let lSet :: Bool
lSet = Maybe Version
hlsSet' Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
        let lInstalled :: Bool
lInstalled = Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v ([Version] -> Bool) -> [Version] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either FilePath Version]
hlses
        ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                        , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                        , lTag :: [Tag]
lTag    = [Tag]
tags
                        , lTool :: Tool
lTool   = Tool
t
                        , fromSrc :: Bool
fromSrc = Bool
False
                        , lStray :: Bool
lStray  = Bool
False
                        , hlsPowered :: Bool
hlsPowered = Bool
False
                        , Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
lNoBindist :: Bool
lSet :: Bool
lInstalled :: Bool
..
                        }
      Tool
Stack -> do
        Bool
lNoBindist <- (VEither '[NoDownload] DownloadInfo -> Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (V '[NoDownload]) DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either (V '[NoDownload]) DownloadInfo -> Bool)
-> (VEither '[NoDownload] DownloadInfo
    -> Either (V '[NoDownload]) DownloadInfo)
-> VEither '[NoDownload] DownloadInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither '[NoDownload] DownloadInfo
-> Either (V '[NoDownload]) DownloadInfo
forall (es :: [*]) a. VEither es a -> Either (V es) a
veitherToEither) (m (VEither '[NoDownload] DownloadInfo) -> m Bool)
-> m (VEither '[NoDownload] DownloadInfo) -> m Bool
forall a b. (a -> b) -> a -> b
$ forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
forall a (m :: * -> *).
Excepts '[NoDownload] m a -> m (VEither '[NoDownload] a)
runE @'[NoDownload] (Excepts '[NoDownload] m DownloadInfo
 -> m (VEither '[NoDownload] DownloadInfo))
-> Excepts '[NoDownload] m DownloadInfo
-> m (VEither '[NoDownload] 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
Stack Version
v
        let lSet :: Bool
lSet = Maybe Version
stackSet' Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
        let lInstalled :: Bool
lInstalled = Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
v ([Version] -> Bool) -> [Version] -> Bool
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either FilePath Version]
stacks
        ListResult -> m ListResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer    = Version
v
                        , lCross :: Maybe Text
lCross  = Maybe Text
forall a. Maybe a
Nothing
                        , lTag :: [Tag]
lTag    = [Tag]
tags
                        , lTool :: Tool
lTool   = Tool
t
                        , fromSrc :: Bool
fromSrc = Bool
False
                        , lStray :: Bool
lStray  = Bool
False
                        , hlsPowered :: Bool
hlsPowered = Bool
False
                        , Bool
lInstalled :: Bool
lSet :: Bool
lNoBindist :: Bool
lNoBindist :: Bool
lSet :: Bool
lInstalled :: Bool
..
                        }


  filter' :: [ListResult] -> [ListResult]
  filter' :: [ListResult] -> [ListResult]
filter' [ListResult]
lr = case Maybe ListCriteria
criteria of
    Maybe ListCriteria
Nothing            -> [ListResult]
lr
    Just ListCriteria
ListInstalled -> (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult {Bool
[Tag]
Maybe Text
Version
Tool
hlsPowered :: Bool
lNoBindist :: Bool
lStray :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
lTag :: [Tag]
lCross :: Maybe Text
lVer :: Version
lTool :: Tool
hlsPowered :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lStray :: ListResult -> Bool
fromSrc :: ListResult -> Bool
lSet :: ListResult -> Bool
lInstalled :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lCross :: ListResult -> Maybe Text
lVer :: ListResult -> Version
lTool :: ListResult -> Tool
..} -> Bool
lInstalled) [ListResult]
lr
    Just ListCriteria
ListSet       -> (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult {Bool
[Tag]
Maybe Text
Version
Tool
hlsPowered :: Bool
lNoBindist :: Bool
lStray :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
lTag :: [Tag]
lCross :: Maybe Text
lVer :: Version
lTool :: Tool
hlsPowered :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lStray :: ListResult -> Bool
fromSrc :: ListResult -> Bool
lSet :: ListResult -> Bool
lInstalled :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lCross :: ListResult -> Maybe Text
lVer :: ListResult -> Version
lTool :: ListResult -> Tool
..} -> Bool
lSet) [ListResult]
lr
    Just ListCriteria
ListAvailable -> (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult {Bool
[Tag]
Maybe Text
Version
Tool
hlsPowered :: Bool
lNoBindist :: Bool
lStray :: Bool
fromSrc :: Bool
lSet :: Bool
lInstalled :: Bool
lTag :: [Tag]
lCross :: Maybe Text
lVer :: Version
lTool :: Tool
hlsPowered :: ListResult -> Bool
lNoBindist :: ListResult -> Bool
lStray :: ListResult -> Bool
fromSrc :: ListResult -> Bool
lSet :: ListResult -> Bool
lInstalled :: ListResult -> Bool
lTag :: ListResult -> [Tag]
lCross :: ListResult -> Maybe Text
lVer :: ListResult -> Version
lTool :: ListResult -> Tool
..} -> Bool -> Bool
not Bool
lNoBindist) [ListResult]
lr



    --------------------
    --[ GHC/cabal rm ]--
    --------------------


-- | Delete a ghc version and all its symlinks.
--
-- This may leave GHCup without a "set" version.
-- Will try to fix the ghc-x.y symlink after removal (e.g. to an
-- older version).
rmGHCVer :: ( MonadReader env m
            , HasDirs env
            , MonadThrow m
            , HasLog env
            , MonadIO m
            , MonadFail m
            , MonadCatch m
            , MonadMask m
            , MonadUnliftIO m
            )
         => GHCTargetVersion
         -> Excepts '[NotInstalled] m ()
rmGHCVer :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ver = do
  Bool
isSetGHC <- 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
$ (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
ver) (m (Maybe GHCTargetVersion) -> m Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)

  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver) (NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))
  FilePath
dir <- 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
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver

  -- this isn't atomic, order matters
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    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 ()
logInfo Text
"Removing ghc symlinks"
    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
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)

  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 ()
logInfo Text
"Removing ghc-x.y.z symlinks"
  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
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks GHCTargetVersion
ver

  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 ()
logInfo Text
"Removing/rewiring ghc-x.y symlinks"
  -- first remove
  (ParseError -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
_ :: ParseError) -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ 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
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks GHCTargetVersion
ver
  -- then fix them (e.g. with an earlier version)

  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 ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing directory recursively: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir
  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 -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
dir

  Maybe (Int, Int)
v' <-
    (ParseError -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
      (\(ParseError
e :: ParseError) -> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Int, Int))
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
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 (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int)
forall a. Maybe a
Nothing)
    (Excepts '[NotInstalled] m (Maybe (Int, Int))
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just
    (Excepts '[NotInstalled] m (Int, Int)
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  Maybe (Int, Int)
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Int, Int)
v' (((Int, Int) -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP (NonEmpty Word -> PVP
PVP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mj Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mi])) (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver))
    Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe FilePath
forall a. Maybe a
Nothing)

  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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

  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
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
rmDirectoryLink (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"share")


-- | Delete a cabal version. Will try to fix the @cabal@ symlink
-- after removal (e.g. setting it to an older version).
rmCabalVer :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadThrow m
              , HasLog env
              , MonadIO m
              , MonadFail m
              , MonadCatch m
              , MonadUnliftIO m
              )
           => Version
           -> Excepts '[NotInstalled] m ()
rmCabalVer :: Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

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

  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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

  let cabalFile :: FilePath
cabalFile = FilePath
"cabal-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
cabalFile)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
cSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    [Version]
cVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledCabals
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
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]
cVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
latestver
      Maybe Version
Nothing        -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)


-- | 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] m ()
rmHLSVer :: Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

  Maybe Version
isHlsSet <- m (Maybe Version) -> Excepts '[NotInstalled] 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] 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
  FilePath
hlsDir <- Version -> Excepts '[NotInstalled] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
  FilePath -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
hlsDir

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    -- delete all set symlinks
    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
    -- set latest hls
    [Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (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 -> 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] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Delete a stack version. Will try to fix the @stack@ symlink
-- after removal (e.g. setting it to an older version).
rmStackVer :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , MonadThrow m
              , HasLog env
              , MonadIO m
              , MonadFail m
              , MonadCatch m
              , MonadUnliftIO m
              )
           => Version
           -> Excepts '[NotInstalled] m ()
rmStackVer :: Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
ver = do
  Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))

  Maybe Version
sSet      <- m (Maybe Version) -> Excepts '[NotInstalled] 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, HasLog env) =>
m (Maybe Version)
stackSet

  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- 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

  let stackFile :: FilePath
stackFile = FilePath
"stack-" 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
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
stackFile)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
sSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    [Version]
sVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (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]
getInstalledStacks
    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]
sVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
latestver
      Maybe Version
Nothing        -> 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 -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)


-- assuming the current scheme of having just 1 ghcup bin, no version info is required.
rmGhcup :: ( MonadReader env m
           , HasDirs env
           , MonadIO m
           , MonadCatch m
           , HasLog env
           , MonadMask m
           , MonadUnliftIO m
           )
        => m ()
rmGhcup :: m ()
rmGhcup = do
  Dirs { FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
.. } <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let ghcupFilename :: FilePath
ghcupFilename = FilePath
"ghcup" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  let ghcupFilepath :: FilePath
ghcupFilepath = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
ghcupFilename

  FilePath
currentRunningExecPath <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath

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

  FilePath
p1 <- IOErrorType
-> (IOException -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
                  (FilePath -> IOException -> m FilePath
forall (m :: * -> *) env p.
(MonadReader env m,
 LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
 MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
currentRunningExecPath)
                  (IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath)

  FilePath
p2 <- IOErrorType
-> (IOException -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
                  (FilePath -> IOException -> m FilePath
forall (m :: * -> *) env p.
(MonadReader env m,
 LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
 MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
ghcupFilepath)
                  (IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
ghcupFilepath)

  let areEqualPaths :: Bool
areEqualPaths = FilePath -> FilePath -> Bool
equalFilePath FilePath
p1 FilePath
p2

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
areEqualPaths (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
nonStandardInstallLocationMsg FilePath
currentRunningExecPath

  if Bool
isWindows
  then do
    -- since it doesn't seem possible to delete a running exe on windows
    -- we move it to temp dir, to be deleted at next reboot
    FilePath
tempFilepath <- m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
    IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
UnsupportedOperation (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              FilePath -> FilePath -> IO ()
moveFile FilePath
ghcupFilepath (FilePath
tempFilepath FilePath -> FilePath -> FilePath
</> FilePath
"ghcup")
  else
    -- delete it.
    IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
ghcupFilepath

  where
    handlePathNotPresent :: FilePath -> p -> m FilePath
handlePathNotPresent FilePath
fp p
_err = do
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: The path does not exist, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fp
      FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fp

    nonStandardInstallLocationMsg :: FilePath -> Text
nonStandardInstallLocationMsg FilePath
path = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
      FilePath
"current ghcup is invoked from a non-standard location: \n"
      FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
      FilePath
"\n you may have to uninstall it manually."

rmTool :: ( MonadReader env m
          , HasDirs env
          , HasLog env
          , MonadFail m
          , MonadMask m
          , MonadUnliftIO m)
          => ListResult
          -> Excepts '[NotInstalled ] m ()
rmTool :: ListResult -> Excepts '[NotInstalled] m ()
rmTool ListResult {Version
lVer :: Version
lVer :: ListResult -> Version
lVer, Tool
lTool :: Tool
lTool :: ListResult -> Tool
lTool, Maybe Text
lCross :: Maybe Text
lCross :: ListResult -> Maybe Text
lCross} = do
  case Tool
lTool of
    Tool
GHC ->
      let ghcTargetVersion :: GHCTargetVersion
ghcTargetVersion = Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
lCross Version
lVer
      in GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
 MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ghcTargetVersion
    Tool
HLS -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
lVer
    Tool
Cabal -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
lVer
    Tool
Stack -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
lVer
    Tool
GHCup -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m,
 HasLog env, MonadMask m, MonadUnliftIO m) =>
m ()
rmGhcup


rmGhcupDirs :: ( MonadReader env m
               , HasDirs env
               , MonadIO m
               , HasLog env
               , MonadCatch m
               , MonadMask m )
            => m [FilePath]
rmGhcupDirs :: m [FilePath]
rmGhcupDirs = do
  Dirs
    { FilePath
baseDir :: FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
baseDir
    , FilePath
binDir :: FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
binDir
    , FilePath
logsDir :: FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
logsDir
    , FilePath
cacheDir :: FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
cacheDir
    , FilePath
recycleDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
recycleDir
    } <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  let envFilePath :: FilePath
envFilePath = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"env"

  FilePath
confFilePath <- m FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getConfigFilePath

  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmEnvFile  FilePath
envFilePath
  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmConfFile FilePath
confFilePath

  -- for xdg dirs, the order matters here
  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
logsDir
  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
cacheDir

  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
rmBinDir FilePath
binDir
  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
recycleDir
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWindows (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"removing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"msys64")
    m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"msys64")

  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
removeEmptyDirsRecursive FilePath
baseDir

  -- report files in baseDir that are left-over after
  -- the standard location deletions above
  [IOErrorType] -> [FilePath] -> m [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] [] (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> m [FilePath]
forall (m :: * -> *). MonadIO m => FilePath -> m [FilePath]
reportRemainingFiles FilePath
baseDir

  where
    handleRm :: (MonadReader env m, MonadCatch m, HasLog env, MonadIO m)  => m () -> m ()
    handleRm :: m () -> m ()
handleRm = (IOException -> m ()) -> m () -> m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Part of the cleanup action failed with error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"continuing regardless...")

    rmEnvFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    rmEnvFile :: FilePath -> m ()
rmEnvFile FilePath
enFilePath = do
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing Ghcup Environment File"
      [IOErrorType] -> () -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
permissionErrorType] () (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m) =>
FilePath -> m ()
deleteFile FilePath
enFilePath

    rmConfFile :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    rmConfFile :: FilePath -> m ()
rmConfFile FilePath
confFilePath = do
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"removing Ghcup Config File"
      [IOErrorType] -> () -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
permissionErrorType] () (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m) =>
FilePath -> m ()
deleteFile FilePath
confFilePath

    rmDir :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    rmDir :: FilePath -> m ()
rmDir FilePath
dir =
      -- 'getDirectoryContentsRecursive' is lazy IO. In case
      -- an error leaks through, we catch it here as well,
      -- althought 'deleteFile' should already handle it.
      [IOErrorType] -> () -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] () (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"removing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir
        [FilePath]
contents <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
dir
        [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents (FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m) =>
FilePath -> m ()
deleteFile (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>))

    rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    rmBinDir :: FilePath -> m ()
rmBinDir FilePath
binDir
      | Bool
isWindows = FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
      | Bool
otherwise = do
          Bool
isXDGStyle <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
useXDG
          if Bool -> Bool
not Bool
isXDGStyle
            then FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
            else () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
    reportRemainingFiles :: FilePath -> m [FilePath]
reportRemainingFiles FilePath
dir = do
      -- force the files so the errors don't leak
      ([FilePath] -> [FilePath]
forall a. NFData a => a -> a
force -> ![FilePath]
remainingFiles) <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
dir IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall a. a -> IO a
evaluate)
      let normalizedFilePaths :: [FilePath]
normalizedFilePaths = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
normalise [FilePath]
remainingFiles
      let sortedByDepthRemainingFiles :: [FilePath]
sortedByDepthRemainingFiles = (FilePath -> FilePath -> Ordering) -> [FilePath] -> [FilePath]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((FilePath -> FilePath -> Ordering)
-> FilePath -> FilePath -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Ordering
compareFn) [FilePath]
normalizedFilePaths
      let remainingFilesAbsolute :: [FilePath]
remainingFilesAbsolute = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
dir FilePath -> FilePath -> FilePath
</>) [FilePath]
sortedByDepthRemainingFiles

      [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
remainingFilesAbsolute

      where
        calcDepth :: FilePath -> Int
        calcDepth :: FilePath -> Int
calcDepth = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> (FilePath -> FilePath) -> FilePath -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isPathSeparator

        compareFn :: FilePath -> FilePath -> Ordering
        compareFn :: FilePath -> FilePath -> Ordering
compareFn FilePath
fp1 FilePath
fp2 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FilePath -> Int
calcDepth FilePath
fp1) (FilePath -> Int
calcDepth FilePath
fp2)

    removeEmptyDirsRecursive :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    removeEmptyDirsRecursive :: FilePath -> m ()
removeEmptyDirsRecursive FilePath
fp = do
      [FilePath]
cs <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
fp IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
fp FilePath -> FilePath -> FilePath
</>)
      [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
cs FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
removeEmptyDirsRecursive
      IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
InappropriateType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
fp


    -- we expect only files inside cache/log dir
    -- we report remaining files/dirs later,
    -- hence the force/quiet mode in these delete functions below.

    deleteFile :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m) => FilePath -> m ()
    deleteFile :: FilePath -> m ()
deleteFile FilePath
filepath = do
      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
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
InappropriateType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
filepath

    removeDirIfEmptyOrIsSymlink :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
    removeDirIfEmptyOrIsSymlink :: FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
filepath =
      IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
UnsatisfiedConstraints (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      IOErrorType -> (IOException -> m ()) -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
InappropriateType
            (FilePath -> IOException -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m,
 LabelOptic "dirs" A_Lens env env Dirs Dirs, MonadMask m) =>
FilePath -> IOException -> m ()
handleIfSym FilePath
filepath)
            (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmDirectory FilePath
filepath)
      where
        handleIfSym :: FilePath -> IOException -> m ()
handleIfSym FilePath
fp IOException
e = do
          Bool
isSym <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
pathIsSymbolicLink FilePath
fp
          if Bool
isSym
          then FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m) =>
FilePath -> m ()
deleteFile FilePath
fp
          else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e



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


getDebugInfo :: ( Alternative m
                , MonadFail m
                , MonadReader env m
                , HasDirs env
                , HasLog env
                , MonadCatch m
                , MonadIO m
                )
             => Excepts
                  '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
                  m
                  DebugInfo
getDebugInfo :: Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  m
  DebugInfo
getDebugInfo = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  let diBaseDir :: FilePath
diBaseDir  = FilePath
baseDir
  let diBinDir :: FilePath
diBinDir   = FilePath
binDir
  FilePath
diGHCDir       <- m FilePath
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m FilePath
ghcupGHCBaseDir
  let diCacheDir :: FilePath
diCacheDir = FilePath
cacheDir
  Architecture
diArch         <- Either NoCompatibleArch Architecture
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     Architecture
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE Either NoCompatibleArch Architecture
getArchitecture
  PlatformResult
diPlatform     <- Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     PlatformResult
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall (m :: * -> *) env.
(Alternative m, MonadReader env m, HasLog env, MonadCatch m,
 MonadIO m, MonadFail m) =>
Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
getPlatform
  DebugInfo
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     DebugInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DebugInfo
 -> Excepts
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      m
      DebugInfo)
-> DebugInfo
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     m
     DebugInfo
forall a b. (a -> b) -> a -> b
$ DebugInfo :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> Architecture
-> PlatformResult
-> DebugInfo
DebugInfo { FilePath
PlatformResult
Architecture
$sel:diPlatform:DebugInfo :: PlatformResult
$sel:diArch:DebugInfo :: Architecture
$sel:diCacheDir:DebugInfo :: FilePath
$sel:diGHCDir:DebugInfo :: FilePath
$sel:diBinDir:DebugInfo :: FilePath
$sel:diBaseDir:DebugInfo :: FilePath
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: FilePath
diGHCDir :: FilePath
diBinDir :: FilePath
diBaseDir :: FilePath
.. }




    ---------------
    --[ Compile ]--
    ---------------


-- | Compile a GHC from source. This behaves wrt symlinks and installation
-- the same as 'installGHCBin'.
compileGHC :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , HasPlatformReq env
              , HasGHCupInfo env
              , HasSettings env
              , MonadThrow m
              , MonadResource m
              , HasLog env
              , MonadIO m
              , MonadUnliftIO m
              , MonadFail m
              )
           => Either GHCTargetVersion GitBranch          -- ^ version to install
           -> Maybe Version            -- ^ overwrite version
           -> Either Version FilePath  -- ^ version to bootstrap with
           -> Maybe Int                -- ^ jobs
           -> Maybe FilePath           -- ^ build config
           -> Maybe (Either FilePath [URI])  -- ^ patches
           -> [Text]                   -- ^ additional args to ./configure
           -> Maybe String             -- ^ build flavour
           -> Bool
           -> InstallDir
           -> Excepts
                '[ AlreadyInstalled
                 , BuildFailed
                 , DigestError
                 , GPGError
                 , DownloadFailed
                 , GHCupSetError
                 , NoDownload
                 , NotFoundInPATH
                 , PatchFailed
                 , UnknownArchive
                 , TarDirDoesNotExist
                 , NotInstalled
                 , DirNotEmpty
                 , ArchiveResult
                 , FileDoesNotExistError
                 , HadrianNotFound
                 , InvalidBuildConfig
                 , ProcessError
                 , CopyError
                 , BuildFailed
                 ]
                m
                GHCTargetVersion
compileGHC :: Either GHCTargetVersion GitBranch
-> Maybe Version
-> Either Version FilePath
-> Maybe Int
-> Maybe FilePath
-> Maybe (Either FilePath [URI])
-> [Text]
-> Maybe FilePath
-> Bool
-> InstallDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     GHCTargetVersion
compileGHC Either GHCTargetVersion GitBranch
targetGhc Maybe Version
ov Either Version FilePath
bstrap Maybe Int
jobs Maybe FilePath
mbuildConfig Maybe (Either FilePath [URI])
patches [Text]
aargs Maybe FilePath
buildFlavour Bool
hadrian InstallDir
installDir
  = 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
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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

    (FilePath
workdir, FilePath
tmpUnpack, GHCTargetVersion
tver) <- case Either GHCTargetVersion GitBranch
targetGhc of
      -- unpack from version tarball
      Left GHCTargetVersion
tver -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
<> GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text)
-> (FilePath -> Text) -> Either Version FilePath -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Text
prettyVer FilePath -> Text
T.pack Either Version FilePath
bstrap

        -- 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
GHC 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 (GHCTargetVersion
tver GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion) 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
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
        FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
        Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] 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) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
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 FilePath
tmpUnpack FilePath
dl)
        Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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 FilePath
tmpUnpack

        FilePath
workdir <- Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
    DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
    PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
    DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
    InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
           PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
           DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
           InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
                         (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
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)
        Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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 FilePath
workdir

        (FilePath, FilePath, GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (FilePath, FilePath, GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
workdir, FilePath
tmpUnpack, GHCTargetVersion
tver)

      -- clone from git
      Right GitBranch{FilePath
Maybe FilePath
repo :: Maybe FilePath
ref :: FilePath
$sel:repo:GitBranch :: GitBranch -> Maybe FilePath
$sel:ref:GitBranch :: GitBranch -> FilePath
..} -> do
        FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
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
tmpUnpack) FilePath
"git" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
        Version
tver <- (V '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
     DownloadFailed, GPGError]
 -> DownloadFailed)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Version
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] V '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
    DownloadFailed, GPGError]
-> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
 Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts
   '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
     DownloadFailed, GPGError]
   m
   Version
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      Version)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Version
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://gitlab.haskell.org/ghc/ghc.git" Maybe FilePath
repo
          m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     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
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"init" ]
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     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 ]

          let fetch_args :: [FilePath]
fetch_args =
                    [ FilePath
"fetch"
                    , FilePath
"--depth"
                    , FilePath
"1"
                    , FilePath
"--quiet"
                    , FilePath
"origin"
                    , FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [FilePath]
fetch_args

          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"checkout", FilePath
"FETCH_HEAD" ]
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"submodule", FilePath
"update", FilePath
"--init", FilePath
"--depth", FilePath
"1" ]
          Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     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
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     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 FilePath
tmpUnpack
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"python3" [FilePath
"./boot"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"ghc-bootstrap"
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"sh" [FilePath
"./configure"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"ghc-bootstrap"
          CapturedProcess {ByteString
ExitCode
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
$sel:_stdOut:CapturedProcess :: CapturedProcess -> ByteString
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
_stdErr :: ByteString
_stdOut :: ByteString
_exitCode :: ExitCode
..} <- m CapturedProcess
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     CapturedProcess
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      CapturedProcess)
-> m CapturedProcess
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     CapturedProcess
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m CapturedProcess
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
[FilePath] -> Maybe FilePath -> m CapturedProcess
makeOut
            [FilePath
"show!", FilePath
"--quiet", FilePath
"VALUE=ProjectVersion" ] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack)
          case ExitCode
_exitCode of
            ExitCode
ExitSuccess -> Either (ParseErrorBundle Text Void) Version
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) Version
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      Version)
-> (ByteString -> Either (ParseErrorBundle Text Void) Version)
-> ByteString
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
ghcProjectVersion FilePath
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        DownloadFailed, GPGError]
      m
      Version)
-> ByteString
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut
            ExitFailure Int
c -> FilePath
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       DownloadFailed, GPGError]
     m
     Version
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Could not figure out GHC project version. Exit code was: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
". Error was: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (ByteString -> Text
decUTF8Safe' ByteString
_stdErr))

        Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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 FilePath
tmpUnpack
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
"Git version " 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
" corresponds to GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

        (FilePath, FilePath, GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (FilePath, FilePath, GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
tmpUnpack, FilePath
tmpUnpack, Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
tver)
    -- the version that's installed may differ from the
    -- compiled version, so the user can overwrite it
    let installVer :: GHCTargetVersion
installVer = GHCTargetVersion
-> (Version -> GHCTargetVersion)
-> Maybe Version
-> GHCTargetVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GHCTargetVersion
tver (\Version
ov' -> GHCTargetVersion
tver { $sel:_tvVersion:GHCTargetVersion :: Version
_tvVersion = Version
ov' }) Maybe Version
ov

    Bool
alreadyInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
installVer
    Bool
alreadySet <- (Maybe GHCTargetVersion -> Bool)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
installVer) (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
     InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
   m
   (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      Bool)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      (Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
installVer)

    Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
     InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
      case InstallDir
installDir of
        IsolateDir FilePath
isoDir ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Isolate installing to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
        InstallDir
GHCupInternal ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Will overwrite existing version."
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
"...waiting for 10 seconds before continuing, you can still abort..."
      IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
10000000 -- give the user a sec to intervene

    InstallDirResolved
ghcdir <- case InstallDir
installDir of
      IsolateDir FilePath
isoDir -> InstallDirResolved
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     InstallDirResolved
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallDirResolved
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      InstallDirResolved)
-> InstallDirResolved
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     InstallDirResolved
forall a b. (a -> b) -> a -> b
$ FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir
      InstallDir
GHCupInternal -> FilePath -> InstallDirResolved
GHCupDir (FilePath -> InstallDirResolved)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     InstallDirResolved
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
installVer)

    (Maybe FilePath
mBindist, ByteString
bmk) <- Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, CopyError]
  m
  (Maybe FilePath, ByteString)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe FilePath, ByteString)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
     PatchFailed, ProcessError, NotFoundInPATH, CopyError]
   m
   (Maybe FilePath, ByteString)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      (Maybe FilePath, ByteString))
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath, ByteString)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     (Maybe FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath, ByteString)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath, ByteString)
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction
      FilePath
tmpUnpack
      Maybe FilePath
forall a. Maybe a
Nothing
      (do
        Maybe FilePath
b <- if Bool
hadrian
             then GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
compileHadrianBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
             else GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
compileMakeBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
        ByteString
bmk <- IO ByteString
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ByteString)
-> IO ByteString
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ByteString
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ByteString) -> IO ByteString -> IO ByteString
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"") (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile (FilePath -> FilePath
build_mk FilePath
workdir)
        (Maybe FilePath, ByteString)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
b, ByteString
bmk)
      )

    case InstallDir
installDir of
      InstallDir
GHCupInternal ->
        -- only remove old ghc in regular installs
        Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
     InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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
"Deleting existing installation"
          Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
 MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
installVer

      InstallDir
_ -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Maybe FilePath
-> (FilePath
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
           PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
           DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
           InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
         m
         ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
mBindist ((FilePath
  -> Excepts
       '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
         DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
         PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
         DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
         InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
       m
       ())
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> (FilePath
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
           PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
           DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
           InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
         m
         ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \FilePath
bindist -> do
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
     ArchiveResult, ProcessError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
 HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError]
     m
     ()
installPackedGHC FilePath
bindist
                               (TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (TarDir -> Maybe TarDir) -> TarDir -> Maybe TarDir
forall a b. (a -> b) -> a -> b
$ FilePath -> TarDir
RegexDir FilePath
"ghc-.*")
                               InstallDirResolved
ghcdir
                               (GHCTargetVersion
installVer GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion)
                               Bool
False       -- not a force install, since we already overwrite when compiling.

    IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
ghcUpSrcBuiltFile) ByteString
bmk

    case InstallDir
installDir of
      -- set and make symlinks for regular (non-isolated) installs
      InstallDir
GHCupInternal -> do
        (V '[NotInstalled] -> GHCupSetError)
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[NotInstalled] -> GHCupSetError
forall (es :: [*]).
(ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es,
 Show (V es), Pretty (V es)) =>
V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
installVer
        -- restore
        Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
     InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     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, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
        InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
installVer SetGHC
SetGHCOnly Maybe FilePath
forall a. Maybe a
Nothing

      InstallDir
_ -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    GHCTargetVersion
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
       InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
     m
     GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
installVer

 where
  defaultConf :: Text
defaultConf =
    let cross_mk :: Text
cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
        default_mk :: Text
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
    in case Either GHCTargetVersion GitBranch
targetGhc of
         Left (GHCTargetVersion (Just Text
_) Version
_) -> Text
cross_mk
         Either GHCTargetVersion GitBranch
_ -> Text
default_mk

  compileHadrianBindist :: ( MonadReader env m
                           , HasDirs env
                           , HasSettings env
                           , HasPlatformReq env
                           , MonadThrow m
                           , MonadCatch m
                           , HasLog env
                           , MonadIO m
                           , MonadFail m
                           )
                        => GHCTargetVersion
                        -> FilePath
                        -> InstallDirResolved
                        -> Excepts
                             '[ FileDoesNotExistError
                              , HadrianNotFound
                              , InvalidBuildConfig
                              , PatchFailed
                              , ProcessError
                              , NotFoundInPATH
                              , CopyError]
                             m
                             (Maybe FilePath)  -- ^ output path of bindist, None for cross
  compileHadrianBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
compileHadrianBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir = do
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"python3" [FilePath
"./boot"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"ghc-bootstrap"

    Excepts
  '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
    ProcessError, NotFoundInPATH, CopyError]
  m
  ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
     ProcessError, NotFoundInPATH, CopyError]
   m
   ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir

    m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, 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
"Building (this may take a while)..."
    FilePath
hadrian_build <- Excepts '[HadrianNotFound] m FilePath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[HadrianNotFound] m FilePath
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      FilePath)
-> Excepts '[HadrianNotFound] m FilePath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[HadrianNotFound] m FilePath
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[HadrianNotFound] m FilePath
findHadrianFile FilePath
workdir
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
hadrian_build
                          ( [FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j  -> [FilePath
"-j" 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]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
bf -> [FilePath
"--flavour=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
bf]) Maybe FilePath
buildFlavour
                         [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"binary-dist"]
                          )
                          (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"ghc-make"
    [FilePath
tar] <- IO [FilePath]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      [FilePath])
-> IO [FilePath]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
      (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"_build" FilePath -> FilePath -> FilePath
</> FilePath
"bindist")
      (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                     ExecOption
execBlank
                     ([s|^ghc-.*\.tar\..*$|] :: ByteString)
      )
    Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe FilePath)
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      (Maybe FilePath))
-> Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe FilePath)
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Excepts '[CopyError] m FilePath
 -> Excepts '[CopyError] m (Maybe FilePath))
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
 HasLog env) =>
GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
copyBindist GHCTargetVersion
tver FilePath
tar (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"_build" FilePath -> FilePath -> FilePath
</> FilePath
"bindist")

  findHadrianFile :: (MonadIO m)
                  => FilePath
                  -> Excepts
                       '[HadrianNotFound]
                       m
                       FilePath
  findHadrianFile :: FilePath -> Excepts '[HadrianNotFound] m FilePath
findHadrianFile FilePath
workdir = do
    let possible_files :: [FilePath]
possible_files = if Bool
isWindows
                         then ((FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"hadrian") FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath
"build.bat"]
                         else ((FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"hadrian") FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath
"build", FilePath
"build.sh"]
    [(Bool, FilePath)]
exsists <- [FilePath]
-> (FilePath -> Excepts '[HadrianNotFound] m (Bool, FilePath))
-> Excepts '[HadrianNotFound] m [(Bool, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
possible_files (\FilePath
f -> IO Bool -> Excepts '[HadrianNotFound] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
f) Excepts '[HadrianNotFound] m Bool
-> (Bool -> (Bool, FilePath))
-> Excepts '[HadrianNotFound] m (Bool, FilePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,FilePath
f))
    case ((Bool, FilePath) -> Bool)
-> [(Bool, FilePath)] -> [(Bool, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FilePath) -> Bool
forall a b. (a, b) -> a
fst [(Bool, FilePath)]
exsists of
      [] -> HadrianNotFound -> Excepts '[HadrianNotFound] m FilePath
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE HadrianNotFound
HadrianNotFound
      ((Bool
_, FilePath
x):[(Bool, FilePath)]
_) -> FilePath -> Excepts '[HadrianNotFound] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x

  compileMakeBindist :: ( MonadReader env m
                        , HasDirs env
                        , HasSettings env
                        , HasPlatformReq env
                        , MonadThrow m
                        , MonadCatch m
                        , HasLog env
                        , MonadIO m
                        , MonadFail m
                        )
                     => GHCTargetVersion
                     -> FilePath
                     -> InstallDirResolved
                     -> Excepts
                          '[ FileDoesNotExistError
                           , HadrianNotFound
                           , InvalidBuildConfig
                           , PatchFailed
                           , ProcessError
                           , NotFoundInPATH
                           , CopyError]
                          m
                       (Maybe FilePath)  -- ^ output path of bindist, None for cross
  compileMakeBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
compileMakeBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir = do
    Excepts
  '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
    ProcessError, NotFoundInPATH, CopyError]
  m
  ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
     ProcessError, NotFoundInPATH, CopyError]
   m
   ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir

    case Maybe FilePath
mbuildConfig of
      Just FilePath
bc -> IOErrorType
-> FileDoesNotExistError
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException
        IOErrorType
doesNotExistErrorType
        (FilePath -> FileDoesNotExistError
FileDoesNotExistError FilePath
bc)
        (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
bc (FilePath -> FilePath
build_mk FilePath
workdir))
      Maybe FilePath
Nothing ->
        IO ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile (FilePath -> FilePath
build_mk FilePath
workdir) (Text -> Text
addBuildFlavourToConf Text
defaultConf)

    Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, MonadIO m, HasLog env) =>
FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig (FilePath -> FilePath
build_mk FilePath
workdir)

    m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, 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
"Building (this may take a while)..."
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     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] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"-j" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. IsString a => FilePath -> a
fS (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j)]) Maybe Int
jobs) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)

    if | GHCTargetVersion -> Bool
isCross GHCTargetVersion
tver -> do
          m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, 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
"Installing cross toolchain..."
          m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     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
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
          Maybe FilePath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
       | Bool
otherwise -> do
          m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, 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
"Creating bindist..."
          m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     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
"binary-dist"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
          [FilePath
tar] <- IO [FilePath]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      [FilePath])
-> IO [FilePath]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
            FilePath
workdir
            (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                           ExecOption
execBlank
                           ([s|^ghc-.*\.tar\..*$|] :: ByteString)
            )
          Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe FilePath)
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      (Maybe FilePath))
-> Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe FilePath)
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Excepts '[CopyError] m FilePath
 -> Excepts '[CopyError] m (Maybe FilePath))
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
 HasLog env) =>
GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
copyBindist GHCTargetVersion
tver FilePath
tar FilePath
workdir

  build_mk :: FilePath -> FilePath
build_mk FilePath
workdir = FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"mk" FilePath -> FilePath -> FilePath
</> FilePath
"build.mk"

  copyBindist :: ( MonadReader env m
                 , HasDirs env
                 , HasSettings env
                 , HasPlatformReq env
                 , MonadIO m
                 , MonadThrow m
                 , MonadCatch m
                 , HasLog env
                 )
              => GHCTargetVersion
              -> FilePath           -- ^ tar file
              -> FilePath           -- ^ workdir
              -> Excepts
                   '[CopyError]
                   m
                   FilePath
  copyBindist :: GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
copyBindist GHCTargetVersion
tver FilePath
tar FilePath
workdir = do
    Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[CopyError] 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
    PlatformRequest
pfreq <- m PlatformRequest -> Excepts '[CopyError] 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
    ByteString
c       <- IO ByteString -> Excepts '[CopyError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Excepts '[CopyError] m ByteString)
-> IO ByteString -> Excepts '[CopyError] m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BL.readFile (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
tar)
    Text
cDigest <-
      (Text -> Text)
-> Excepts '[CopyError] m Text -> Excepts '[CopyError] m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.take Int
8)
      (Excepts '[CopyError] m Text -> Excepts '[CopyError] m Text)
-> (ByteString -> Excepts '[CopyError] m Text)
-> ByteString
-> Excepts '[CopyError] m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Text -> Excepts '[CopyError] m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
      (m Text -> Excepts '[CopyError] m Text)
-> (ByteString -> m Text)
-> ByteString
-> Excepts '[CopyError] m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither
      (Either UnicodeException Text -> m Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
E.decodeUtf8'
      (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode
      (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hashlazy
      (ByteString -> Excepts '[CopyError] m Text)
-> ByteString -> Excepts '[CopyError] m Text
forall a b. (a -> b) -> a -> b
$ ByteString
c
    UTCTime
cTime <- IO UTCTime -> Excepts '[CopyError] m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let tarName :: FilePath
tarName = FilePath -> FilePath
makeValid (FilePath
"ghc-"
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver)
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-"
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PlatformRequest -> FilePath
pfReqToString PlatformRequest
pfreq
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-"
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UTCTime -> FilePath
forall t. ISO8601 t => t -> FilePath
iso8601Show UTCTime
cTime
                            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 Text
cDigest
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tar"
                            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
takeExtension FilePath
tar)
    let tarPath :: FilePath
tarPath = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
tarName
    FilePath -> FilePath -> Excepts '[CopyError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
tar)
                                                             FilePath
tarPath
    m () -> Excepts '[CopyError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError] m ())
-> m () -> Excepts '[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
"Copied bindist to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
tarPath
    FilePath -> Excepts '[CopyError] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tarPath

  checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
                   => FilePath
                   -> Excepts
                        '[FileDoesNotExistError, InvalidBuildConfig]
                        m
                        ()
  checkBuildConfig :: FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig FilePath
bc = do
    ByteString
c <- IOErrorType
-> FileDoesNotExistError
-> m ByteString
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException
           IOErrorType
doesNotExistErrorType
           (FilePath -> FileDoesNotExistError
FileDoesNotExistError FilePath
bc)
           (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
bc)
    let lines' :: [Text]
lines' = (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe ByteString
c

   -- for cross, we need Stage1Only
    case Either GHCTargetVersion GitBranch
targetGhc of
      Left (GHCTargetVersion (Just Text
_) Version
_) -> Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"Stage1Only = YES" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ InvalidBuildConfig
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
        (Text -> InvalidBuildConfig
InvalidBuildConfig
          [s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
        )
      Either GHCTargetVersion GitBranch
_ -> () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Maybe FilePath
-> (FilePath
    -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
buildFlavour ((FilePath
  -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> (FilePath
    -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
bf ->
      Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Text
T.pack (FilePath
"BuildFlavour = " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
bf) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ do
        m () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] 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
$ Text
"Customly specified build config overwrites --flavour=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" switch! Waiting 5 seconds..."
        IO () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> IO ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000

  addBuildFlavourToConf :: Text -> Text
addBuildFlavourToConf Text
bc = case Maybe FilePath
buildFlavour of
    Just FilePath
bf -> Text
"BuildFlavour = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bc
    Maybe FilePath
Nothing -> Text
bc

  isCross :: GHCTargetVersion -> Bool
  isCross :: GHCTargetVersion -> Bool
isCross = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> (GHCTargetVersion -> Maybe Text) -> GHCTargetVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Maybe Text
_tvTarget


  configureBindist :: ( MonadReader env m
                      , HasDirs env
                      , HasSettings env
                      , HasPlatformReq env
                      , MonadThrow m
                      , MonadCatch m
                      , HasLog env
                      , MonadIO m
                      , MonadFail m
                      )
                   => GHCTargetVersion
                   -> FilePath
                   -> InstallDirResolved
                   -> Excepts
                        '[ FileDoesNotExistError
                         , InvalidBuildConfig
                         , PatchFailed
                         , ProcessError
                         , NotFoundInPATH
                         , CopyError
                         ]
                        m
                        ()
  configureBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver FilePath
workdir (InstallDirResolved -> FilePath
fromInstallDir -> FilePath
ghcdir) = do
    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, 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 [s|configuring build|]

    if | GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.8.0|] -> do
          m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv
            FilePath
"sh"
            (FilePath
"./configure" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:  [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath]
forall a. Monoid a => a
mempty
                      (\Text
x -> [FilePath
"--target=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
x])
                      (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
            [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcdir]
            [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
isWindows then [FilePath
"--enable-tarballs-autodownload"] else [])
            [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]
aargs
            )
            (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
            FilePath
"ghc-conf"
       | Bool
otherwise -> do
        m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     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
"sh"
          (  [ FilePath
"./configure", FilePath
"--with-ghc=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FilePath)
-> (FilePath -> FilePath) -> Either FilePath FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id Either FilePath FilePath
bghc
             ]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath]
forall a. Monoid a => a
mempty
                   (\Text
x -> [FilePath
"--target=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
x])
                   (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcdir]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
isWindows then [FilePath
"--enable-tarballs-autodownload"] else [])
          [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]
aargs
          )
          (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
          FilePath
"ghc-conf"
          Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  execWithGhcEnv :: ( MonadReader env m
                    , HasSettings env
                    , HasDirs env
                    , HasLog env
                    , MonadIO m
                    , MonadThrow m)
                 => FilePath         -- ^ thing to execute
                 -> [String]         -- ^ args for the thing
                 -> Maybe FilePath   -- ^ optionally chdir into this
                 -> FilePath         -- ^ log filename (opened in append mode)
                 -> m (Either ProcessError ())
  execWithGhcEnv :: FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
fp [FilePath]
args Maybe FilePath
dir FilePath
logf = do
    [(FilePath, FilePath)]
env <- m [(FilePath, FilePath)]
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
m [(FilePath, FilePath)]
ghcEnv
    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
fp [FilePath]
args Maybe FilePath
dir FilePath
logf ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env)

  bghc :: Either FilePath FilePath
bghc = case Either Version FilePath
bstrap of
           Right FilePath
g    -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
g
           Left  Version
bver -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (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
bver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)

  ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
  ghcEnv :: m [(FilePath, FilePath)]
ghcEnv = do
    [(FilePath, FilePath)]
cEnv <- IO [(FilePath, FilePath)] -> m [(FilePath, FilePath)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FilePath, FilePath)]
getEnvironment
    FilePath
bghcPath <- case Either FilePath FilePath
bghc of
      Right FilePath
ghc' -> FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
ghc'
      Left  FilePath
bver -> do
        [FilePath]
spaths <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
        NotFoundInPATH -> m (Maybe FilePath) -> m FilePath
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
a -> m (Maybe b) -> m b
throwMaybeM (FilePath -> NotFoundInPATH
NotFoundInPATH FilePath
bver) (m (Maybe FilePath) -> m FilePath)
-> m (Maybe FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
spaths FilePath
bver)
    [(FilePath, FilePath)] -> m [(FilePath, FilePath)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
"GHC", FilePath
bghcPath) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
cEnv)






    ---------------------
    --[ Upgrade GHCup ]--
    ---------------------


-- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
-- if no path is provided.
upgradeGHCup :: ( MonadMask m
                , MonadReader env m
                , HasDirs env
                , HasPlatformReq env
                , HasGHCupInfo env
                , HasSettings env
                , MonadCatch m
                , HasLog env
                , MonadThrow m
                , MonadFail m
                , MonadResource m
                , MonadIO m
                , MonadUnliftIO m
                )
             => Maybe FilePath    -- ^ full file destination to write ghcup into
             -> Bool              -- ^ whether to force update regardless
                                  --   of currently installed version
             -> Bool              -- ^ whether to throw an error if ghcup is shadowed
             -> Excepts
                  '[ CopyError
                   , DigestError
                   , GPGError
                   , GPGError
                   , DownloadFailed
                   , NoDownload
                   , NoUpdate
                   , GHCupShadowed
                   ]
                  m
                  Version
upgradeGHCup :: Maybe FilePath
-> Bool
-> Bool
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     Version
upgradeGHCup Maybe FilePath
mtarget Bool
force' Bool
fatal = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo

  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Upgrading GHCup..."
  let latestVer :: Version
latestVer = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst (Maybe (Version, VersionInfo) -> (Version, VersionInfo)
forall a. HasCallStack => Maybe a -> a
fromJust (GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup))
  (Just Version
ghcupPVPVer) <- Maybe Version
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      (Maybe Version))
-> Maybe Version
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     (Maybe Version)
forall a b. (a -> b) -> a -> b
$ PVP -> Text -> Maybe Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
ghcUpVer Text
""
  Bool
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force' Bool -> Bool -> Bool
&& (Version
latestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
ghcupPVPVer)) (Excepts
   '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
     NoDownload, NoUpdate, GHCupShadowed]
   m
   ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ NoUpdate
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE NoUpdate
NoUpdate
  DownloadInfo
dli   <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
GHCup Version
latestVer
  FilePath
tmp   <- m FilePath
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
  let fn :: FilePath
fn = FilePath
"ghcup" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  FilePath
p <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download (DownloadInfo -> URI
_dlUri DownloadInfo
dli) Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) FilePath
tmp (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fn) Bool
False
  let destDir :: FilePath
destDir = FilePath -> FilePath
takeDirectory FilePath
destFile
      destFile :: FilePath
destFile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fn) Maybe FilePath
mtarget
  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destDir
  IO ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> IO ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
destDir
  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile FilePath
destFile
  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
  FilePath
-> FilePath
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
p
                                                           FilePath
destFile
  m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destFile

  IO Bool
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
isInPath FilePath
destFile) Excepts
  '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
    NoDownload, NoUpdate, GHCupShadowed]
  m
  Bool
-> (Bool
    -> Excepts
         '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
           NoDownload, NoUpdate, GHCupShadowed]
         m
         ())
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Excepts
   '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
     NoDownload, NoUpdate, GHCupShadowed]
   m
   ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$
    m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> FilePath
takeFileName FilePath
destFile) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in PATH! You have to add it in order to use ghcup."
  IO (Maybe FilePath)
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
isShadowed FilePath
destFile) Excepts
  '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
    NoDownload, NoUpdate, GHCupShadowed]
  m
  (Maybe FilePath)
-> (Maybe FilePath
    -> Excepts
         '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
           NoDownload, NoUpdate, GHCupShadowed]
         m
         ())
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe FilePath
Nothing -> ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just FilePath
pa
      | Bool
fatal -> GHCupShadowed
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FilePath -> FilePath -> Version -> GHCupShadowed
GHCupShadowed FilePath
pa FilePath
destFile Version
latestVer)
      | Bool
otherwise ->
        m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
        NoDownload, NoUpdate, GHCupShadowed]
      m
      ())
-> m ()
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     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
$ Text
"ghcup is shadowed by "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pa
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". The upgrade will not be in effect, unless you remove "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pa
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" or make sure "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destDir
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" comes before "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
takeDirectory FilePath
pa)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in PATH."

  Version
-> Excepts
     '[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
       NoDownload, NoUpdate, GHCupShadowed]
     m
     Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
latestVer



    -------------
    --[ Other ]--
    -------------



-- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
-- both installing from source and bindist.
postGHCInstall :: ( MonadReader env m
                  , HasDirs env
                  , HasLog env
                  , MonadThrow m
                  , MonadFail m
                  , MonadIO m
                  , MonadCatch m
                  , MonadMask m
                  , MonadUnliftIO m
                  )
               => GHCTargetVersion
               -> Excepts '[NotInstalled] m ()
postGHCInstall :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
..} = do
  Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
SetGHC_XYZ Maybe FilePath
forall a. Maybe a
Nothing

  -- Create ghc-x.y symlinks. This may not be the current
  -- version, create it regardless.
  Maybe (Int, Int)
v' <-
    (ParseError -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
e :: ParseError) -> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Int, Int))
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
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 (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int)
forall a. Maybe a
Nothing)
    (Excepts '[NotInstalled] m (Maybe (Int, Int))
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just
    (Excepts '[NotInstalled] m (Int, Int)
 -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version
_tvVersion
  Maybe (Int, Int)
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Int, Int)
v' (((Int, Int) -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP (NonEmpty Word -> PVP
PVP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mj Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mi])) Maybe Text
_tvTarget)
    Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
 -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe FilePath
forall a. Maybe a
Nothing)


-- | Reports the binary location of a given tool:
--
--   * for GHC, this reports: @~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * for cabal, this reports @~\/.ghcup\/bin\/cabal-\<ver\>@
--   * for hls, this reports @~\/.ghcup\/bin\/haskell-language-server-wrapper-\<ver\>@
--   * for stack, this reports @~\/.ghcup\/bin\/stack-\<ver\>@
--   * for ghcup, this reports the location of the currently running executable
whereIsTool :: ( MonadReader env m
               , HasDirs env
               , HasLog env
               , MonadThrow m
               , MonadFail m
               , MonadIO m
               , MonadCatch m
               , MonadMask m
               , MonadUnliftIO m
               )
            => Tool
            -> GHCTargetVersion
            -> Excepts '[NotInstalled] m FilePath
whereIsTool :: Tool -> GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
whereIsTool Tool
tool ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
..} = do
  Dirs
dirs <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  case Tool
tool of
    Tool
GHC -> do
      Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver)
        (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver)
      FilePath
bdir <- 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
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
      FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> GHCTargetVersion -> FilePath
ghcBinaryName GHCTargetVersion
ver)
    Tool
Cabal -> do
      Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
_tvVersion)
        (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
      FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"cabal-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    Tool
HLS -> do
      Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
_tvVersion)
        (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
      Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
_tvVersion)
        (FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt))
        (Excepts '[NotInstalled] m FilePath
 -> Excepts '[NotInstalled] m FilePath)
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ do
          FilePath
bdir <- 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 -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
_tvVersion
          FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)

    Tool
Stack -> do
      Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
_tvVersion)
        (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
      FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"stack-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    Tool
GHCup -> do
      FilePath
currentRunningExecPath <- IO FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
      IO FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Excepts '[NotInstalled] m FilePath)
-> IO FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath

-- | Doesn't work for cross GHC.
checkIfToolInstalled :: ( MonadIO m
                        , MonadReader env m
                        , HasDirs env
                        , MonadCatch m) =>
                        Tool ->
                        Version ->
                        m Bool
checkIfToolInstalled :: Tool -> Version -> m Bool
checkIfToolInstalled Tool
tool Version
ver = Tool -> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool (Version -> GHCTargetVersion
mkTVer Version
ver)

checkIfToolInstalled' :: ( MonadIO m
                         , MonadReader env m
                         , HasDirs env
                         , MonadCatch m) =>
                        Tool ->
                        GHCTargetVersion ->
                        m Bool
checkIfToolInstalled' :: Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool GHCTargetVersion
ver =
  case Tool
tool of
    Tool
Cabal -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
    Tool
HLS   -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
    Tool
Stack -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
    Tool
GHC   -> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver
    Tool
_     -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

throwIfFileAlreadyExists :: ( MonadIO m ) =>
                            FilePath ->
                            Excepts '[FileAlreadyExistsError] m ()

throwIfFileAlreadyExists :: FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
fp = Excepts '[FileAlreadyExistsError] m Bool
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> Excepts '[FileAlreadyExistsError] m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
checkFileAlreadyExists FilePath
fp)
                                (FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ())
-> FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileAlreadyExistsError
FileAlreadyExistsError FilePath
fp)



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


rmOldGHC :: ( MonadReader env m
            , HasGHCupInfo env
            , HasDirs env
            , HasLog env
            , MonadIO m
            , MonadFail m
            , MonadMask m
            , MonadUnliftIO m
            )
         => Excepts '[NotInstalled] m ()
rmOldGHC :: Excepts '[NotInstalled] m ()
rmOldGHC = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo -> Excepts '[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
  let oldGHCs :: [GHCTargetVersion]
oldGHCs = Version -> GHCTargetVersion
mkTVer (Version -> GHCTargetVersion) -> [Version] -> [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] GHCupDownloads Version
-> GHCupDownloads -> [Version]
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic'
     A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Optic
     A_Fold
     '[]
     GHCupDownloads
     GHCupDownloads
     (Version, VersionInfo)
     (Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag
-> Optic'
     A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Old Optic
  A_Fold
  '[]
  GHCupDownloads
  GHCupDownloads
  (Version, VersionInfo)
  (Version, VersionInfo)
-> Optic
     A_Getter
     '[]
     (Version, VersionInfo)
     (Version, VersionInfo)
     Version
     Version
-> Optic' A_Fold '[] GHCupDownloads Version
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((Version, VersionInfo) -> Version)
-> Optic
     A_Getter
     '[]
     (Version, VersionInfo)
     (Version, VersionInfo)
     Version
     Version
forall s a. (s -> a) -> Getter s a
to (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst) GHCupDownloads
dls
  [GHCTargetVersion]
ghcs <- m [GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GHCTargetVersion]
 -> Excepts '[NotInstalled] m [GHCTargetVersion])
-> m [GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
  [GHCTargetVersion]
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GHCTargetVersion
ghc GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GHCTargetVersion]
oldGHCs) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
 MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ghc



rmProfilingLibs :: ( MonadReader env m
                   , HasDirs env
                   , HasLog env
                   , MonadIO m
                   , MonadFail m
                   , MonadMask m
                   , MonadUnliftIO m
                   )
                => m ()
rmProfilingLibs :: m ()
rmProfilingLibs = do
  [GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs

  let regexes :: [ByteString]
      regexes :: [ByteString]
regexes = [[s|.*_p\.a$|], [s|.*\.p_hi$|]]

  [ByteString] -> (ByteString -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
regexes ((ByteString -> m ()) -> m ()) -> (ByteString -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
regex ->
    [GHCTargetVersion] -> (GHCTargetVersion -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> m ()) -> m ())
-> (GHCTargetVersion -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
      FilePath
d <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ghc
      [FilePath]
matches <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFilesDeep
        FilePath
d
        (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                       ExecOption
execBlank
                       ByteString
regex
        )
      [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
matches ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
m -> do
        let p :: FilePath
p = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
m
        Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
        FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p



rmShareDir :: ( MonadReader env m
              , HasDirs env
              , HasLog env
              , MonadIO m
              , MonadFail m
              , MonadMask m
              , MonadUnliftIO m
              )
           => m ()
rmShareDir :: m ()
rmShareDir = do
  [GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
  [GHCTargetVersion] -> (GHCTargetVersion -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> m ()) -> m ())
-> (GHCTargetVersion -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
    FilePath
d <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ghc
    let p :: FilePath
p = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"share"
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
    FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
p


rmHLSNoGHC :: ( MonadReader env m
              , HasDirs env
              , HasLog env
              , MonadIO m
              , MonadMask m
              , MonadFail m
              , MonadUnliftIO m
              )
           => Excepts '[NotInstalled] m ()
rmHLSNoGHC :: Excepts '[NotInstalled] m ()
rmHLSNoGHC = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- Excepts '[NotInstalled] m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  [GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> Excepts '[NotInstalled] m [Either FilePath GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights Excepts '[NotInstalled] m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
  [Version]
hlses <- ([Either FilePath Version] -> [Version])
-> Excepts '[NotInstalled] m [Either FilePath Version]
-> Excepts '[NotInstalled] m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights Excepts '[NotInstalled] m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
  [Version]
-> (Version -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version]
hlses ((Version -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (Version -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Version
hls -> do
    [GHCTargetVersion]
hlsGHCs <- (Version -> GHCTargetVersion) -> [Version] -> [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> GHCTargetVersion
mkTVer ([Version] -> [GHCTargetVersion])
-> Excepts '[NotInstalled] m [Version]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Excepts '[NotInstalled] m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
Version -> m [Version]
hlsGHCVersions' Version
hls
    let candidates :: [GHCTargetVersion]
candidates = (GHCTargetVersion -> Bool)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCTargetVersion]
ghcs) [GHCTargetVersion]
hlsGHCs
    if ([GHCTargetVersion] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
hlsGHCs Int -> Int -> Int
forall a. Num a => a -> a -> a
- [GHCTargetVersion] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
candidates) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    then Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
hls
    else
      [GHCTargetVersion]
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
candidates ((GHCTargetVersion -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
        [FilePath]
bins1 <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
binDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
        [FilePath]
bins2 <- Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Version -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
hls) ([FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Excepts '[NotInstalled] m [FilePath]
 -> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ do
          [FilePath]
shs <- Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
          [FilePath]
bins <- Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadFail m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerBinaries Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
          [FilePath]
libs <- Version -> Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadFail m) =>
Version -> Version -> m [FilePath]
hlsInternalServerLibs Version
hls (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
          [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
shs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
bins [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
libs)
        [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath]
bins1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
bins2) ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
          Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> Excepts '[NotInstalled] m ())
-> Text -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
f
          FilePath -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
f
    () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


rmCache :: ( MonadReader env m
           , HasDirs env
           , HasLog env
           , MonadIO m
           , MonadMask m
           )
        => m ()
rmCache :: m ()
rmCache = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  [FilePath]
contents <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
cacheDir
  [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
    let p :: FilePath
p = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
f
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
    FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p


rmTmp :: ( MonadReader env m
         , HasDirs env
         , HasLog env
         , MonadIO m
         , MonadMask m
         )
      => m ()
rmTmp :: m ()
rmTmp = do
  FilePath
tmpdir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCanonicalTemporaryDirectory
  [FilePath]
ghcup_dirs <- 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 -> Regex -> IO [FilePath]
findFiles
    FilePath
tmpdir
    (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                   ExecOption
execBlank
                   ([s|^ghcup-.*$|] :: ByteString)
    )
  [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
ghcup_dirs ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
    let p :: FilePath
p = FilePath
tmpdir FilePath -> FilePath -> FilePath
</> FilePath
f
    Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
    FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
p


applyAnyPatch :: ( 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])
-> FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
Nothing FilePath
_                   = ()
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
applyAnyPatch (Just (Left FilePath
pdir)) FilePath
workdir  = Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
 -> Excepts
      '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatches FilePath
pdir FilePath
workdir
applyAnyPatch (Just (Right [URI]
uris)) FilePath
workdir = do
  FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
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 FilePath
withGHCupTmpDir
  [URI]
-> (URI
    -> Excepts
         '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [URI]
uris ((URI
  -> Excepts
       '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
 -> Excepts
      '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> (URI
    -> Excepts
         '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ \URI
uri -> do
    FilePath
patch <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] 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
      '[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] 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 FilePath
tmpUnpack Maybe FilePath
forall a. Maybe a
Nothing Bool
False
    Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
 -> Excepts
      '[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatch FilePath
patch FilePath
workdir