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

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

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

These are the entry points.
-}
module GHCup where


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

import           Codec.Archive                  ( ArchiveResult )
import           Control.Applicative
import           Control.DeepSeq                ( force )
import           Control.Exception              ( evaluate )
import           Control.Exception.Safe
import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
#if defined(IS_WINDOWS)
import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
#endif
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
import           Distribution.Types.Version   hiding ( Version )
import           Distribution.Types.PackageId
import           Distribution.Types.PackageDescription
import           Distribution.Types.GenericPackageDescription
import           Distribution.PackageDescription.Parsec
import           GHC.IO.Exception
import           Haskus.Utils.Variant.Excepts
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax     ( Quasi(qAddDependentFile) )
import           Optics
import           Prelude                 hiding ( abs
                                                , writeFile
                                                )
import           Safe                    hiding ( at )
import           System.Directory        hiding ( findFiles )
import           System.Environment
import           System.FilePath
import           System.IO.Error
import           System.IO.Temp
import           Text.PrettyPrint.HughesPJClass ( prettyShow )
import           Text.Regex.Posix

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


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


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


fetchGHCSrc :: ( MonadFail m
               , MonadMask m
               , MonadCatch m
               , MonadReader env m
               , HasDirs env
               , HasSettings env
               , HasPlatformReq env
               , HasGHCupInfo env
               , HasLog env
               , MonadResource m
               , MonadIO m
               , MonadUnliftIO m
               )
            => Version
            -> Maybe FilePath
            -> Excepts
                 '[ DigestError
                  , GPGError
                  , DownloadFailed
                  , NoDownload
                  ]
                 m
                 FilePath
fetchGHCSrc :: Version
-> Maybe FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
fetchGHCSrc Version
v Maybe FilePath
mfp = do
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  DownloadInfo
dlInfo <-
    Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
-> GHCupDownloads -> Maybe DownloadInfo
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     VersionInfo
     VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
v Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
viSourceDL Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
-> Optic
     A_Prism
     '[]
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
     DownloadInfo
     DownloadInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  '[]
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
  DownloadInfo
  DownloadInfo
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
      Maybe DownloadInfo
-> NoDownload
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
  Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[DigestError, GPGError, DownloadFailed, NoDownload] m FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
dlInfo Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
mfp



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


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

  m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install GHC with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver

  Bool
regularGHCInstalled <- m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      Bool)
-> m Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
GHC Version
ver
  
  if
    | Bool -> Bool
not Bool
forceInstall
    , Bool
regularGHCInstalled
    , Maybe FilePath
Nothing <- Maybe FilePath
isoFilepath -> do
        AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
GHC Version
ver

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

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

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

  -- prepare paths
  FilePath
ghcdir <- m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      FilePath)
-> m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
tver

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

  case Maybe FilePath
isoFilepath of
    Just FilePath
isoDir -> do                        -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing GHC to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     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]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> FilePath
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
 HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> FilePath
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
installPackedGHC FilePath
dl (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo) FilePath
isoDir Version
ver Bool
forceInstall
    Maybe FilePath
Nothing -> do                            -- regular install
      Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult]
  m
  ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     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]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> FilePath
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
 HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> FilePath
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
installPackedGHC FilePath
dl (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo) FilePath
ghcdir Version
ver Bool
forceInstall

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

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


-- | Install a packed GHC distribution. This only deals with unpacking and the GHC
-- build system and nothing else.
installPackedGHC :: ( MonadMask m
                    , MonadCatch m
                    , MonadReader env m
                    , HasDirs env
                    , HasPlatformReq env
                    , HasSettings env
                    , MonadThrow m
                    , HasLog env
                    , MonadIO m
                    , MonadUnliftIO m
                    , MonadFail m
                    )
                 => FilePath          -- ^ Path to the packed GHC bindist
                 -> Maybe TarDir      -- ^ Subdir of the archive
                 -> FilePath          -- ^ Path to install to
                 -> Version           -- ^ The GHC version
                 -> Bool              -- ^ Force install
                 -> Excepts
                      '[ BuildFailed
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , DirNotEmpty
                       , ArchiveResult
                       ] m ()
installPackedGHC :: FilePath
-> Maybe TarDir
-> FilePath
-> Version
-> Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
installPackedGHC FilePath
dl Maybe TarDir
msubdir FilePath
inst Version
ver Bool
forceInstall = do
  PlatformRequest {Maybe Versioning
Platform
Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
..} <- m PlatformRequest
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq

  Bool
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     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]
      m
      ())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
FilePath -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck FilePath
inst)

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

  -- the subdir of the archive where we do the work
  FilePath
workdir <- Excepts
  '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
    ArchiveResult]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
           ArchiveResult]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
                   (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
                   Maybe TarDir
msubdir
  
  Excepts '[BuildFailed] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m ()
 -> Excepts
      '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
        ArchiveResult]
      m
      ())
-> Excepts '[BuildFailed] m ()
-> Excepts
     '[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
       ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts '[ProcessError] m ()
-> Excepts '[BuildFailed] m ()
forall (e :: [*]) env (m :: * -> *) a.
(Pretty (V e), Show (V e), PopVariant BuildFailed e,
 ToVariantMaybe BuildFailed e, MonadReader env m, HasDirs env,
 HasSettings env, MonadIO m, MonadMask m, HasLog env,
 MonadUnliftIO m, MonadFail m, MonadCatch m) =>
FilePath
-> Maybe FilePath -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction FilePath
tmpUnpack
                         (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
inst)
                         (FilePath -> FilePath -> Version -> Excepts '[ProcessError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
 HasSettings env, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m, MonadMask m) =>
FilePath -> FilePath -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
workdir FilePath
inst Version
ver)
 where
  -- | Does basic checks for isolated installs
  -- Isolated Directory:
  --   1. if it doesn't exist -> proceed
  --   2. if it exists and is empty -> proceed
  --   3. if it exists and is non-empty -> panic and leave the house
  installDestSanityCheck :: ( MonadIO m
                            , MonadCatch m
                            ) =>
                            FilePath ->
                            Excepts '[DirNotEmpty] m ()
  installDestSanityCheck :: FilePath -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck FilePath
isoDir = do
    [IOErrorType]
-> () -> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] () (Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ())
-> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall a b. (a -> b) -> a -> b
$ do
      [FilePath]
contents <- IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath])
-> IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
isoDir
      Bool -> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
contents) (DirNotEmpty -> Excepts '[DirNotEmpty] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DirNotEmpty -> Excepts '[DirNotEmpty] m ())
-> DirNotEmpty -> Excepts '[DirNotEmpty] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> DirNotEmpty
DirNotEmpty FilePath
isoDir)



-- | Install an unpacked GHC distribution. This only deals with the GHC
-- build system and nothing else.
installUnpackedGHC :: ( MonadReader env m
                      , HasPlatformReq env
                      , HasDirs env
                      , HasSettings env
                      , MonadThrow m
                      , HasLog env
                      , MonadIO m
                      , MonadUnliftIO m
                      , MonadMask m
                      )
                   => FilePath      -- ^ Path to the unpacked GHC bindist (where the configure script resides)
                   -> FilePath      -- ^ Path to install to
                   -> Version       -- ^ The GHC version
                   -> Excepts '[ProcessError] m ()
installUnpackedGHC :: FilePath -> FilePath -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
path FilePath
inst Version
ver = do
#if defined(IS_WINDOWS)
  lift $ logInfo "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.
  lift $ withRunInIO $ \run -> flip onException (run $ recyclePathForcibly inst) $ copyDirectoryRecursive path inst $ \source dest -> do
    mtime <- getModificationTime source
    Win32.moveFile source dest
    setModificationTime dest mtime
#else
  PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
..} <- m PlatformRequest -> Excepts '[ProcessError] m PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq

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

  m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing GHC (this may take a while)"
  m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"sh"
                   (FilePath
"./configure" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inst) 
                    FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
alpineArgs
                   )
                   (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
                   FilePath
"ghc-configure"
                   Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
  m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
  () -> Excepts '[ProcessError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif


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


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

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

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

  if
    | Bool -> Bool
not Bool
forceInstall
    , Bool
regularCabalInstalled
    ,  Maybe FilePath
Nothing <- Maybe FilePath
isoFilepath -> do
        AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> AlreadyInstalled
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Cabal Version
ver
        
    | Bool
forceInstall
    , Bool
regularCabalInstalled
    , Maybe FilePath
Nothing <- Maybe FilePath
isoFilepath -> do
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version first!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
ver

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

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

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

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

  case Maybe FilePath
isoFilepath of
    Just FilePath
isoDir -> do             -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Cabal to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir FilePath
isoDir Maybe Version
forall a. Maybe a
Nothing Bool
forceInstall

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

      -- create symlink if this is the latest version for regular installs
      [Version]
cVers <- m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      [Version])
-> m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledCabals
      let lInstCabal :: Maybe Version
lInstCabal = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
cVers
      Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstCabal) (Excepts
   '[AlreadyInstalled, CopyError, DigestError, GPGError,
     DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
     TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver
      
-- | Install an unpacked cabal distribution.Symbol
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
              => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
              -> FilePath      -- ^ Path to install to
              -> Maybe Version -- ^ Nothing for isolated install
              -> Bool          -- ^ Force Install
              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked :: FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
path FilePath
inst Maybe Version
mver' Bool
forceInstall = do
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing cabal"
  let cabalFile :: FilePath
cabalFile = FilePath
"cabal"
  IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
inst
  let destFileName :: FilePath
destFileName = FilePath
cabalFile
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> (Version -> FilePath) -> Maybe Version -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer) Maybe Version
mver'
        FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
  let destPath :: FilePath
destPath = FilePath
inst FilePath -> FilePath -> FilePath
</> FilePath
destFileName

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall          -- Overwrite it when it IS a force install
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)
    
  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
cabalFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    FilePath
destPath
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath

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


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

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

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

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

    | Bool
forceInstall
    , Bool
regularHLSInstalled
    , Maybe FilePath
Nothing <- Maybe FilePath
isoFilepath -> do      -- regular forced install
        m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of HLS before force installing!"
        Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
 HasLog env, MonadIO m, MonadFail m, MonadCatch m,
 MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver

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

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

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

  case Maybe FilePath
isoFilepath of
    Just FilePath
isoDir -> do
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked FilePath
workdir FilePath
isoDir Maybe Version
forall a. Maybe a
Nothing Bool
forceInstall

    Maybe FilePath
Nothing -> do
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked FilePath
workdir FilePath
binDir (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver) Bool
forceInstall

  Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m) =>
Maybe FilePath -> Version -> Excepts '[NotInstalled] m ()
installHLSPostInst Maybe FilePath
isoFilepath Version
ver


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

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

    let srcPath :: FilePath
srcPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
f
    let destPath :: FilePath
destPath = FilePath
inst FilePath -> FilePath -> FilePath
</> FilePath
toF

    Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall   -- if it is a force install, overwrite it.
      (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)
      
    FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
      FilePath
srcPath
      FilePath
destPath
    m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath

  -- install haskell-language-server-wrapper
  let wrapper :: FilePath
wrapper = FilePath
"haskell-language-server-wrapper"
      toF :: FilePath
toF = FilePath
wrapper
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> (Version -> FilePath) -> Maybe Version -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer) Maybe Version
mver'
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      srcWrapperPath :: FilePath
srcWrapperPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
wrapper FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      destWrapperPath :: FilePath
destWrapperPath = FilePath
inst FilePath -> FilePath -> FilePath
</> FilePath
toF

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destWrapperPath)
      
  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    FilePath
srcWrapperPath
    FilePath
destWrapperPath
    
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destWrapperPath


installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
                   => Maybe FilePath
                   -> Version
                   -> Excepts '[NotInstalled] m ()
installHLSPostInst :: Maybe FilePath -> Version -> Excepts '[NotInstalled] m ()
installHLSPostInst Maybe FilePath
isoFilepath Version
ver = 
  case Maybe FilePath
isoFilepath of
    Just FilePath
_ -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Maybe FilePath
Nothing -> do
      -- create symlink if this is the latest version in a regular install
      [Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
      let lInstHLS :: Maybe Version
lInstHLS = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers
      Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstHLS) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver


-- | Installs hls binaries @haskell-language-server-\<ghcver\>@
-- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
installHLSBin :: ( MonadMask m
                 , MonadCatch m
                 , MonadReader env m
                 , HasPlatformReq env
                 , HasGHCupInfo env
                 , HasDirs env
                 , HasSettings env
                 , HasLog env
                 , MonadResource m
                 , MonadIO m
                 , MonadUnliftIO m
                 , MonadFail m
                 )
              => Version
              -> Maybe FilePath  -- isolated install Dir (if any)
              -> Bool            -- force install
              -> Excepts
                   '[ AlreadyInstalled
                    , CopyError
                    , DigestError
                    , GPGError
                    , DownloadFailed
                    , NoDownload
                    , NotInstalled
                    , UnknownArchive
                    , TarDirDoesNotExist
                    , ArchiveResult
                    , FileAlreadyExistsError
                    ]
                   m
                   ()
installHLSBin :: Version
-> Maybe FilePath
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installHLSBin Version
ver Maybe FilePath
isoFilepath Bool
forceInstall = do
  DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
HLS Version
ver
  DownloadInfo
-> Version
-> Maybe FilePath
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
 HasDirs env, HasSettings env, HasLog env, MonadResource m,
 MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> Maybe FilePath
-> Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
installHLSBindist DownloadInfo
dlinfo Version
ver Maybe FilePath
isoFilepath Bool
forceInstall


compileHLS :: ( MonadMask m
              , MonadCatch m
              , MonadReader env m
              , HasDirs env
              , HasSettings env
              , HasPlatformReq env
              , HasGHCupInfo env
              , HasLog env
              , MonadResource m
              , MonadIO m
              , MonadUnliftIO m
              , MonadFail m
              )
           => Either Version GitBranch
           -> [Version]
           -> Maybe Int
           -> Maybe Version
           -> Maybe FilePath
           -> Maybe FilePath
           -> Maybe FilePath
           -> Maybe FilePath
           -> Excepts '[ NoDownload
                       , GPGError
                       , DownloadFailed
                       , DigestError
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , ArchiveResult
                       , BuildFailed
                       , NotInstalled
                       ] m Version
compileHLS :: Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Version
compileHLS Either Version GitBranch
targetHLS [Version]
ghcs Maybe Int
jobs Maybe Version
ov Maybe FilePath
isolateDir Maybe FilePath
cabalProject Maybe FilePath
cabalProjectLocal Maybe FilePath
patchdir = do
  PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
  GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  Dirs { FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
.. } <- m Dirs
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

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

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

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

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

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

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

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

        m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"checkout", FilePath
"FETCH_HEAD" ]
        (Just GenericPackageDescription
gpd) <- ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> Maybe GenericPackageDescription)
-> Excepts '[ProcessError] m ByteString
-> Excepts '[ProcessError] m (Maybe GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Excepts '[ProcessError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
B.readFile (FilePath
tmpUnpack FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server.cabal"))
        Version -> Excepts '[ProcessError] m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Excepts '[ProcessError] m Version)
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> Excepts '[ProcessError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\NonEmpty VChunk
c -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> Maybe Text -> Version
Version Maybe Word
forall a. Maybe a
Nothing NonEmpty VChunk
c [] Maybe Text
forall a. Maybe a
Nothing)
          (NonEmpty VChunk -> Version)
-> (GenericPackageDescription -> NonEmpty VChunk)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VChunk] -> NonEmpty VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VChunk] -> NonEmpty VChunk)
-> (GenericPackageDescription -> [VChunk])
-> GenericPackageDescription
-> NonEmpty VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> VChunk) -> [Int] -> [VChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([VUnit] -> VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VUnit] -> VChunk) -> (Int -> [VUnit]) -> Int -> VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VUnit -> [VUnit] -> [VUnit]
forall a. a -> [a] -> [a]
:[]) (VUnit -> [VUnit]) -> (Int -> VUnit) -> Int -> [VUnit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> VUnit
digits (Word -> VUnit) -> (Int -> Word) -> Int -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
          ([Int] -> [VChunk])
-> (GenericPackageDescription -> [Int])
-> GenericPackageDescription
-> [VChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers
          (Version -> [Int])
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion
          (PackageIdentifier -> Version)
-> (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
          (PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
          (GenericPackageDescription -> Excepts '[ProcessError] m Version)
-> GenericPackageDescription -> Excepts '[ProcessError] m Version
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
gpd

      Excepts '[] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
      m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Git version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" corresponds to HLS version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

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

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

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

      -- apply patches
      Maybe FilePath
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
patchdir (\FilePath
dir -> Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[PatchFailed] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatches FilePath
dir FilePath
workdir)

      -- set up project files
      FilePath
cp <- case Maybe FilePath
cabalProject of
        Just FilePath
cp
          | FilePath -> Bool
isAbsolute FilePath
cp -> do
              FilePath
-> FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cp (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
              FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
          | Bool
otherwise -> FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath
takeFileName FilePath
cp)
        Maybe FilePath
Nothing -> FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
      Maybe FilePath
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
cabalProjectLocal ((FilePath
  -> Excepts
       '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
       m
       ())
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \FilePath
cpl -> FilePath
-> FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cpl (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")

      let targets :: [FilePath]
targets = [FilePath
"exe:haskell-language-server", FilePath
"exe:haskell-language-server-wrapper"]

      [FilePath]
artifacts <- [Version]
-> (Version
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         FilePath)
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort [Version]
ghcs) ((Version
  -> Excepts
       '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
       m
       FilePath)
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      [FilePath])
-> (Version
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         FilePath)
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     [FilePath]
forall a b. (a -> b) -> a -> b
$ \Version
ghc -> do
        let ghcInstallDir :: FilePath
ghcInstallDir = FilePath
installDir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
        IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
ghcInstallDir
        m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Building HLS " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
installVer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ghc
        Excepts '[ProcessError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[ProcessError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$
          FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"cabal" ( [ FilePath
"v2-build"
                               , FilePath
"-w"
                               , FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
                               ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                               [FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"--jobs=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j]) Maybe Int
jobs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                               [ FilePath
"--project-file=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cp
                               ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
targets
                             )
          (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"cabal" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
        [FilePath]
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
targets ((FilePath
  -> Excepts
       '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
       m
       ())
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \FilePath
target -> do
          let cabal :: FilePath
cabal = FilePath
"cabal"
              args :: [FilePath]
args = [FilePath
"list-bin", FilePath
target]
          CapturedProcess{ByteString
ExitCode
_stdErr :: CapturedProcess -> ByteString
_stdOut :: CapturedProcess -> ByteString
_exitCode :: CapturedProcess -> ExitCode
_stdErr :: ByteString
_stdOut :: ByteString
_exitCode :: ExitCode
..} <- m CapturedProcess
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     CapturedProcess
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      CapturedProcess)
-> m CapturedProcess
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     CapturedProcess
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
executeOut FilePath
cabal [FilePath]
args  (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) 
          case ExitCode
_exitCode of
            ExitFailure Int
i -> ProcessError
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Int -> FilePath -> [FilePath] -> ProcessError
NonZeroExit Int
i FilePath
cabal [FilePath]
args)
            ExitCode
_ -> ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          let cbin :: FilePath
cbin = FilePath -> FilePath
stripNewlineEnd (FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut
          FilePath
-> FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cbin (FilePath
ghcInstallDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
cbin)
        FilePath
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
ghcInstallDir

      [FilePath]
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
artifacts ((FilePath
  -> Excepts
       '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
       m
       ())
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> (FilePath
    -> Excepts
         '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
         m
         ())
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ \FilePath
artifact -> do
        IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
          (FilePath
installDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
takeFileName FilePath
artifact FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
        IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
          (FilePath
installDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
        IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> IO ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
artifact

      case Maybe FilePath
isolateDir of
        Just FilePath
isoDir -> do
          m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
          Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked FilePath
installDir FilePath
isoDir Maybe Version
forall a. Maybe a
Nothing Bool
True
        Maybe FilePath
Nothing -> do
          Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[PatchFailed, ProcessError, FileAlreadyExistsError, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
 MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpacked FilePath
installDir FilePath
binDir (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
installVer) Bool
True
    )

  Excepts '[NotInstalled] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[NoDownload, GPGError, DownloadFailed, DigestError,
        UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
        NotInstalled]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[NoDownload, GPGError, DownloadFailed, DigestError,
       UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
       NotInstalled]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m) =>
Maybe FilePath -> Version -> Excepts '[NotInstalled] m ()
installHLSPostInst Maybe FilePath
isolateDir Version
installVer

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



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


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

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

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

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

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

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

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

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

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

  case Maybe FilePath
isoFilepath of
    Just FilePath
isoDir -> do                 -- isolated install
      m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Stack to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir FilePath
isoDir Maybe Version
forall a. Maybe a
Nothing Bool
forceInstall
    Maybe FilePath
Nothing -> do                     -- regular install
      Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir FilePath
binDir (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver) Bool
forceInstall

      -- create symlink if this is the latest version and a regular install
      [Version]
sVers <- m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      [Version])
-> m [Version]
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledStacks
      let lInstStack :: Maybe Version
lInstStack = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
sVers
      Bool
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstStack) (Excepts
   '[AlreadyInstalled, CopyError, DigestError, GPGError,
     DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
     TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, CopyError, DigestError, GPGError,
        DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
        TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, CopyError, DigestError, GPGError,
       DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
       TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
ver


-- | Install an unpacked stack distribution.
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
              => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
              -> FilePath      -- ^ Path to install to
              -> Maybe Version -- ^ Nothing for isolated installs
              -> Bool          -- ^ Force install
              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked :: FilePath
-> FilePath
-> Maybe Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
path FilePath
inst Maybe Version
mver' Bool
forceInstall = do
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing stack"
  let stackFile :: FilePath
stackFile = FilePath
"stack"
  IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
inst
  let destFileName :: FilePath
destFileName = FilePath
stackFile
                     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> (Version -> FilePath) -> Maybe Version -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer) Maybe Version
mver'
                     FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      destPath :: FilePath
destPath = FilePath
inst FilePath -> FilePath -> FilePath
</> FilePath
destFileName

  Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
    (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
 -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)
      
  FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
    (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
stackFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
    FilePath
destPath
  m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath


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



-- | Set GHC symlinks in @~\/.ghcup\/bin@ for the requested GHC version. The behavior depends
-- on `SetGHC`:
--
--   * SetGHCOnly: @~\/.ghcup\/bin\/ghc -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XY: @~\/.ghcup\/bin\/ghc-X.Y -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--   * SetGHC_XYZ: @~\/.ghcup\/bin\/ghc-\<ver\> -> ~\/.ghcup\/ghc\/\<ver\>\/bin\/ghc@
--
-- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
-- for 'SetGHCOnly' constructor.
setGHC :: ( MonadReader env m
          , HasDirs env
          , HasLog env
          , MonadThrow m
          , MonadFail m
          , MonadIO m
          , MonadCatch m
          , MonadMask m
          , MonadUnliftIO m
          )
       => GHCTargetVersion
       -> SetGHC
       -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC :: GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc = do
  let verS :: FilePath
verS = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
  FilePath
ghcdir                        <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver

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

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

  -- first delete the old symlinks (this fixes compatibility issues
  -- with old ghcup)
  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 ()
rmPlain (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 ()
rmMajorSymlinks 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 ()
rmMinorSymlinks GHCTargetVersion
ver

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

    -- create symlink
    Maybe FilePath
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe FilePath
mTargetFile ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m (Maybe ()))
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall a b. (a -> b) -> a -> b
$ \FilePath
targetFile -> do
      let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile  FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
          fileWithExt :: FilePath
fileWithExt = FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
      FilePath
destL <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
FilePath -> GHCTargetVersion -> m FilePath
ghcLinkDestination FilePath
fileWithExt GHCTargetVersion
ver
      m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL FilePath
fullF

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

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

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

 where

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

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


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

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

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

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

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

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

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


-- | Set the haskell-language-server symlinks.
setHLS :: ( MonadReader env m
          , HasDirs env
          , HasLog env
          , MonadIO m
          , MonadMask m
          , MonadFail m
          , MonadUnliftIO m
          )
       => Version
       -> Excepts '[NotInstalled] m ()
setHLS :: Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs

  -- Delete old symlinks, since these might have different ghc versions than the
  -- selected version, so we could end up with stray or incorrect symlinks.
  [FilePath]
oldSyms <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [FilePath]
hlsSymlinks
  [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
oldSyms ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f)
    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f)

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

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

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

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

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

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


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


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

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

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

  let stackbin :: FilePath
stackbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt

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

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


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


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

  case (Maybe Version
currentGHC, Maybe Version
currentHLS) of
    (Just Version
gv, Just Version
hv) | Version
gv Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
supportedGHC -> do
      Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
gv) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not compatible with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Haskell Language Server " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
hv) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Haskell IDE support may not work until this is fixed." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        Text
"Install a different HLS version, or install and set one of the following GHCs:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        FilePath -> Text
T.pack ([Version] -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow [Version]
supportedGHC)
        
    (Maybe Version, Maybe Version)
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


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

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


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


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

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

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

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

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

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

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

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


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



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


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

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

  -- this isn't atomic, order matters
  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc symlinks"
    Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc-x.y.z symlinks"
  Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks GHCTargetVersion
ver

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing/rewiring ghc-x.y symlinks"
  -- first remove
  (ParseError -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
_ :: ParseError) -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
 MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion
ver
  -- then fix them (e.g. with an earlier version)

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing directory recursively: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir
  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
dir

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

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

  m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
rmDirectoryLink (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"share")


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

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

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

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

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


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

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

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

  [FilePath]
bins <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> m [FilePath]
hlsAllBinaries Version
ver
  [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f)

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    -- delete all set symlinks
    [FilePath]
oldSyms <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [FilePath]
hlsSymlinks
    [FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
oldSyms ((FilePath -> Excepts '[NotInstalled] m ())
 -> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
      let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f
      m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF
      m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
fullF
    -- set latest hls
    [Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
 MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
latestver
      Maybe Version
Nothing        -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


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

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

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

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

  Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
sSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
    [Version]
sVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledStacks
    case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
sVers of
      Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
 MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
latestver
      Maybe Version
Nothing        -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)


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

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

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

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

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

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

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

#if defined(IS_WINDOWS)
  -- since it doesn't seem possible to delete a running exe on windows
  -- we move it to temp dir, to be deleted at next reboot
  tempFilepath <- mkGhcupTmpDir
  hideError UnsupportedOperation $
            liftIO $ hideError NoSuchThing $
            Win32.moveFileEx ghcupFilepath (Just (tempFilepath </> "ghcup")) 0
#else
  -- delete it.
  IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
ghcupFilepath
#endif

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

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

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


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

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

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

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

  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
 MonadCatch m) =>
FilePath -> m ()
rmBinDir FilePath
binDir
  m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
 MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
recycleDir
#if defined(IS_WINDOWS)
  logInfo $ "removing " <> T.pack (baseDir </> "msys64")
  handleRm $ rmPathForcibly (baseDir </> "msys64")
#endif

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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



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


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




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


-- | Compile a GHC from source. This behaves wrt symlinks and installation
-- the same as 'installGHCBin'.
compileGHC :: ( MonadMask m
              , MonadReader env m
              , HasDirs env
              , HasPlatformReq env
              , HasGHCupInfo env
              , HasSettings env
              , MonadThrow m
              , MonadResource m
              , HasLog env
              , MonadIO m
              , MonadUnliftIO m
              , MonadFail m
              )
           => Either GHCTargetVersion GitBranch          -- ^ version to install
           -> Maybe Version            -- ^ overwrite version
           -> Either Version FilePath  -- ^ version to bootstrap with
           -> Maybe Int                -- ^ jobs
           -> Maybe FilePath           -- ^ build config
           -> Maybe FilePath           -- ^ patch directory
           -> [Text]                   -- ^ additional args to ./configure
           -> Maybe String             -- ^ build flavour
           -> Bool
           -> Maybe FilePath           -- ^ isolate dir
           -> Excepts
                '[ AlreadyInstalled
                 , BuildFailed
                 , DigestError
                 , GPGError
                 , DownloadFailed
                 , GHCupSetError
                 , NoDownload
                 , NotFoundInPATH
                 , PatchFailed
                 , UnknownArchive
                 , TarDirDoesNotExist
                 , NotInstalled
                 , DirNotEmpty
                 , ArchiveResult
                 ]
                m
                GHCTargetVersion
compileGHC :: Either GHCTargetVersion GitBranch
-> Maybe Version
-> Either Version FilePath
-> Maybe Int
-> Maybe FilePath
-> Maybe FilePath
-> [Text]
-> Maybe FilePath
-> Bool
-> Maybe FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     GHCTargetVersion
compileGHC Either GHCTargetVersion GitBranch
targetGhc Maybe Version
ov Either Version FilePath
bstrap Maybe Int
jobs Maybe FilePath
mbuildConfig Maybe FilePath
patchdir [Text]
aargs Maybe FilePath
buildFlavour Bool
hadrian Maybe FilePath
isolateDir
  = do
    PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
    GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo

    Either FilePath FilePath
bghc <- case Either Version FilePath
bstrap of
      Right FilePath
g    -> Either FilePath FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      (Either FilePath FilePath))
-> Either FilePath FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
g
      Left  Version
bver -> Either FilePath FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     (Either FilePath FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      (Either FilePath FilePath))
-> Either FilePath FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
bver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)

    (FilePath
workdir, FilePath
tmpUnpack, GHCTargetVersion
tver) <- case Either GHCTargetVersion GitBranch
targetGhc of
      -- unpack from version tarball
      Left GHCTargetVersion
tver -> do
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text)
-> (FilePath -> Text) -> Either Version FilePath -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Text
prettyVer FilePath -> Text
T.pack Either Version FilePath
bstrap

        -- download source tarball
        DownloadInfo
dlInfo <-
          Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
-> GHCupDownloads -> Maybe DownloadInfo
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
     (IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Map Version VersionInfo)
  (Map Version VersionInfo)
-> Optic
     An_AffineTraversal
     '[]
     (Map Version VersionInfo)
     (Map Version VersionInfo)
     VersionInfo
     VersionInfo
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     VersionInfo
     VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
     (IxKind (Map Version VersionInfo))
     '[]
     (Map Version VersionInfo)
     (IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (GHCTargetVersion
tver GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion) Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  VersionInfo
  VersionInfo
-> Optic
     A_Lens
     '[]
     VersionInfo
     VersionInfo
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
-> Optic
     An_AffineTraversal
     '[]
     GHCupDownloads
     GHCupDownloads
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  VersionInfo
  VersionInfo
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
viSourceDL Optic
  An_AffineTraversal
  '[]
  GHCupDownloads
  GHCupDownloads
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
-> Optic
     A_Prism
     '[]
     (Maybe DownloadInfo)
     (Maybe DownloadInfo)
     DownloadInfo
     DownloadInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  '[]
  (Maybe DownloadInfo)
  (Maybe DownloadInfo)
  DownloadInfo
  DownloadInfo
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
            Maybe DownloadInfo
-> NoDownload
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
        FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
 MonadResource m, MonadThrow m, HasLog env, MonadIO m,
 MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlInfo Maybe FilePath
forall a. Maybe a
Nothing

        -- unpack
        FilePath
tmpUnpack <- m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
 MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
        Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl
        Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack

        FilePath
workdir <- Excepts
  '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
    DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
    PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
    DirNotEmpty, ArchiveResult]
  m
  FilePath
-> (TarDir
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
           PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
           DirNotEmpty, ArchiveResult]
         m
         FilePath)
-> Maybe TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
                         (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
                         (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
        Maybe FilePath
-> (FilePath
    -> Excepts
         '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
           DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
           PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
           DirNotEmpty, ArchiveResult]
         m
         ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
patchdir (\FilePath
dir -> Excepts '[PatchFailed] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[PatchFailed] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatches FilePath
dir FilePath
workdir)

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

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

          let fetch_args :: [FilePath]
fetch_args = 
                    [ FilePath
"fetch"
                    , FilePath
"--depth"
                    , FilePath
"1"
                    , FilePath
"--quiet"
                    , FilePath
"origin"
                    , FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]
          m (Either ProcessError ())
-> Excepts '[PatchFailed, ProcessError, NotFoundInPATH] 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] m ())
-> m (Either ProcessError ())
-> Excepts '[PatchFailed, ProcessError, NotFoundInPATH] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [FilePath]
fetch_args

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

        Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
 Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
        m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Git version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" corresponds to GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver

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

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

    Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ do
      case Maybe FilePath
isolateDir of
        Just FilePath
isoDir ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Isolate installing to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
        Maybe FilePath
Nothing ->
          m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Will overwrite existing version."
      m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
        Text
"...waiting for 10 seconds before continuing, you can still abort..."
      IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
10000000 -- give the user a sec to intervene

    FilePath
ghcdir <- case Maybe FilePath
isolateDir of
      Just FilePath
isoDir -> FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
isoDir
      Maybe FilePath
Nothing -> m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      FilePath)
-> m FilePath
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
installVer

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

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

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

    IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> IO ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
ghcUpSrcBuiltFile) ByteString
bmk
    
    case Maybe FilePath
isolateDir of
      -- set and make symlinks for regular (non-isolated) installs
      Maybe FilePath
Nothing -> do
        (V '[NotInstalled] -> GHCupSetError)
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[NotInstalled] -> GHCupSetError
forall (es :: [*]).
(ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es,
 Show (V es), Pretty (V es)) =>
V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
 MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
 MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
installVer
        -- restore
        Bool
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
   '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
     DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
     PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
     DirNotEmpty, ArchiveResult]
   m
   ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
 -> Excepts
      '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
        DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
        PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
        DirNotEmpty, ArchiveResult]
      m
      ())
-> Excepts '[NotInstalled] m ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     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 -> 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 -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
installVer SetGHC
SetGHCOnly
        
      Maybe FilePath
_ -> ()
-> Excepts
     '[AlreadyInstalled, BuildFailed, DigestError, GPGError,
       DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
       PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
       DirNotEmpty, ArchiveResult]
     m
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

    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
$ Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> 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) =>
Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist Either FilePath FilePath
bghc GHCTargetVersion
tver FilePath
workdir FilePath
ghcdir

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

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

  compileMakeBindist :: ( MonadReader env m
                        , HasDirs env
                        , HasSettings env
                        , HasPlatformReq env
                        , MonadThrow m
                        , MonadCatch m
                        , HasLog env
                        , MonadIO m
                        , MonadFail m
                        )
                     => Either FilePath FilePath
                     -> GHCTargetVersion
                     -> FilePath
                     -> FilePath
                     -> Excepts
                          '[ FileDoesNotExistError
                           , HadrianNotFound
                           , InvalidBuildConfig
                           , PatchFailed
                           , ProcessError
                           , NotFoundInPATH
                           , CopyError]
                          m
                       (Maybe FilePath)  -- ^ output path of bindist, None for cross
  compileMakeBindist :: Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     (Maybe FilePath)
compileMakeBindist Either FilePath FilePath
bghc GHCTargetVersion
tver FilePath
workdir FilePath
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
$ Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> 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) =>
Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist Either FilePath FilePath
bghc GHCTargetVersion
tver FilePath
workdir FilePath
ghcdir

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

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

    m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Building (this may take a while)..."
    m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
 -> Excepts
      '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
        PatchFailed, ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m (Either ProcessError ())
-> Excepts
     '[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
       PatchFailed, ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
 HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make ([FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"-j" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. IsString a => FilePath -> a
fS (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j)]) Maybe Int
jobs) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)

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

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

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

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

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

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

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

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


  configureBindist :: ( MonadReader env m
                      , HasDirs env
                      , HasSettings env
                      , HasPlatformReq env
                      , MonadThrow m
                      , MonadCatch m
                      , HasLog env
                      , MonadIO m
                      , MonadFail m
                      )
                   => Either FilePath FilePath
                   -> GHCTargetVersion
                   -> FilePath
                   -> FilePath
                   -> Excepts
                        '[ FileDoesNotExistError
                         , InvalidBuildConfig
                         , PatchFailed
                         , ProcessError
                         , NotFoundInPATH
                         , CopyError
                         ]
                        m
                        ()
  configureBindist :: Either FilePath FilePath
-> GHCTargetVersion
-> FilePath
-> FilePath
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
configureBindist Either FilePath FilePath
bghc GHCTargetVersion
tver FilePath
workdir FilePath
ghcdir = do
    m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
 -> Excepts
      '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
        ProcessError, NotFoundInPATH, CopyError]
      m
      ())
-> m ()
-> Excepts
     '[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
       ProcessError, NotFoundInPATH, CopyError]
     m
     ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo [s|configuring build|]

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

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






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


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

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

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

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



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



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

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


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

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

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

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

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

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

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



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


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



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

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

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



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


rmHLSNoGHC :: ( MonadReader env m
              , HasDirs env
              , HasLog env
              , MonadIO m
              , MonadMask m
              )
           => m ()
rmHLSNoGHC :: m ()
rmHLSNoGHC = do
  Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
  [GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
  [Version]
hlses <- ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
  [Version] -> (Version -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version]
hlses ((Version -> m ()) -> m ()) -> (Version -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Version
hls -> do
    [GHCTargetVersion]
hlsGHCs <- (Version -> GHCTargetVersion) -> [Version] -> [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> GHCTargetVersion
mkTVer ([Version] -> [GHCTargetVersion])
-> m [Version] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
 MonadCatch m) =>
Version -> m [Version]
hlsGHCVersions' Version
hls
    [GHCTargetVersion] -> (GHCTargetVersion -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
hlsGHCs ((GHCTargetVersion -> m ()) -> m ())
-> (GHCTargetVersion -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do 
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GHCTargetVersion
ghc GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCTargetVersion]
ghcs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        [FilePath]
bins <- Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
        [FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
bin -> do
          let f :: FilePath
f = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
bin
          Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
f
          FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
f


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


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