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

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


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

import           Control.Applicative
import           Control.Concurrent             ( threadDelay )
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
import           Data.ByteString                ( ByteString )
import           Data.Either
import           Data.List
import           Data.Maybe
import           Data.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           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           System.Environment
import           System.FilePath
import           System.IO.Error
import           Text.PrettyPrint.HughesPJClass ( prettyShow )
import           Text.Regex.Posix
import           URI.ByteString

import qualified Crypto.Hash.SHA256            as SHA256
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


data GHCVer = SourceDist Version
            | GitDist GitBranch
            | RemoteDist URI
            deriving (GHCVer -> GHCVer -> Bool
(GHCVer -> GHCVer -> Bool)
-> (GHCVer -> GHCVer -> Bool) -> Eq GHCVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GHCVer -> GHCVer -> Bool
== :: GHCVer -> GHCVer -> Bool
$c/= :: GHCVer -> GHCVer -> Bool
/= :: GHCVer -> GHCVer -> Bool
Eq, Int -> GHCVer -> ShowS
[GHCVer] -> ShowS
GHCVer -> String
(Int -> GHCVer -> ShowS)
-> (GHCVer -> String) -> ([GHCVer] -> ShowS) -> Show GHCVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GHCVer -> ShowS
showsPrec :: Int -> GHCVer -> ShowS
$cshow :: GHCVer -> String
show :: GHCVer -> String
$cshowList :: [GHCVer] -> ShowS
showList :: [GHCVer] -> ShowS
Show)



    --------------------
    --[ Tool testing ]--
    --------------------



testGHCVer :: ( 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
              )
           => GHCTargetVersion
           -> [T.Text]
           -> Excepts
                '[ DigestError
                 , ContentLengthError
                 , GPGError
                 , DownloadFailed
                 , NoDownload
                 , ArchiveResult
                 , TarDirDoesNotExist
                 , UnknownArchive
                 , TestFailed
                 ]
                m
                ()
testGHCVer :: forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
 HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env,
 HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) =>
GHCTargetVersion
-> [Text]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
testGHCVer GHCTargetVersion
ver [Text]
addMakeArgs = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     a
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 GHCTargetVersion VersionInfo)
  (Map GHCTargetVersion VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map GHCTargetVersion VersionInfo)
     (Map GHCTargetVersion 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 GHCTargetVersion VersionInfo)
-> Optic'
     (IxKind (Map GHCTargetVersion VersionInfo))
     '[]
     (Map GHCTargetVersion VersionInfo)
     (IxValue (Map GHCTargetVersion VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map GHCTargetVersion VersionInfo)
GHCTargetVersion
ver 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)
viTestDL 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, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? GHCTargetVersion -> Tool -> Maybe PlatformRequest -> NoDownload
NoDownload GHCTargetVersion
ver Tool
GHC Maybe PlatformRequest
forall a. Maybe a
Nothing

  Excepts
  '[DigestError, ContentLengthError, GPGError, DownloadFailed,
    NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
    TestFailed]
  m
  ()
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, GPGError, DownloadFailed,
     NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
     TestFailed]
   m
   ()
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, DownloadFailed,
        NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
        TestFailed]
      m
      ())
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
 HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env,
 HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
testGHCBindist DownloadInfo
dlInfo GHCTargetVersion
ver [Text]
addMakeArgs



testGHCBindist :: ( 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
                  )
               => DownloadInfo
               -> GHCTargetVersion
               -> [T.Text]
               -> Excepts
                    '[ DigestError
                     , ContentLengthError
                     , GPGError
                     , DownloadFailed
                     , NoDownload
                     , ArchiveResult
                     , TarDirDoesNotExist
                     , UnknownArchive
                     , TestFailed
                     ]
                    m
                    ()
testGHCBindist :: forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
 HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env,
 HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
testGHCBindist DownloadInfo
dlinfo GHCTargetVersion
ver [Text]
addMakeArgs = do
  -- download (or use cached version)
  String
dl <- Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, DownloadFailed,
        NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
        TestFailed]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     String
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
downloadCached DownloadInfo
dlinfo Maybe String
forall a. Maybe a
Nothing

  Excepts
  '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
  m
  ()
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
   m
   ()
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, DownloadFailed,
        NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
        TestFailed]
      m
      ())
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     ()
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload, ArchiveResult, TarDirDoesNotExist, UnknownArchive,
       TestFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TarDir
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     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, MonadResource m) =>
String
-> Maybe TarDir
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     ()
testPackedGHC String
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) GHCTargetVersion
ver [Text]
addMakeArgs


testPackedGHC :: ( MonadMask m
                 , MonadCatch m
                 , MonadReader env m
                 , HasDirs env
                 , HasPlatformReq env
                 , HasSettings env
                 , MonadThrow m
                 , HasLog env
                 , MonadIO m
                 , MonadUnliftIO m
                 , MonadFail m
                 , MonadResource m
                 )
              => FilePath          -- ^ Path to the packed GHC bindist
              -> Maybe TarDir      -- ^ Subdir of the archive
              -> GHCTargetVersion  -- ^ The GHC version
              -> [T.Text]          -- ^ additional make args
              -> Excepts
                   '[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
testPackedGHC :: 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, MonadResource m) =>
String
-> Maybe TarDir
-> GHCTargetVersion
-> [Text]
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     ()
testPackedGHC String
dl Maybe TarDir
msubdir GHCTargetVersion
ver [Text]
addMakeArgs = do
  -- unpack
  GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
  Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     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
      '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError GHCupPath
tmpUnpack (String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
dl)

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

  forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
    (String
-> V '[ArchiveResult, UnknownArchive, TarDirDoesNotExist,
       ProcessError]
-> TestFailed
forall (es :: [*]).
(ToVariantMaybe TestFailed es, PopVariant TestFailed es,
 Pretty (V es), Show (V es), HFErrorProject (V es)) =>
String -> V es -> TestFailed
TestFailed (GHCupPath -> String
fromGHCupPath GHCupPath
workdir)) (Excepts
   '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
   m
   ()
 -> Excepts
      '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
      m
      ())
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
     m
     ()
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m ()
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, 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
      '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> 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) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction GHCupPath
tmpUnpack
                         (GHCupPath
-> GHCTargetVersion -> [Text] -> Excepts '[ProcessError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadThrow m,
 HasLog env, MonadIO m) =>
GHCupPath
-> GHCTargetVersion -> [Text] -> Excepts '[ProcessError] m ()
testUnpackedGHC GHCupPath
workdir GHCTargetVersion
ver [Text]
addMakeArgs)

testUnpackedGHC :: ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadThrow m
                   , HasLog env
                   , MonadIO m
                   )
                => GHCupPath         -- ^ Path to the unpacked GHC bindist (where the make file resides)
                -> GHCTargetVersion  -- ^ The GHC version
                -> [T.Text]          -- ^ additional configure args for bindist
                -> Excepts '[ProcessError] m ()
testUnpackedGHC :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadThrow m,
 HasLog env, MonadIO m) =>
GHCupPath
-> GHCTargetVersion -> [Text] -> Excepts '[ProcessError] m ()
testUnpackedGHC GHCupPath
path GHCTargetVersion
tver [Text]
addMakeArgs = do
  m () -> Excepts '[ProcessError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError] m a
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
"Testing GHC version " 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
"!"
  GHCupPath
ghcDir <- m GHCupPath -> Excepts '[ProcessError] m GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GHCupPath -> Excepts '[ProcessError] m GHCupPath)
-> m GHCupPath -> Excepts '[ProcessError] m GHCupPath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
tver
  let ghcBinDir :: String
ghcBinDir = GHCupPath -> String
fromGHCupPath GHCupPath
ghcDir String -> ShowS
</> String
"bin"
  [(String, String)]
env <- IO [(String, String)]
-> Excepts '[ProcessError] m [(String, String)]
forall a. IO a -> Excepts '[ProcessError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)]
 -> Excepts '[ProcessError] m [(String, String)])
-> IO [(String, String)]
-> Excepts '[ProcessError] m [(String, String)]
forall a b. (a -> b) -> a -> b
$ [String] -> Bool -> IO [(String, String)]
addToPath [String
ghcBinDir] Bool
False
  let pathVar :: String
pathVar = if Bool
isWindows then String
"Path" else String
"PATH"
  Maybe String
-> (String -> Excepts '[ProcessError] m ())
-> Excepts '[ProcessError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
pathVar (Map String String -> Maybe String)
-> ([(String, String)] -> Map String String)
-> [(String, String)]
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Maybe String)
-> [(String, String)] -> Maybe String
forall a b. (a -> b) -> a -> b
$ [(String, String)]
env) ((String -> Excepts '[ProcessError] m ())
 -> Excepts '[ProcessError] m ())
-> (String -> Excepts '[ProcessError] m ())
-> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[ProcessError] m ()
forall a. IO a -> Excepts '[ProcessError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[ProcessError] m ())
-> (String -> IO ()) -> String -> Excepts '[ProcessError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
setEnv String
pathVar

  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
$ [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
make' ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack [Text]
addMakeArgs)
              (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
path)
              String
"ghc-test"
              ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String
"STAGE1_GHC", String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-")) (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
                                     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"ghc-"
                                     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Version -> Text
prettyVer (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver)) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
env)
  () -> Excepts '[ProcessError] m ()
forall a. a -> Excepts '[ProcessError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


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



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
               )
            => GHCTargetVersion
            -> Maybe FilePath
            -> Excepts
                 '[ DigestError
                  , ContentLengthError
                  , GPGError
                  , DownloadFailed
                  , NoDownload
                  ]
                 m
                 FilePath
fetchGHCSrc :: forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
 HasDirs env, HasSettings env, HasPlatformReq env, HasGHCupInfo env,
 HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m) =>
GHCTargetVersion
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     String
fetchGHCSrc GHCTargetVersion
v Maybe String
mfp = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     a
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 GHCTargetVersion VersionInfo)
  (Map GHCTargetVersion VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map GHCTargetVersion VersionInfo)
     (Map GHCTargetVersion 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 GHCTargetVersion VersionInfo)
-> Optic'
     (IxKind (Map GHCTargetVersion VersionInfo))
     '[]
     (Map GHCTargetVersion VersionInfo)
     (IxValue (Map GHCTargetVersion VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map GHCTargetVersion VersionInfo)
GHCTargetVersion
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, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? GHCTargetVersion -> Tool -> Maybe PlatformRequest -> NoDownload
NoDownload GHCTargetVersion
v Tool
GHC Maybe PlatformRequest
forall a. Maybe a
Nothing
  Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[DigestError, ContentLengthError, GPGError, DownloadFailed,
        NoDownload]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[DigestError, ContentLengthError, GPGError, DownloadFailed,
       NoDownload]
     m
     String
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
downloadCached' DownloadInfo
dlInfo Maybe String
forall a. Maybe a
Nothing Maybe String
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
                  -> GHCTargetVersion -- ^ the version to install
                  -> InstallDir
                  -> Bool            -- ^ Force install
                  -> [T.Text]        -- ^ additional configure args for bindist
                  -> Excepts
                       '[ AlreadyInstalled
                        , BuildFailed
                        , DigestError
                        , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , NoDownload
                        , NotInstalled
                        , UnknownArchive
                        , TarDirDoesNotExist
                        , DirNotEmpty
                        , ArchiveResult
                        , ProcessError
                        , UninstallFailed
                        , MergeFileTreeError
                        ]
                       m
                       ()
installGHCBindist :: 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
-> GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
installGHCBindist DownloadInfo
dlinfo GHCTargetVersion
tver InstallDir
installDir Bool
forceInstall [Text]
addConfArgs = do
  m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install GHC with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver

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

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

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

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

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


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

  case InstallDir
installDir of
    IsolateDir String
isoDir -> do                        -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing GHC to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
isoDir
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError, MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     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, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     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, MonadResource m) =>
String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
installPackedGHC String
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) (String -> InstallDirResolved
IsolateDirResolved String
isoDir) GHCTargetVersion
tver Bool
forceInstall [Text]
addConfArgs
    InstallDir
GHCupInternal -> do                            -- regular install
      -- prepare paths
      GHCupPath
ghcdir <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GHCupPath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      GHCupPath)
-> m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
tver

      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError, MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     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, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     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, MonadResource m) =>
String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
installPackedGHC String
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) (GHCupPath -> InstallDirResolved
GHCupDir GHCupPath
ghcdir) GHCTargetVersion
tver Bool
forceInstall [Text]
addConfArgs

      -- make symlinks & stuff when regular install,
      Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     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, ContentLengthError,
    GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
    UninstallFailed, MergeFileTreeError]
  m
  ()
toolchainSanityChecks = do
    [Maybe String]
r <- [String]
-> (String
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
           GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
           TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
           UninstallFailed, MergeFileTreeError]
         m
         (Maybe String))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String
"CC", String
"LD"] (IO (Maybe String)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     (Maybe String)
forall a.
IO a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      (Maybe String))
-> (String -> IO (Maybe String))
-> String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
lookupEnv)
    case [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
r of
      [] -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [String]
_ -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
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
                    , MonadResource m
                    )
                 => FilePath          -- ^ Path to the packed GHC bindist
                 -> Maybe TarDir      -- ^ Subdir of the archive
                 -> InstallDirResolved
                 -> GHCTargetVersion  -- ^ The GHC version
                 -> Bool              -- ^ Force install
                 -> [T.Text]          -- ^ additional configure args for bindist
                 -> Excepts
                      '[ BuildFailed
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , DirNotEmpty
                       , ArchiveResult
                       , ProcessError
                       , MergeFileTreeError
                       ] m ()
installPackedGHC :: 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, MonadResource m) =>
String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
installPackedGHC String
dl Maybe TarDir
msubdir InstallDirResolved
inst GHCTargetVersion
ver Bool
forceInstall [Text]
addConfArgs = do
  PlatformRequest {Maybe Versioning
Platform
Architecture
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
..} <- m PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     PlatformRequest
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     a
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, MergeFileTreeError]
     m
     ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DirNotEmpty] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError, MergeFileTreeError]
      m
      ())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m, MonadMask m) =>
InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck InstallDirResolved
inst)

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

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

  Excepts '[ProcessError, MergeFileTreeError] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError, MergeFileTreeError] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult, ProcessError, MergeFileTreeError]
      m
      ())
-> Excepts '[ProcessError, MergeFileTreeError] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[ProcessError, MergeFileTreeError] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction GHCupPath
tmpUnpack
                         (GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC GHCupPath
workdir InstallDirResolved
inst GHCTargetVersion
ver Bool
forceInstall [Text]
addConfArgs)


-- | 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
                      , MonadResource m
                      , MonadFail m
                      )
                   => GHCupPath           -- ^ Path to the unpacked GHC bindist (where the configure script resides)
                   -> InstallDirResolved  -- ^ Path to install to
                   -> GHCTargetVersion    -- ^ The GHC version
                   -> Bool                -- ^ Force install
                   -> [T.Text]          -- ^ additional configure args for bindist
                   -> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC :: forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts '[ProcessError, MergeFileTreeError] m ()
installUnpackedGHC GHCupPath
path InstallDirResolved
inst GHCTargetVersion
tver Bool
forceInstall [Text]
addConfArgs
  | Bool
isWindows = do
      m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing 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.
      Excepts '[MergeFileTreeError] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree GHCupPath
path InstallDirResolved
inst GHCTargetVersion
tver Bool
forceInstall
  | Bool
otherwise = do
      PlatformRequest {Maybe Versioning
Platform
Architecture
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
..} <- m PlatformRequest
-> Excepts '[ProcessError, MergeFileTreeError] m PlatformRequest
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, MergeFileTreeError] m a
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 ldOverride :: [String]
ldOverride
           | GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.2.2|]
           , Platform
_rPlatform Platform -> [Platform] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LinuxDistro -> Platform
Linux LinuxDistro
Alpine, Platform
Darwin]
           = [String
"--disable-ld-override"]
           | Bool
otherwise
           = []

      m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing GHC (this may take a while)"
      Maybe [(String, String)]
env <- case Platform
_rPlatform of
               -- https://github.com/haskell/ghcup-hs/issues/967
               Linux LinuxDistro
Alpine
                 -- lets not touch LD for cross targets
                 | Maybe Text
Nothing <- GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver -> do
                     [(String, String)]
cEnv <- IO [(String, String)]
-> Excepts '[ProcessError, MergeFileTreeError] m [(String, String)]
forall a. IO a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(String, String)]
getEnvironment
                     [String]
spaths <- IO [String]
-> Excepts '[ProcessError, MergeFileTreeError] m [String]
forall a. IO a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getSearchPath
                     Bool
has_ld_bfd <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> Excepts '[ProcessError, MergeFileTreeError] m (Maybe String)
-> Excepts '[ProcessError, MergeFileTreeError] m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
-> Excepts '[ProcessError, MergeFileTreeError] m (Maybe String)
forall a. IO a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([String] -> String -> IO (Maybe String)
searchPath [String]
spaths String
"ld.bfd")
                     let ldSet :: Bool
ldSet = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"LD" [(String, String)]
cEnv
                     -- only set LD if ld.bfd exists in PATH and LD is not set
                     -- already
                     if Bool
has_ld_bfd Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ldSet
                     then do
                       m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> m () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Detected alpine linux... setting LD=ld.bfd"
                       Maybe [(String, String)]
-> Excepts
     '[ProcessError, MergeFileTreeError] m (Maybe [(String, String)])
forall a. a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [(String, String)]
 -> Excepts
      '[ProcessError, MergeFileTreeError] m (Maybe [(String, String)]))
-> Maybe [(String, String)]
-> Excepts
     '[ProcessError, MergeFileTreeError] m (Maybe [(String, String)])
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ((String
"LD", String
"ld.bfd") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
cEnv)
                     else Maybe [(String, String)]
-> Excepts
     '[ProcessError, MergeFileTreeError] m (Maybe [(String, String)])
forall a. a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(String, String)]
forall a. Maybe a
Nothing
               Platform
_ -> Maybe [(String, String)]
-> Excepts
     '[ProcessError, MergeFileTreeError] m (Maybe [(String, String)])
forall a. a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(String, String)]
forall a. Maybe a
Nothing
      m (Either ProcessError ())
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> m (Either ProcessError ())
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged String
"sh"
                       (String
"./configure" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"--prefix=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> InstallDirResolved -> String
fromInstallDir InstallDirResolved
inst)
                        String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ([String] -> (Text -> [String]) -> Maybe Text -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
forall a. Monoid a => a
mempty (\Text
x -> [String
"--target=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x]) (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ldOverride [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
addConfArgs))
                       )
                       (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
path)
                       String
"ghc-configure"
                       Maybe [(String, String)]
env
      GHCupPath
tmpInstallDest <- m GHCupPath
-> Excepts '[ProcessError, MergeFileTreeError] m GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
m GHCupPath
withGHCupTmpDir
      m (Either ProcessError ())
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> m (Either ProcessError ())
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[String] -> Maybe String -> m (Either ProcessError ())
make [String
"DESTDIR=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GHCupPath -> String
fromGHCupPath GHCupPath
tmpInstallDest, String
"install"] (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
path)
      Excepts '[] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> Excepts '[] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), HFErrorProject (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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> String -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> String -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (GHCupPath -> String
fromGHCupPath GHCupPath
tmpInstallDest)
      Excepts '[MergeFileTreeError] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts '[ProcessError, MergeFileTreeError] m ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree (GHCupPath
tmpInstallDest GHCupPath -> String -> GHCupPath
`appendGHCupPath` ShowS
dropDrive (InstallDirResolved -> String
fromInstallDir InstallDirResolved
inst)) InstallDirResolved
inst GHCTargetVersion
tver Bool
forceInstall
      () -> Excepts '[ProcessError, MergeFileTreeError] m ()
forall a. a -> Excepts '[ProcessError, MergeFileTreeError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


mergeGHCFileTree :: ( MonadReader env m
                    , HasPlatformReq env
                    , HasDirs env
                    , HasSettings env
                    , MonadThrow m
                    , HasLog env
                    , MonadIO m
                    , MonadUnliftIO m
                    , MonadMask m
                    , MonadResource m
                    , MonadFail m
                    )
                 => GHCupPath           -- ^ Path to the root of the tree
                 -> InstallDirResolved  -- ^ Path to install to
                 -> GHCTargetVersion    -- ^ The GHC version
                 -> Bool                -- ^ Force install
                 -> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree :: forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree GHCupPath
root InstallDirResolved
inst GHCTargetVersion
tver Bool
forceInstall
  | Bool
isWindows = do
      Excepts '[MergeFileTreeError] m ()
-> Excepts '[MergeFileTreeError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts '[MergeFileTreeError] m ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts '[MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (String -> String -> m ())
-> Excepts '[MergeFileTreeError] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadAsync m, MonadReader env m, HasDirs env,
 HasLog env, MonadCatch m) =>
GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (String -> String -> m ())
-> Excepts '[MergeFileTreeError] m ()
mergeFileTree GHCupPath
root InstallDirResolved
inst Tool
GHC GHCTargetVersion
tver ((String -> String -> m ()) -> Excepts '[MergeFileTreeError] m ())
-> (String -> String -> m ()) -> Excepts '[MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ \String
source String
dest -> do
        Maybe UTCTime
mtime <- IO (Maybe UTCTime) -> m (Maybe UTCTime)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UTCTime) -> m (Maybe UTCTime))
-> IO (Maybe UTCTime) -> m (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe UTCTime) -> IO (Maybe UTCTime) -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
pathIsSymbolicLink String
source) (Maybe UTCTime -> IO (Maybe UTCTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing) (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
source)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forceInstall (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
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
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
recycleFile String
dest
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
moveFilePortable String
source String
dest
        Maybe UTCTime -> (UTCTime -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UTCTime
mtime ((UTCTime -> m ()) -> m ()) -> (UTCTime -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (UTCTime -> IO ()) -> UTCTime -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UTCTime -> IO ()
setModificationTime String
dest
  | Bool
otherwise = do
      Excepts '[MergeFileTreeError] m ()
-> Excepts '[MergeFileTreeError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts '[MergeFileTreeError] m ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts '[MergeFileTreeError] m ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (String -> String -> m ())
-> Excepts '[MergeFileTreeError] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadAsync m, MonadReader env m, HasDirs env,
 HasLog env, MonadCatch m) =>
GHCupPath
-> InstallDirResolved
-> Tool
-> GHCTargetVersion
-> (String -> String -> m ())
-> Excepts '[MergeFileTreeError] m ()
mergeFileTree GHCupPath
root
        InstallDirResolved
inst
        Tool
GHC
        GHCTargetVersion
tver
        (\String
f String
t -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Maybe UTCTime
mtime <- IO Bool
-> IO (Maybe UTCTime) -> IO (Maybe UTCTime) -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
pathIsSymbolicLink String
f) (Maybe UTCTime -> IO (Maybe UTCTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UTCTime
forall a. Maybe a
Nothing) (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
f)
            String -> String -> Bool -> IO ()
install String
f String
t (Bool -> Bool
not Bool
forceInstall)
            Maybe UTCTime -> (UTCTime -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UTCTime
mtime ((UTCTime -> IO ()) -> IO ()) -> (UTCTime -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> UTCTime -> IO ()
setModificationTime String
t)


-- | 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
                 , Alternative m
                 )
              => GHCTargetVersion -- ^ the version to install
              -> InstallDir
              -> Bool            -- ^ force install
              -> [T.Text]        -- ^ additional configure args for bindist
              -> Excepts
                   '[ AlreadyInstalled
                    , BuildFailed
                    , DigestError
                    , ContentLengthError
                    , GPGError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
                    , DirNotEmpty
                    , ArchiveResult
                    , ProcessError
                    , UninstallFailed
                    , MergeFileTreeError
                    , NoCompatiblePlatform
                    , ParseError
                    , UnsupportedSetupCombo
                    , DistroNotFound
                    , NoCompatibleArch
                    ]
                   m
                   ()
installGHCBin :: forall (m :: * -> *) env.
(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,
 Alternative m) =>
GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
       ParseError, UnsupportedSetupCombo, DistroNotFound,
       NoCompatibleArch]
     m
     ()
installGHCBin GHCTargetVersion
tver InstallDir
installDir Bool
forceInstall [Text]
addConfArgs = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
       ParseError, UnsupportedSetupCombo, DistroNotFound,
       NoCompatibleArch]
     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, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
        ParseError, UnsupportedSetupCombo, DistroNotFound,
        NoCompatibleArch]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
       ParseError, UnsupportedSetupCombo, DistroNotFound,
       NoCompatibleArch]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> GHCTargetVersion -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> GHCTargetVersion -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo' Tool
GHC GHCTargetVersion
tver
  Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
    GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
    TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
    UninstallFailed, MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
       ParseError, UnsupportedSetupCombo, DistroNotFound,
       NoCompatibleArch]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
     TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
     UninstallFailed, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
        UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
        ParseError, UnsupportedSetupCombo, DistroNotFound,
        NoCompatibleArch]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
       ParseError, UnsupportedSetupCombo, DistroNotFound,
       NoCompatibleArch]
     m
     ()
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     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
-> GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
       UninstallFailed, MergeFileTreeError]
     m
     ()
installGHCBindist DownloadInfo
dlinfo GHCTargetVersion
tver InstallDir
installDir Bool
forceInstall [Text]
addConfArgs





    ---------------
    --[ Set GHC ]--
    ---------------



-- | 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 :: 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 String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc Maybe String
mBinDir = do
  let verS :: String
verS = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  GHCupPath
ghcdir                        <- m GHCupPath -> Excepts '[NotInstalled] m GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GHCupPath -> Excepts '[NotInstalled] m GHCupPath)
-> m GHCupPath -> Excepts '[NotInstalled] m GHCupPath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
  String
binDir <- case Maybe String
mBinDir of
    Just String
x -> String -> Excepts '[NotInstalled] m String
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
    Maybe String
Nothing -> do
      Dirs {$sel:binDir:Dirs :: Dirs -> String
binDir = String
f} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
      String -> Excepts '[NotInstalled] m String
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
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 String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
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, ...)
  [String]
verfiles <- GHCTargetVersion -> Excepts '[NotInstalled] m [String]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
 MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [String]
ghcToolFiles GHCTargetVersion
ver
  [String]
-> (String -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
verfiles ((String -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (String -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
    Maybe String
mTargetFile <- case SetGHC
sghc of
      SetGHC
SetGHCOnly -> Maybe String -> Excepts '[NotInstalled] m (Maybe String)
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> Excepts '[NotInstalled] m (Maybe String))
-> Maybe String -> Excepts '[NotInstalled] m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
file
      SetGHC
SetGHC_XY  -> do
        (ParseError -> Excepts '[NotInstalled] m (Maybe String))
-> Excepts '[NotInstalled] m (Maybe String)
-> Excepts '[NotInstalled] m (Maybe String)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
            (\(ParseError
e :: ParseError) -> m (Maybe String) -> Excepts '[NotInstalled] m (Maybe String)
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe String) -> Excepts '[NotInstalled] m (Maybe String))
-> m (Maybe String) -> Excepts '[NotInstalled] m (Maybe String)
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 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
e) m () -> m (Maybe String) -> m (Maybe String)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> m (Maybe String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing)
          (Excepts '[NotInstalled] m (Maybe String)
 -> Excepts '[NotInstalled] m (Maybe String))
-> Excepts '[NotInstalled] m (Maybe String)
-> Excepts '[NotInstalled] m (Maybe String)
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 String -> Excepts '[NotInstalled] m (Maybe String)
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> Excepts '[NotInstalled] m (Maybe String))
-> Maybe String -> Excepts '[NotInstalled] m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String
file String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
major')
      SetGHC
SetGHC_XYZ ->
        Maybe String -> Excepts '[NotInstalled] m (Maybe String)
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> Excepts '[NotInstalled] m (Maybe String))
-> Maybe String -> Excepts '[NotInstalled] m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String
file String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
verS)

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

      Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
targetFile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ghc") (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
        IO (Maybe String) -> Excepts '[NotInstalled] m (Maybe String)
forall a. IO a -> Excepts '[NotInstalled] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
isShadowed String
fullF) Excepts '[NotInstalled] m (Maybe String)
-> (Maybe String -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b.
Excepts '[NotInstalled] m a
-> (a -> Excepts '[NotInstalled] m b)
-> Excepts '[NotInstalled] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe String
Nothing -> () -> Excepts '[NotInstalled] m ()
forall a. a -> Excepts '[NotInstalled] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just String
pa -> m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ToolShadowed -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError (Tool -> String -> String -> Version -> ToolShadowed
ToolShadowed Tool
GHC String
pa String
fullF (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver))

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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
$ String -> String -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadCatch m, MonadMask m) =>
String -> String -> m ()
symlinkShareDir (GHCupPath -> String
fromGHCupPath GHCupPath
ghcdir) String
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 a. a -> Excepts '[NotInstalled] m a
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 :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadCatch m, MonadMask m) =>
String -> String -> m ()
symlinkShareDir String
ghcdir String
ver' = do
    Dirs {String
GHCupPath
$sel:binDir:Dirs :: Dirs -> String
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> String
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
    let destdir :: String
destdir = GHCupPath -> String
fromGHCupPath GHCupPath
baseDir
    case SetGHC
sghc of
      SetGHC
SetGHCOnly -> do
        let sharedir :: String
sharedir     = String
"share"
        let fullsharedir :: String
fullsharedir = String
ghcdir String -> ShowS
</> String
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
<> String -> Text
T.pack String
fullsharedir
        m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> m Bool
forall a. IO a -> m a
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
$ String -> IO Bool
doesDirectoryExist String
fullsharedir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          let fullF :: String
fullF   = String
destdir String -> ShowS
</> String
sharedir
          let targetF :: String
targetF = String
"." String -> ShowS
</> String
"ghc" String -> ShowS
</> String
ver' String -> ShowS
</> String
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
<> String -> Text
T.pack String
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
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
rmDirectoryLink String
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
<> String -> Text
T.pack String
targetF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fullF

          if Bool
isWindows
          then IO () -> m ()
forall a. IO a -> m a
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
$ String -> String -> IO ()
createDirectoryLink String
targetF String
fullF
          else IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                 (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
createDirectoryLink String
targetF String
fullF
      SetGHC
_ -> () -> m ()
forall a. a -> m a
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 :: forall env (m :: * -> *).
(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 ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC





    --------------
    --[ GHC 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, UninstallFailed] m ()
rmGHCVer :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
 MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled, UninstallFailed] m ()
rmGHCVer GHCTargetVersion
ver = do
  Bool
isSetGHC <- m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool)
-> m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall a b. (a -> b) -> a -> b
$ (Maybe GHCTargetVersion -> Bool)
-> m (Maybe GHCTargetVersion) -> m Bool
forall a b. (a -> b) -> m a -> m b
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, UninstallFailed] m Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool)
-> m Bool -> Excepts '[NotInstalled, UninstallFailed] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> m a -> m b
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, UninstallFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))

  -- this isn't atomic, order matters
  Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
    m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc symlinks"
    Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] 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, UninstallFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc-x.y.z symlinks"
  Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] 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, UninstallFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing/rewiring ghc-x.y symlinks"
  -- first remove
  (ParseError -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
_ :: ParseError) -> () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a. a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ 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)

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

  Maybe (Int, Int)
v' <-
    (ParseError
 -> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
-> Excepts '[NotInstalled, UninstallFailed] 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, UninstallFailed] m (Maybe (Int, Int))
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Int, Int))
 -> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int)))
-> m (Maybe (Int, Int))
-> Excepts '[NotInstalled, UninstallFailed] 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 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int)
forall a. Maybe a
Nothing)
    (Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
 -> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Maybe (Int, Int))
-> Excepts '[NotInstalled, UninstallFailed] m (Int, Int)
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
forall a b.
(a -> b)
-> Excepts '[NotInstalled, UninstallFailed] m a
-> Excepts '[NotInstalled, UninstallFailed] m b
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, UninstallFailed] m (Int, Int)
 -> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled, UninstallFailed] m (Int, Int)
-> Excepts '[NotInstalled, UninstallFailed] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled, UninstallFailed] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  Maybe (Int, Int)
-> ((Int, Int) -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] 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, UninstallFailed] m ())
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> ((Int, Int) -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts
     '[NotInstalled, UninstallFailed] m (Maybe GHCTargetVersion)
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
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, UninstallFailed] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion
    -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b.
Excepts '[NotInstalled, UninstallFailed] m a
-> (a -> Excepts '[NotInstalled, UninstallFailed] m b)
-> Excepts '[NotInstalled, UninstallFailed] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion
 -> Excepts '[NotInstalled, UninstallFailed] m GHCTargetVersion)
-> Maybe GHCTargetVersion
-> Excepts '[NotInstalled, UninstallFailed] 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, UninstallFailed] 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, UninstallFailed] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled, UninstallFailed] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe String
-> 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 String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe String
forall a. Maybe a
Nothing)

  Dirs {String
GHCupPath
$sel:binDir:Dirs :: Dirs -> String
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> String
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
..} <- m Dirs -> Excepts '[NotInstalled, UninstallFailed] m Dirs
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  Bool
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled, UninstallFailed] m ()
 -> Excepts '[NotInstalled, UninstallFailed] m ())
-> Excepts '[NotInstalled, UninstallFailed] m ()
-> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
    m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled, UninstallFailed] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled, UninstallFailed] m ())
-> m () -> Excepts '[NotInstalled, UninstallFailed] m ()
forall a b. (a -> b) -> a -> b
$ 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
$ String -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
String -> m ()
rmDirectoryLink (GHCupPath -> String
fromGHCupPath GHCupPath
baseDir String -> ShowS
</> String
"share")




    ---------------
    --[ 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
              )
           => GHCVer
           -> Maybe Text               -- ^ cross target
           -> Maybe [VersionPattern]
           -> 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
           -> Maybe BuildSystem
           -> InstallDir
           -> Excepts
                '[ AlreadyInstalled
                 , BuildFailed
                 , DigestError
                 , ContentLengthError
                 , GPGError
                 , DownloadFailed
                 , GHCupSetError
                 , NoDownload
                 , NotFoundInPATH
                 , PatchFailed
                 , UnknownArchive
                 , TarDirDoesNotExist
                 , NotInstalled
                 , DirNotEmpty
                 , ArchiveResult
                 , FileDoesNotExistError
                 , HadrianNotFound
                 , InvalidBuildConfig
                 , ProcessError
                 , CopyError
                 , BuildFailed
                 , UninstallFailed
                 , MergeFileTreeError
                 ]
                m
                GHCTargetVersion
compileGHC :: forall (m :: * -> *) env.
(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) =>
GHCVer
-> Maybe Text
-> Maybe [VersionPattern]
-> Either Version String
-> Maybe Int
-> Maybe String
-> Maybe (Either String [URI])
-> [Text]
-> Maybe String
-> Maybe BuildSystem
-> InstallDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCTargetVersion
compileGHC GHCVer
targetGhc Maybe Text
crossTarget Maybe [VersionPattern]
vps Either Version String
bstrap Maybe Int
jobs Maybe String
mbuildConfig Maybe (Either String [URI])
patches [Text]
aargs Maybe String
buildFlavour Maybe BuildSystem
buildSystem InstallDir
installDir
  = do
    pfreq :: PlatformRequest
pfreq@PlatformRequest { Maybe Versioning
Platform
Architecture
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
.. } <- m PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     PlatformRequest
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupInfo
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
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

    (GHCupPath
workdir, GHCupPath
tmpUnpack, Maybe GHCTargetVersion
tver, Maybe Version
ov) <- case GHCVer
targetGhc of
      -- unpack from version tarball
      SourceDist Version
ver -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text)
-> (String -> Text) -> Either Version String -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Text
prettyVer String -> Text
T.pack Either Version String
bstrap

        -- download source tarball
        let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
ver
        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 GHCTargetVersion VersionInfo)
  (Map GHCTargetVersion VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map GHCTargetVersion VersionInfo)
     (Map GHCTargetVersion 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 GHCTargetVersion VersionInfo)
-> Optic'
     (IxKind (Map GHCTargetVersion VersionInfo))
     '[]
     (Map GHCTargetVersion VersionInfo)
     (IxValue (Map GHCTargetVersion VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map GHCTargetVersion VersionInfo)
GHCTargetVersion
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
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? GHCTargetVersion -> Tool -> Maybe PlatformRequest -> NoDownload
NoDownload GHCTargetVersion
tver Tool
GHC (PlatformRequest -> Maybe PlatformRequest
forall a. a -> Maybe a
Just PlatformRequest
pfreq)
        String
dl <- Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     String
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe String
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
downloadCached DownloadInfo
dlInfo Maybe String
forall a. Maybe a
Nothing

        -- unpack
        GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
        Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError GHCupPath
tmpUnpack (String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
dl)
        Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), HFErrorProject (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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> String -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> String -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (String -> m (Either ProcessError ()))
-> String -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack

        GHCupPath
workdir <- Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
    GPGError, DownloadFailed, GHCupSetError, NoDownload,
    NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
    NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
    HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
    BuildFailed, UninstallFailed, MergeFileTreeError]
  m
  GHCupPath
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
           GPGError, DownloadFailed, GHCupSetError, NoDownload,
           NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
           NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
           HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
           BuildFailed, UninstallFailed, MergeFileTreeError]
         m
         GHCupPath)
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCupPath
tmpUnpack)
                         (Excepts '[TarDirDoesNotExist] m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m GHCupPath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      GHCupPath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath)
-> TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCupPath -> TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
GHCupPath -> TarDir -> Excepts '[TarDirDoesNotExist] m GHCupPath
intoSubdir GHCupPath
tmpUnpack)
                         (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
        Excepts
  '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
    GPGError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
     GPGError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       GPGError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either String [URI])
-> String
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       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 String [URI])
-> String
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       GPGError]
     m
     ()
applyAnyPatch Maybe (Either String [URI])
patches (GHCupPath -> String
fromGHCupPath GHCupPath
workdir)

        Maybe Version
ov <- case Maybe [VersionPattern]
vps of
                Just [VersionPattern]
vps' -> (Version -> Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a b.
(a -> b)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Maybe Version
forall a. a -> Maybe a
Just (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   Version
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe Version))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
forall (m :: * -> *).
MonadFail m =>
Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> m Version
expandVersionPattern (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver) String
"" String
"" String
"" String
"" [VersionPattern]
vps'
                Maybe [VersionPattern]
Nothing   -> Maybe Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing

        (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
workdir, GHCupPath
tmpUnpack, GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
crossTarget Version
ver), Maybe Version
ov)

      RemoteDist URI
uri -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile (from uri): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (URI -> String
forall a. Show a => a -> String
show URI
uri)

        -- download source tarball
        GHCupPath
tmpDownload <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
m GHCupPath
withGHCupTmpDir
        GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
        String
tar <- Excepts
  '[DigestError, ContentLengthError, DownloadFailed, GPGError]
  m
  String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[DigestError, ContentLengthError, DownloadFailed, GPGError]
   m
   String
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      String)
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     String
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> Maybe Integer
-> String
-> Maybe String
-> Bool
-> Excepts
     '[DigestError, ContentLengthError, DownloadFailed, GPGError]
     m
     String
download URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing (GHCupPath -> String
fromGHCupPath GHCupPath
tmpDownload) Maybe String
forall a. Maybe a
Nothing Bool
False
        (String
bf, Maybe Version
tver) <- Excepts
  '[UnknownArchive, ArchiveResult, ProcessError]
  m
  (String, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (String, Maybe Version)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
   '[UnknownArchive, ArchiveResult, ProcessError]
   m
   (String, Maybe Version)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (String, Maybe Version))
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError]
     m
     (String, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (String, Maybe Version)
forall a b. (a -> b) -> a -> b
$ forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] GHCupPath
tmpUnpack (Excepts
   '[UnknownArchive, ArchiveResult, ProcessError]
   m
   (String, Maybe Version)
 -> Excepts
      '[UnknownArchive, ArchiveResult, ProcessError]
      m
      (String, Maybe Version))
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError]
     m
     (String, Maybe Version)
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError]
     m
     (String, Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
          Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, 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 '[UnknownArchive, ArchiveResult, ProcessError] m ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult, ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
String -> String -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
tar
          let regex :: ByteString
regex = [s|^(.*/)*boot$|] :: B.ByteString
          [String
bootFile] <- IO [String]
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError] m [String]
forall a.
IO a -> Excepts '[UnknownArchive, ArchiveResult, ProcessError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String]
 -> Excepts
      '[UnknownArchive, ArchiveResult, ProcessError] m [String])
-> IO [String]
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError] m [String]
forall a b. (a -> b) -> a -> b
$ GHCupPath -> Regex -> IO [String]
findFilesDeep
            GHCupPath
tmpUnpack
            (CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
                           ExecOption
execBlank
                           ByteString
regex
            )
          Maybe Version
tver <- Excepts '[] m (Maybe Version)
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError] m (Maybe Version)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m (Maybe Version)
 -> Excepts
      '[UnknownArchive, ArchiveResult, ProcessError] m (Maybe Version))
-> Excepts '[] m (Maybe Version)
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError] m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @'[ProcessError, ParseError] @'[] (\V '[ProcessError, ParseError]
_ -> Maybe Version -> Excepts '[] m (Maybe Version)
forall a. a -> Excepts '[] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing) (Excepts '[ProcessError, ParseError] m (Maybe Version)
 -> Excepts '[] m (Maybe Version))
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
-> Excepts '[] m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Version -> Maybe Version)
-> Excepts '[ProcessError, ParseError] m Version
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
forall a b.
(a -> b)
-> Excepts '[ProcessError, ParseError] m a
-> Excepts '[ProcessError, ParseError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Maybe Version
forall a. a -> Maybe a
Just (Excepts '[ProcessError, ParseError] m Version
 -> Excepts '[ProcessError, ParseError] m (Maybe Version))
-> Excepts '[ProcessError, ParseError] m Version
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ GHCupPath -> Excepts '[ProcessError, ParseError] m Version
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
GHCupPath -> Excepts '[ProcessError, ParseError] m Version
getGHCVer
            (GHCupPath -> String -> GHCupPath
appendGHCupPath GHCupPath
tmpUnpack (ShowS
takeDirectory String
bootFile))
          (String, Maybe Version)
-> Excepts
     '[UnknownArchive, ArchiveResult, ProcessError]
     m
     (String, Maybe Version)
forall a.
a -> Excepts '[UnknownArchive, ArchiveResult, ProcessError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
bootFile, Maybe Version
tver)

        let workdir :: GHCupPath
workdir = GHCupPath -> String -> GHCupPath
appendGHCupPath GHCupPath
tmpUnpack (ShowS
takeDirectory String
bf)

        Maybe Version
ov <- case Maybe [VersionPattern]
vps of
                Just [VersionPattern]
vps' -> (Version -> Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a b.
(a -> b)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Maybe Version
forall a. a -> Maybe a
Just (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   Version
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe Version))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Version
forall (m :: * -> *).
MonadFail m =>
Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> m Version
expandVersionPattern Maybe Version
tver String
"" String
"" String
"" String
"" [VersionPattern]
vps'
                Maybe [VersionPattern]
Nothing   -> Maybe Version
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version)
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing

        (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
workdir, GHCupPath
tmpUnpack, Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
crossTarget (Version -> GHCTargetVersion)
-> Maybe Version -> Maybe GHCTargetVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
tver, Maybe Version
ov)

      -- clone from git
      GitDist GitBranch{String
Maybe String
ref :: String
repo :: Maybe String
$sel:ref:GitBranch :: GitBranch -> String
$sel:repo:GitBranch :: GitBranch -> Maybe String
..} -> do
        GHCupPath
tmpUnpack <- m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m GHCupPath
mkGhcupTmpDir
        let git :: [String] -> m (Either ProcessError ())
git [String]
args = String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged String
"git" (String
"--no-pager"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
"git" Maybe [(String, String)]
forall a. Maybe a
Nothing
        (Maybe Version
tver, Maybe Version
ov) <- GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version, Maybe Version)
forall (e :: [*]) (m :: * -> *) a env.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
cleanUpOnError GHCupPath
tmpUnpack (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   (Maybe Version, Maybe Version)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe Version, Maybe Version))
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version, Maybe Version)
forall a b. (a -> b) -> a -> b
$ 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, ContentLengthError, DownloadFailed, GPGError] V '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
    ContentLengthError, DownloadFailed, GPGError]
-> DownloadFailed
forall (xs :: [*]).
(HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs,
 PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts
   '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
     ContentLengthError, DownloadFailed, GPGError]
   m
   (Maybe Version, Maybe Version)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe Version, Maybe Version))
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe Version, Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
          let rep :: String
rep = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"https://gitlab.haskell.org/ghc/ghc.git" Maybe String
repo
          m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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
<> String -> Text
T.pack String
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
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,
       ContentLengthError, 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,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> m (Either ProcessError ())
git [ String
"init" ]
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> m (Either ProcessError ())
git [ String
"remote"
                    , String
"add"
                    , String
"origin"
                    , ShowS
forall a. IsString a => String -> a
fromString String
rep ]

          -- figure out if we can do a shallow clone
          [String]
remoteBranches <- forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(ProcessError
_ :: ProcessError) -> [String]
-> Excepts
     '[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed,
       GPGError]
     m
     [String]
forall a.
a
-> Excepts
     '[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed,
       GPGError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
              (Excepts '[ProcessError] m [String]
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      [String])
-> Excepts '[ProcessError] m [String]
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     [String]
forall a b. (a -> b) -> a -> b
$ (Text -> [String])
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m [String]
forall a b.
(a -> b)
-> Excepts '[ProcessError] m a -> Excepts '[ProcessError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [String]
processBranches (Excepts '[ProcessError] m Text
 -> Excepts '[ProcessError] m [String])
-> Excepts '[ProcessError] m Text
-> Excepts '[ProcessError] m [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[String] -> String -> Excepts '[ProcessError] m Text
gitOut [String
"ls-remote", String
"--heads", String
"origin"] (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)
          let shallow_clone :: Bool
shallow_clone
                | String -> Bool
isCommitHash String
ref                     = Bool
True
                | ShowS
forall a. IsString a => String -> a
fromString String
ref String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
remoteBranches = Bool
True
                | Bool
otherwise                            = Bool
False
          m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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 ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Shallow clone: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
shallow_clone)

          -- fetch
          let fetch_args :: [String]
fetch_args
                | Bool
shallow_clone = [String
"fetch", String
"--depth", String
"1", String
"--quiet", String
"origin", ShowS
forall a. IsString a => String -> a
fromString String
ref]
                | Bool
otherwise     = [String
"fetch", String
"--tags",       String
"--quiet", String
"origin"                ]
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> m (Either ProcessError ())
git [String]
fetch_args

          -- initial checkout
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> m (Either ProcessError ())
git [ String
"checkout", ShowS
forall a. IsString a => String -> a
fromString String
ref ]

          -- gather some info
          Maybe Text
git_describe <- if Bool
shallow_clone
                          then Maybe Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Text)
forall a.
a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
                          else (Text -> Maybe Text)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Text)
forall a b.
(a -> b)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (Excepts
   '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
     ContentLengthError, DownloadFailed, GPGError]
   m
   Text
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      (Maybe Text))
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m Text
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      Text)
-> Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall a b. (a -> b) -> a -> b
$ [String] -> String -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[String] -> String -> Excepts '[ProcessError] m Text
gitOut [String
"describe", String
"--tags"] (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)
          Text
chash <- Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m Text
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      Text)
-> Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall a b. (a -> b) -> a -> b
$ [String] -> String -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[String] -> String -> Excepts '[ProcessError] m Text
gitOut [String
"rev-parse", String
"HEAD" ] (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)
          Text
branch <- Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m Text
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      Text)
-> Excepts '[ProcessError] m Text
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Text
forall a b. (a -> b) -> a -> b
$ [String] -> String -> Excepts '[ProcessError] m Text
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
[String] -> String -> Excepts '[ProcessError] m Text
gitOut [String
"rev-parse", String
"--abbrev-ref", String
"HEAD" ] (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)

          -- clone submodules
          m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> m (Either ProcessError ())
git [ String
"submodule", String
"update", String
"--init", String
"--depth", String
"1" ]

          -- apply patches
          Excepts
  '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
    GPGError]
  m
  ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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, ContentLengthError,
     GPGError]
   m
   ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       GPGError]
     m
     ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either String [URI])
-> String
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       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 String [URI])
-> String
-> Excepts
     '[PatchFailed, DownloadFailed, DigestError, ContentLengthError,
       GPGError]
     m
     ()
applyAnyPatch Maybe (Either String [URI])
patches (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)

          -- bootstrap
          Maybe Version
tver <- Excepts '[] m (Maybe Version)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m (Maybe Version)
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      (Maybe Version))
-> Excepts '[] m (Maybe Version)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE @_ @'[ProcessError, ParseError] @'[] (\V '[ProcessError, ParseError]
_ -> Maybe Version -> Excepts '[] m (Maybe Version)
forall a. a -> Excepts '[] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing) (Excepts '[ProcessError, ParseError] m (Maybe Version)
 -> Excepts '[] m (Maybe Version))
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
-> Excepts '[] m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ (Version -> Maybe Version)
-> Excepts '[ProcessError, ParseError] m Version
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
forall a b.
(a -> b)
-> Excepts '[ProcessError, ParseError] m a
-> Excepts '[ProcessError, ParseError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Maybe Version
forall a. a -> Maybe a
Just (Excepts '[ProcessError, ParseError] m Version
 -> Excepts '[ProcessError, ParseError] m (Maybe Version))
-> Excepts '[ProcessError, ParseError] m Version
-> Excepts '[ProcessError, ParseError] m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ GHCupPath -> Excepts '[ProcessError, ParseError] m Version
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
GHCupPath -> Excepts '[ProcessError, ParseError] m Version
getGHCVer
            GHCupPath
tmpUnpack
          Excepts '[] m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), HFErrorProject (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
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> String -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> String -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform (GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)
          m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, 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
"Examining git ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
"GHC version (from Makefile): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Maybe Text -> String
forall a. Show a => a -> String
show (Version -> Text
prettyVer (Version -> Text) -> Maybe Version -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
tver)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           (if Bool -> Bool
not Bool
shallow_clone then Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'git describe' output: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
git_describe else Text
forall a. Monoid a => a
mempty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           (if String -> Bool
isCommitHash String
ref then Text
forall a. Monoid a => a
mempty else Text
"\n  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"commit hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
chash)
          IO ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a.
IO a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      ())
-> IO ()
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000 -- give the user a sec to intervene

          Maybe Version
ov <- case Maybe [VersionPattern]
vps of
                  Just [VersionPattern]
vps' -> (Version -> Maybe Version)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Version
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version)
forall a b.
(a -> b)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> Maybe Version
forall a. a -> Maybe a
Just (Excepts
   '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
     ContentLengthError, DownloadFailed, GPGError]
   m
   Version
 -> Excepts
      '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
        ContentLengthError, DownloadFailed, GPGError]
      m
      (Maybe Version))
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Version
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     Version
forall (m :: * -> *).
MonadFail m =>
Maybe Version
-> String
-> String
-> String
-> String
-> [VersionPattern]
-> m Version
expandVersionPattern
                                             Maybe Version
tver
                                             (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
7 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
chash)
                                             (Text -> String
T.unpack Text
chash)
                                             (String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Text -> String
T.unpack Maybe Text
git_describe)
                                             (Text -> String
T.unpack Text
branch)
                                             [VersionPattern]
vps'
                  Maybe [VersionPattern]
Nothing -> Maybe Version
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version)
forall a.
a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing

          (Maybe Version, Maybe Version)
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     (Maybe Version, Maybe Version)
forall a.
a
-> Excepts
     '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
       ContentLengthError, DownloadFailed, GPGError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version
tver, Maybe Version
ov)

        (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (GHCupPath, GHCupPath, Maybe GHCTargetVersion, Maybe Version)
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GHCupPath
tmpUnpack, GHCupPath
tmpUnpack, Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
crossTarget (Version -> GHCTargetVersion)
-> Maybe Version -> Maybe GHCTargetVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
tver, Maybe Version
ov)
    -- the version that's installed may differ from the
    -- compiled version, so the user can overwrite it
    GHCTargetVersion
installVer <- if | Just Version
ov'   <- Maybe Version
ov   -> GHCTargetVersion
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCTargetVersion
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
crossTarget Version
ov')
                     | Just GHCTargetVersion
tver' <- Maybe GHCTargetVersion
tver -> GHCTargetVersion
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCTargetVersion
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
tver'
                     | Bool
otherwise          -> String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCTargetVersion
forall a.
String
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No GHC version given and couldn't detect version. Giving up..."

    Bool
alreadyInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Bool
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Bool
forall a b.
(a -> b)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     b
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, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      Bool)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe GHCTargetVersion)
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
      case InstallDir
installDir of
        IsolateDir String
isoDir ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCTargetVersion -> String
forall a. Pretty a => a -> String
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
<> String -> Text
T.pack String
isoDir
        InstallDir
GHCupInternal ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCTargetVersion -> String
forall a. Pretty a => a -> String
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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
        Text
"...waiting for 10 seconds before continuing, you can still abort..."
      IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a.
IO a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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 String
isoDir -> InstallDirResolved
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     InstallDirResolved
forall a.
a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallDirResolved
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      InstallDirResolved)
-> InstallDirResolved
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     InstallDirResolved
forall a b. (a -> b) -> a -> b
$ String -> InstallDirResolved
IsolateDirResolved String
isoDir
      InstallDir
GHCupInternal -> GHCupPath -> InstallDirResolved
GHCupDir (GHCupPath -> InstallDirResolved)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     InstallDirResolved
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m GHCupPath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCTargetVersion -> m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m GHCupPath
ghcupGHCDir GHCTargetVersion
installVer)

    Maybe String
mBindist <- Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
    CopyError]
  m
  (Maybe String)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe String)
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, MergeFileTreeError,
     CopyError]
   m
   (Maybe String)
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      (Maybe String))
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     (Maybe String)
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
 MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
 MonadCatch m) =>
GHCupPath -> Excepts e m a -> Excepts e m a
runBuildAction
      GHCupPath
tmpUnpack
      (do
        -- prefer 'tver', because the real version carries out compatibility checks
        -- we don't want the user to do funny things with it
        let doHadrian :: Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, CopyError]
  m
  (Maybe String)
doHadrian = GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe String)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe String)
compileHadrianBindist (GHCTargetVersion -> Maybe GHCTargetVersion -> GHCTargetVersion
forall a. a -> Maybe a -> a
fromMaybe GHCTargetVersion
installVer Maybe GHCTargetVersion
tver) (GHCupPath -> String
fromGHCupPath GHCupPath
workdir) InstallDirResolved
ghcdir
            doMake :: Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
    CopyError]
  m
  (Maybe String)
doMake    = GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m,
 MonadResource m) =>
GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
compileMakeBindist (GHCTargetVersion -> Maybe GHCTargetVersion -> GHCTargetVersion
forall a. a -> Maybe a -> a
fromMaybe GHCTargetVersion
installVer Maybe GHCTargetVersion
tver) (GHCupPath -> String
fromGHCupPath GHCupPath
workdir) InstallDirResolved
ghcdir
        case Maybe BuildSystem
buildSystem of
          Just BuildSystem
Hadrian -> do
            m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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
"Requested to use Hadrian"
            Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, CopyError]
  m
  (Maybe String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
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 String)
doHadrian
          Just BuildSystem
Make -> do
            m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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
"Requested to use Make"
            Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
    CopyError]
  m
  (Maybe String)
doMake
          Maybe BuildSystem
Nothing -> do
            Bool
supportsHadrian <- Excepts '[HadrianNotFound] m Bool
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     Bool
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[HadrianNotFound] m Bool
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      Bool)
-> Excepts '[HadrianNotFound] m Bool
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\HadrianNotFound
_ -> Bool -> Excepts '[] m Bool
forall a. a -> Excepts '[] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                                 (Excepts '[HadrianNotFound] m Bool
 -> Excepts '[HadrianNotFound] m Bool)
-> Excepts '[HadrianNotFound] m Bool
-> Excepts '[HadrianNotFound] m Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool)
-> Excepts '[HadrianNotFound] m String
-> Excepts '[HadrianNotFound] m Bool
forall a b.
(a -> b)
-> Excepts '[HadrianNotFound] m a -> Excepts '[HadrianNotFound] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True)
                                 (Excepts '[HadrianNotFound] m String
 -> Excepts '[HadrianNotFound] m Bool)
-> Excepts '[HadrianNotFound] m String
-> Excepts '[HadrianNotFound] m Bool
forall a b. (a -> b) -> a -> b
$ String -> Excepts '[HadrianNotFound] m String
forall (m :: * -> *).
MonadIO m =>
String -> Excepts '[HadrianNotFound] m String
findHadrianFile (GHCupPath -> String
fromGHCupPath GHCupPath
workdir)
            if Bool
supportsHadrian
            then do
              m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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
"Detected Hadrian"
              Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, CopyError]
  m
  (Maybe String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
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 String)
doHadrian
            else do
              m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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
"Detected Make"
              Excepts
  '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
    PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
    CopyError]
  m
  (Maybe String)
doMake
      )

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

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

    Maybe String
-> (String
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
           GPGError, DownloadFailed, GHCupSetError, NoDownload,
           NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
           NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
           HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
           BuildFailed, UninstallFailed, MergeFileTreeError]
         m
         ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
mBindist ((String
  -> Excepts
       '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
         GPGError, DownloadFailed, GHCupSetError, NoDownload,
         NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
         NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
         HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
         BuildFailed, UninstallFailed, MergeFileTreeError]
       m
       ())
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> (String
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
           GPGError, DownloadFailed, GHCupSetError, NoDownload,
           NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
           NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
           HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
           BuildFailed, UninstallFailed, MergeFileTreeError]
         m
         ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \String
bindist -> do
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult, ProcessError, MergeFileTreeError]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     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, MonadResource m) =>
String
-> Maybe TarDir
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> [Text]
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult, ProcessError, MergeFileTreeError]
     m
     ()
installPackedGHC String
bindist
                               (TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (TarDir -> Maybe TarDir) -> TarDir -> Maybe TarDir
forall a b. (a -> b) -> a -> b
$ String -> TarDir
RegexDir String
"ghc-.*")
                               InstallDirResolved
ghcdir
                               GHCTargetVersion
installVer
                               Bool
False       -- not a force install, since we already overwrite when compiling.
                               []

    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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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), HFErrorProject (V es)) =>
V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
     GPGError, DownloadFailed, GHCupSetError, NoDownload,
     NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
     NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
     HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
     BuildFailed, UninstallFailed, MergeFileTreeError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
        GPGError, DownloadFailed, GHCupSetError, NoDownload,
        NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
        NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
        HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
        BuildFailed, UninstallFailed, MergeFileTreeError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
       GPGError, DownloadFailed, GHCupSetError, NoDownload,
       NotFoundInPATH, PatchFailed, UnknownArchive, TarDirDoesNotExist,
       NotInstalled, DirNotEmpty, ArchiveResult, FileDoesNotExistError,
       HadrianNotFound, InvalidBuildConfig, ProcessError, CopyError,
       BuildFailed, UninstallFailed, MergeFileTreeError]
     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 String
-> 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 String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
installVer SetGHC
SetGHCOnly Maybe String
forall a. Maybe a
Nothing

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

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

 where
  getGHCVer :: ( MonadReader env m
               , HasSettings env
               , HasDirs env
               , HasLog env
               , MonadIO m
               , MonadThrow m
               )
            => GHCupPath
            -> Excepts '[ProcessError, ParseError] m Version
  getGHCVer :: forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
GHCupPath -> Excepts '[ProcessError, ParseError] m Version
getGHCVer GHCupPath
tmpUnpack = do
    m (Either ProcessError ())
-> Excepts '[ProcessError, ParseError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts '[ProcessError, ParseError] m ())
-> m (Either ProcessError ())
-> Excepts '[ProcessError, ParseError] m ()
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged String
"python3" [String
"./boot"] (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
"ghc-bootstrap" Maybe [(String, String)]
forall a. Maybe a
Nothing
    m (Either ProcessError ())
-> Excepts '[ProcessError, ParseError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts '[ProcessError, ParseError] m ())
-> m (Either ProcessError ())
-> Excepts '[ProcessError, ParseError] m ()
forall a b. (a -> b) -> a -> b
$ Maybe GHCTargetVersion
-> [String] -> Maybe String -> String -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
Maybe GHCTargetVersion
-> [String] -> Maybe String -> String -> m (Either ProcessError ())
configureWithGhcBoot Maybe GHCTargetVersion
forall a. Maybe a
Nothing [] (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack) String
"ghc-bootstrap"
    let versionFile :: String
versionFile = GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack String -> ShowS
</> String
"VERSION"
    Bool
hasVersionFile <- IO Bool -> Excepts '[ProcessError, ParseError] m Bool
forall a. IO a -> Excepts '[ProcessError, ParseError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[ProcessError, ParseError] m Bool)
-> IO Bool -> Excepts '[ProcessError, ParseError] m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
versionFile
    if Bool
hasVersionFile
    then do
      m () -> Excepts '[ProcessError, ParseError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, ParseError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError, ParseError] m ())
-> m () -> Excepts '[ProcessError, ParseError] 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
"Detected VERSION file, trying to extract"
      String
contents <- IO String -> Excepts '[ProcessError, ParseError] m String
forall a. IO a -> Excepts '[ProcessError, ParseError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Excepts '[ProcessError, ParseError] m String)
-> IO String -> Excepts '[ProcessError, ParseError] m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
versionFile
      (ParseErrorBundle Text Void
 -> Excepts '[ProcessError, ParseError] m Version)
-> (Version -> Excepts '[ProcessError, ParseError] m Version)
-> Either (ParseErrorBundle Text Void) Version
-> Excepts '[ProcessError, ParseError] m Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Excepts '[ProcessError, ParseError] m Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ParseError -> Excepts '[ProcessError, ParseError] m Version)
-> (ParseErrorBundle Text Void -> ParseError)
-> ParseErrorBundle Text Void
-> Excepts '[ProcessError, ParseError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError (String -> ParseError)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> ParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show) Version -> Excepts '[ProcessError, ParseError] m Version
forall a. a -> Excepts '[ProcessError, ParseError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) Version
 -> Excepts '[ProcessError, ParseError] m Version)
-> (String -> Either (ParseErrorBundle Text Void) Version)
-> String
-> Excepts '[ProcessError, ParseError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> String -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
version' String
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripNewlineEnd (String -> Excepts '[ProcessError, ParseError] m Version)
-> String -> Excepts '[ProcessError, ParseError] m Version
forall a b. (a -> b) -> a -> b
$ String
contents
    else do
      m () -> Excepts '[ProcessError, ParseError] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, ParseError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError, ParseError] m ())
-> m () -> Excepts '[ProcessError, ParseError] 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
"Didn't detect VERSION file, trying to extract via legacy 'make'"
      CapturedProcess {ExitCode
ByteString
_exitCode :: ExitCode
_stdOut :: ByteString
_stdErr :: ByteString
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
$sel:_stdOut:CapturedProcess :: CapturedProcess -> ByteString
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
..} <- m CapturedProcess
-> Excepts '[ProcessError, ParseError] m CapturedProcess
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ProcessError, ParseError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
 -> Excepts '[ProcessError, ParseError] m CapturedProcess)
-> m CapturedProcess
-> Excepts '[ProcessError, ParseError] m CapturedProcess
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> m CapturedProcess
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
[String] -> Maybe String -> m CapturedProcess
makeOut
        [String
"show!", String
"--quiet", String
"VALUE=ProjectVersion" ] (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GHCupPath -> String
fromGHCupPath GHCupPath
tmpUnpack)
      case ExitCode
_exitCode of
        ExitCode
ExitSuccess -> (ParseErrorBundle Text Void
 -> Excepts '[ProcessError, ParseError] m Version)
-> (Version -> Excepts '[ProcessError, ParseError] m Version)
-> Either (ParseErrorBundle Text Void) Version
-> Excepts '[ProcessError, ParseError] m Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Excepts '[ProcessError, ParseError] m Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ParseError -> Excepts '[ProcessError, ParseError] m Version)
-> (ParseErrorBundle Text Void -> ParseError)
-> ParseErrorBundle Text Void
-> Excepts '[ProcessError, ParseError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError (String -> ParseError)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> ParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show) Version -> Excepts '[ProcessError, ParseError] m Version
forall a. a -> Excepts '[ProcessError, ParseError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (ParseErrorBundle Text Void) Version
 -> Excepts '[ProcessError, ParseError] m Version)
-> (ByteString -> Either (ParseErrorBundle Text Void) Version)
-> ByteString
-> Excepts '[ProcessError, ParseError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> String -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
ghcProjectVersion String
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripNewlineEnd ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString -> Excepts '[ProcessError, ParseError] m Version)
-> ByteString -> Excepts '[ProcessError, ParseError] m Version
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut
        ExitFailure Int
c -> ProcessError -> Excepts '[ProcessError, ParseError] m Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ProcessError -> Excepts '[ProcessError, ParseError] m Version)
-> ProcessError -> Excepts '[ProcessError, ParseError] m Version
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String] -> ProcessError
NonZeroExit Int
c String
"make" [String
"show!", String
"--quiet", String
"VALUE=ProjectVersion" ]

  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 Maybe Text
crossTarget of
         Just Text
_ -> Text
cross_mk
         Maybe Text
_      -> 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 :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe String)
compileHadrianBindist GHCTargetVersion
tver String
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
-> String
-> 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
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver String
workdir InstallDirResolved
ghcdir

    m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     a
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 -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Building GHC version " 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
" (this may take a while)..."
    String
hadrian_build <- Excepts '[HadrianNotFound] m String
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[HadrianNotFound] m String
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      String)
-> Excepts '[HadrianNotFound] m String
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     String
forall a b. (a -> b) -> a -> b
$ String -> Excepts '[HadrianNotFound] m String
forall (m :: * -> *).
MonadIO m =>
String -> Excepts '[HadrianNotFound] m String
findHadrianFile String
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
$ String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged String
hadrian_build
                          ( [String] -> (Int -> [String]) -> Maybe Int -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j  -> [String
"-j" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
j]         ) Maybe Int
jobs
                         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
bf -> [String
"--flavour=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
bf]) Maybe String
buildFlavour
                         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"binary-dist"]
                          )
                          (String -> Maybe String
forall a. a -> Maybe a
Just String
workdir) String
"ghc-make"
                          Maybe [(String, String)]
forall a. Maybe a
Nothing
    [String
tar] <- IO [String]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [String]
forall a.
IO a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String]
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      [String])
-> IO [String]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     [String]
forall a b. (a -> b) -> a -> b
$ String -> Regex -> IO [String]
findFiles
      (String
workdir String -> ShowS
</> String
"_build" String -> ShowS
</> String
"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 String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe String)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe String)
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      (Maybe String))
-> Excepts '[CopyError] m (Maybe String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String)
-> Excepts '[CopyError] m String
-> Excepts '[CopyError] m (Maybe String)
forall a b.
(a -> b) -> Excepts '[CopyError] m a -> Excepts '[CopyError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (Excepts '[CopyError] m String
 -> Excepts '[CopyError] m (Maybe String))
-> Excepts '[CopyError] m String
-> Excepts '[CopyError] m (Maybe String)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> String -> String -> Excepts '[CopyError] m String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
 HasLog env) =>
GHCTargetVersion
-> String -> String -> Excepts '[CopyError] m String
copyBindist GHCTargetVersion
tver String
tar (String
workdir String -> ShowS
</> String
"_build" String -> ShowS
</> String
"bindist")

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

  compileMakeBindist :: ( MonadReader env m
                        , HasDirs env
                        , HasSettings env
                        , HasPlatformReq env
                        , MonadThrow m
                        , MonadCatch m
                        , HasLog env
                        , MonadIO m
                        , MonadFail m
                        , MonadMask m
                        , MonadUnliftIO m
                        , MonadResource m
                        )
                     => GHCTargetVersion
                     -> FilePath
                     -> InstallDirResolved
                     -> Excepts
                          '[ FileDoesNotExistError
                           , HadrianNotFound
                           , InvalidBuildConfig
                           , PatchFailed
                           , ProcessError
                           , NotFoundInPATH
                           , MergeFileTreeError
                           , CopyError]
                          m
                       (Maybe FilePath)  -- ^ output path of bindist, None for cross
  compileMakeBindist :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m,
 MonadResource m) =>
GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
compileMakeBindist GHCTargetVersion
tver String
workdir InstallDirResolved
ghcdir = do
    Excepts
  '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
    ProcessError, NotFoundInPATH, CopyError]
  m
  ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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, MergeFileTreeError,
        CopyError]
      m
      ())
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> String
-> 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
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver String
workdir InstallDirResolved
ghcdir

    case Maybe String
mbuildConfig of
      Just String
bc -> IOErrorType
-> FileDoesNotExistError
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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
        (String -> FileDoesNotExistError
FileDoesNotExistError String
bc)
        (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool -> IO ()
copyFile String
bc (ShowS
build_mk String
workdir) Bool
False)
      Maybe String
Nothing ->
        IO ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a.
IO a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile (ShowS
build_mk String
workdir) (Text -> Text
addBuildFlavourToConf Text
defaultConf)

    Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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, MergeFileTreeError,
        CopyError]
      m
      ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ String -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, MonadIO m, HasLog env) =>
String -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig (ShowS
build_mk String
workdir)

    m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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 GHC version " 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
" (this may take a while)..."
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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, MergeFileTreeError,
        CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[String] -> Maybe String -> m (Either ProcessError ())
make ([String] -> (Int -> [String]) -> Maybe Int -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [String
"-j" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. IsString a => String -> a
fS (Int -> String
forall a. Show a => a -> String
show Int
j)]) Maybe Int
jobs) (String -> Maybe String
forall a. a -> Maybe a
Just String
workdir)

    if | GHCTargetVersion -> Bool
isCross GHCTargetVersion
tver -> do
          m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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..."
          GHCupPath
tmpInstallDest <- m GHCupPath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     GHCupPath
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupPath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
 MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
 MonadMask m, MonadIO m) =>
m GHCupPath
withGHCupTmpDir
          m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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, MergeFileTreeError,
        CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[String] -> Maybe String -> m (Either ProcessError ())
make [String
"DESTDIR=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GHCupPath -> String
fromGHCupPath GHCupPath
tmpInstallDest, String
"install"] (String -> Maybe String
forall a. a -> Maybe a
Just String
workdir)
          Excepts '[MergeFileTreeError] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[MergeFileTreeError] m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> Excepts '[MergeFileTreeError] m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m, MonadResource m, MonadFail m) =>
GHCupPath
-> InstallDirResolved
-> GHCTargetVersion
-> Bool
-> Excepts '[MergeFileTreeError] m ()
mergeGHCFileTree (GHCupPath
tmpInstallDest GHCupPath -> String -> GHCupPath
`appendGHCupPath` ShowS
dropDrive (InstallDirResolved -> String
fromInstallDir InstallDirResolved
ghcdir)) InstallDirResolved
ghcdir GHCTargetVersion
tver Bool
True
          Maybe String
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
forall a.
a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
       | Bool
otherwise -> do
          m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       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, MergeFileTreeError,
       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, MergeFileTreeError,
        CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasLog env, HasSettings env) =>
[String] -> Maybe String -> m (Either ProcessError ())
make [String
"binary-dist"] (String -> Maybe String
forall a. a -> Maybe a
Just String
workdir)
          [String
tar] <- IO [String]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     [String]
forall a.
IO a
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String]
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      [String])
-> IO [String]
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     [String]
forall a b. (a -> b) -> a -> b
$ String -> Regex -> IO [String]
findFiles
            String
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 String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe String)
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
        CopyError]
      m
      (Maybe String))
-> Excepts '[CopyError] m (Maybe String)
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, MergeFileTreeError,
       CopyError]
     m
     (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String)
-> Excepts '[CopyError] m String
-> Excepts '[CopyError] m (Maybe String)
forall a b.
(a -> b) -> Excepts '[CopyError] m a -> Excepts '[CopyError] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (Excepts '[CopyError] m String
 -> Excepts '[CopyError] m (Maybe String))
-> Excepts '[CopyError] m String
-> Excepts '[CopyError] m (Maybe String)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> String -> String -> Excepts '[CopyError] m String
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
 HasLog env) =>
GHCTargetVersion
-> String -> String -> Excepts '[CopyError] m String
copyBindist GHCTargetVersion
tver String
tar String
workdir

  build_mk :: ShowS
build_mk String
workdir = String
workdir String -> ShowS
</> String
"mk" String -> ShowS
</> String
"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 :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
 HasLog env) =>
GHCTargetVersion
-> String -> String -> Excepts '[CopyError] m String
copyBindist GHCTargetVersion
tver String
tar String
workdir = do
    Dirs {String
GHCupPath
$sel:binDir:Dirs :: Dirs -> String
$sel:baseDir:Dirs :: Dirs -> GHCupPath
$sel:cacheDir:Dirs :: Dirs -> GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
$sel:confDir:Dirs :: Dirs -> GHCupPath
$sel:dbDir:Dirs :: Dirs -> GHCupPath
$sel:recycleDir:Dirs :: Dirs -> GHCupPath
$sel:tmpDir:Dirs :: Dirs -> GHCupPath
$sel:msys2Dir:Dirs :: Dirs -> String
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
..} <- m Dirs -> Excepts '[CopyError] m Dirs
forall (m :: * -> *) a. Monad m => m a -> Excepts '[CopyError] m a
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 (m :: * -> *) a. Monad m => m a -> Excepts '[CopyError] m a
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 a. IO a -> Excepts '[CopyError] m a
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
$ String -> IO ByteString
BL.readFile (String
workdir String -> ShowS
</> String
tar)
    Text
cDigest <-
      (Text -> Text)
-> Excepts '[CopyError] m Text -> Excepts '[CopyError] m Text
forall a b.
(a -> b) -> Excepts '[CopyError] m a -> Excepts '[CopyError] m b
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 (m :: * -> *) a. Monad m => m a -> Excepts '[CopyError] m a
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 a. IO a -> Excepts '[CopyError] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let tarName :: String
tarName = ShowS
makeValid (String
"ghc-"
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver)
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PlatformRequest -> String
pfReqToString PlatformRequest
pfreq
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
cTime
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
cDigest
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".tar"
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
takeExtension String
tar)
    let tarPath :: String
tarPath = GHCupPath -> String
fromGHCupPath GHCupPath
cacheDir String -> ShowS
</> String
tarName
    String -> String -> Bool -> Excepts '[CopyError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
String -> String -> Bool -> Excepts xs m ()
copyFileE (String
workdir String -> ShowS
</> String
tar) String
tarPath Bool
False
    m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. Monad m => m a -> Excepts '[CopyError] m a
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
<> String -> Text
T.pack String
tarPath
    String -> Excepts '[CopyError] m String
forall a. a -> Excepts '[CopyError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
tarPath

  checkBuildConfig :: (MonadReader env m, MonadCatch m, MonadIO m, HasLog env)
                   => FilePath
                   -> Excepts
                        '[FileDoesNotExistError, InvalidBuildConfig]
                        m
                        ()
  checkBuildConfig :: forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, MonadIO m, HasLog env) =>
String -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig String
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
           (String -> FileDoesNotExistError
FileDoesNotExistError String
bc)
           (IO ByteString -> m ByteString
forall a. IO a -> m a
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
$ String -> IO ByteString
B.readFile String
bc)
    let lines' :: [Text]
lines' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
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 Maybe Text
crossTarget of
      Just Text
_ -> 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!|]
        )
      Maybe Text
_ -> () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a.
a -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Maybe String
-> (String
    -> 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 String
buildFlavour ((String
  -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
 -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> (String
    -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ \String
bf ->
      Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Text
T.pack (String
"BuildFlavour = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m a
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
<> String -> Text
T.pack String
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" switch! Waiting 5 seconds..."
        IO () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a.
IO a -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m a
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 String
buildFlavour of
    Just String
bf -> Text
"BuildFlavour = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
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 String
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 :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
 HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
 MonadIO m, MonadFail m) =>
GHCTargetVersion
-> String
-> InstallDirResolved
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist GHCTargetVersion
tver String
workdir (InstallDirResolved -> String
fromInstallDir -> String
ghcdir) = do
    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     a
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|]
    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
$ Maybe GHCTargetVersion
-> [String] -> Maybe String -> String -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
Maybe GHCTargetVersion
-> [String] -> Maybe String -> String -> m (Either ProcessError ())
configureWithGhcBoot (GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
tver)
      ([String] -> (Text -> [String]) -> Maybe Text -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String]
forall a. Monoid a => a
mempty
                (\Text
x -> [String
"--target=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x])
                (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--prefix=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ghcdir]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (if Bool
isWindows then [String
"--enable-tarballs-autodownload"] else [])
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack [Text]
aargs
      )
      (String -> Maybe String
forall a. a -> Maybe a
Just String
workdir)
      String
"ghc-conf"
    ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a.
a
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  configureWithGhcBoot :: ( MonadReader env m
                          , HasSettings env
                          , HasDirs env
                          , HasLog env
                          , MonadIO m
                          , MonadThrow m)
                       => Maybe GHCTargetVersion
                       -> [String]         -- ^ args for configure
                       -> Maybe FilePath   -- ^ optionally chdir into this
                       -> FilePath         -- ^ log filename (opened in append mode)
                       -> m (Either ProcessError ())
  configureWithGhcBoot :: forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
 MonadIO m, MonadThrow m) =>
Maybe GHCTargetVersion
-> [String] -> Maybe String -> String -> m (Either ProcessError ())
configureWithGhcBoot Maybe GHCTargetVersion
mtver [String]
args Maybe String
dir String
logf = do
    let execNew :: m (Either ProcessError ())
execNew = String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged
                    String
"sh"
                    (String
"./configure" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"GHC=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
bghc) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
                    Maybe String
dir
                    String
logf
                    Maybe [(String, String)]
forall a. Maybe a
Nothing
        execOld :: m (Either ProcessError ())
execOld = String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
 MonadIO m, MonadThrow m) =>
String
-> [String]
-> Maybe String
-> String
-> Maybe [(String, String)]
-> m (Either ProcessError ())
execLogged
                   String
"sh"
                   (String
"./configure" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String
"--with-ghc=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
bghc) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
                   Maybe String
dir
                   String
logf
                   Maybe [(String, String)]
forall a. Maybe a
Nothing
    if | Just GHCTargetVersion
tver <- Maybe GHCTargetVersion
mtver
       , GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.8.0|] -> m (Either ProcessError ())
execNew
       | Maybe GHCTargetVersion
Nothing   <- Maybe GHCTargetVersion
mtver               -> m (Either ProcessError ())
execNew -- need some default for git checkouts where we don't know yet
       | Bool
otherwise                        -> m (Either ProcessError ())
execOld

  bghc :: String
bghc = case Either Version String
bstrap of
           Right String
g    -> String
g
           Left  Version
bver -> String
"ghc-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> String
T.unpack (Text -> String) -> (Version -> Text) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> String) -> Version -> String
forall a b. (a -> b) -> a -> b
$ Version
bver) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
exeExt




    -------------
    --[ 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 :: 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 ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
_tvTarget :: Maybe Text
_tvVersion :: 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 String
-> 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 String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
SetGHC_XYZ Maybe String
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall a. a -> m a
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 a b.
(a -> b)
-> Excepts '[NotInstalled] m a -> Excepts '[NotInstalled] m b
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 (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NotInstalled] m a
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 a b.
Excepts '[NotInstalled] m a
-> (a -> Excepts '[NotInstalled] m b)
-> Excepts '[NotInstalled] m b
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 String
-> 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 String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe String
forall a. Maybe a
Nothing)