{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module GHCup where
import GHCup.Download
import GHCup.Errors
import GHCup.Platform
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ
import GHCup.Version
import Codec.Archive ( ArchiveResult )
import Control.Applicative
import Control.DeepSeq ( force )
import Control.Exception ( evaluate )
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Maybe
import Data.List.NonEmpty ( NonEmpty((:|)) )
import Data.String ( fromString )
import Data.Text ( Text )
import Data.Time.Clock
import Data.Time.Format.ISO8601
import Data.Versions hiding ( patch )
import Distribution.Types.Version hiding ( Version )
import Distribution.Types.PackageId
import Distribution.Types.PackageDescription
import Distribution.Types.GenericPackageDescription
import Distribution.PackageDescription.Parsec
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts
import Language.Haskell.TH
import Language.Haskell.TH.Syntax ( Quasi(qAddDependentFile) )
import Optics
import Prelude hiding ( abs
, writeFile
)
import Safe hiding ( at )
import System.Directory hiding ( findFiles )
import System.Environment
import System.FilePath
import System.IO.Error
import System.IO.Temp
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import URI.ByteString
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
import GHCup.Utils.MegaParsec
import Control.Concurrent (threadDelay)
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
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
-> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
, ArchiveResult
, ProcessError
]
m
()
installGHCBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
installGHCBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
ver
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install GHC with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver
Bool
regularGHCInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
GHC Version
ver
if
| Bool -> Bool
not Bool
forceInstall
, Bool
regularGHCInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
GHC Version
ver
| Bool
forceInstall
, Bool
regularGHCInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed GHC version first!"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
tver
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadResource m, MonadThrow m, HasLog env, MonadIO m,
MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlinfo Maybe FilePath
forall a. Maybe a
Nothing
Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
toolchainSanityChecks
case InstallDir
installDir of
IsolateDir FilePath
isoDir -> do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing GHC to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
installPackedGHC FilePath
dl (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo) (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
InstallDir
GHCupInternal -> do
FilePath
ghcdir <- m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath)
-> m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
tver
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
installPackedGHC FilePath
dl (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo) (FilePath -> InstallDirResolved
GHCupDir FilePath
ghcdir) Version
ver Bool
forceInstall
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver
where
toolchainSanityChecks :: Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
toolchainSanityChecks = do
[Maybe FilePath]
r <- [FilePath]
-> (FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
(Maybe FilePath))
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
[Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath
"CC", FilePath
"LD"] (IO (Maybe FilePath)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
(Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
(Maybe FilePath))
-> (FilePath -> IO (Maybe FilePath))
-> FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
(Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
lookupEnv)
case [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
r of
[] -> ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[FilePath]
_ -> do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"CC/LD environment variable is set. This will change the compiler/linker"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"environments). If you encounter problems, unset CC and LD and reinstall."
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
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[ BuildFailed
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
, ArchiveResult
, ProcessError
] m ()
installPackedGHC :: FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
installPackedGHC FilePath
dl Maybe TarDir
msubdir InstallDirResolved
inst Version
ver Bool
forceInstall = do
PlatformRequest {Maybe Versioning
Platform
Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
..} <- m PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
(Excepts '[DirNotEmpty] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DirNotEmpty] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck InstallDirResolved
inst)
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
())
-> Excepts '[] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
-> (TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
(Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
Maybe TarDir
msubdir
Excepts '[ProcessError] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
())
-> Excepts '[ProcessError] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts '[ProcessError] m ()
-> Excepts '[ProcessError] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack
(case InstallDirResolved
inst of
IsolateDirResolved FilePath
_ -> Maybe FilePath
forall a. Maybe a
Nothing
GHCupDir FilePath
d -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
d
)
(FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasDirs env,
HasSettings env, MonadThrow m, HasLog env, MonadIO m,
MonadUnliftIO m, MonadMask m) =>
FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
workdir InstallDirResolved
inst Version
ver)
installUnpackedGHC :: ( MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadUnliftIO m
, MonadMask m
)
=> FilePath
-> InstallDirResolved
-> Version
-> Excepts '[ProcessError] m ()
installUnpackedGHC :: FilePath
-> InstallDirResolved -> Version -> Excepts '[ProcessError] m ()
installUnpackedGHC FilePath
path InstallDirResolved
inst Version
ver
| Bool
isWindows = do
m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing GHC (this may take a while)"
m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> IO a) -> IO ()) -> m ()
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (case InstallDirResolved
inst of
IsolateDirResolved FilePath
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
GHCupDir FilePath
d -> m () -> IO ()
forall a. m a -> IO a
run (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
d
) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> (FilePath -> FilePath -> IO ()) -> IO ()
copyDirectoryRecursive FilePath
path (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst) ((FilePath -> FilePath -> IO ()) -> IO ())
-> (FilePath -> FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
source FilePath
dest -> do
UTCTime
mtime <- FilePath -> IO UTCTime
getModificationTime FilePath
source
FilePath -> FilePath -> IO ()
moveFilePortable FilePath
source FilePath
dest
FilePath -> UTCTime -> IO ()
setModificationTime FilePath
dest UTCTime
mtime
| Bool
otherwise = do
PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
..} <- m PlatformRequest -> Excepts '[ProcessError] m PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
let alpineArgs :: [FilePath]
alpineArgs
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.2.2|], Linux LinuxDistro
Alpine <- Platform
_rPlatform
= [FilePath
"--disable-ld-override"]
| Bool
otherwise
= []
m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing GHC (this may take a while)"
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"sh"
(FilePath
"./configure" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
alpineArgs
)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
FilePath
"ghc-configure"
Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
() -> Excepts '[ProcessError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, DirNotEmpty
, ArchiveResult
, ProcessError
]
m
()
installGHCBin :: Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
installGHCBin Version
ver InstallDir
installDir Bool
forceInstall = do
DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
GHC Version
ver
Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
HasDirs env, HasSettings env, HasPlatformReq env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError]
m
()
installGHCBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall
installCabalBindist :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install cabal version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver
PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
..} <- m PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
Dirs {FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
..} <- m Dirs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
Bool
regularCabalInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
Cabal Version
ver
if
| Bool -> Bool
not Bool
forceInstall
, Bool
regularCabalInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Cabal Version
ver
| Bool
forceInstall
, Bool
regularCabalInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version first!"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
ver
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)
case InstallDir
installDir of
IsolateDir FilePath
isoDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Cabal to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
InstallDir
GHCupInternal -> do
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadIO m, MonadReader env m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall
installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
=> FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked FilePath
path InstallDirResolved
inst Version
ver Bool
forceInstall = do
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing cabal"
let cabalFile :: FilePath
cabalFile = FilePath
"cabal"
IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst)
let destFileName :: FilePath
destFileName = FilePath
cabalFile
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
inst of
IsolateDirResolved FilePath
_ -> FilePath
""
GHCupDir FilePath
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
inst FilePath -> FilePath -> FilePath
</> FilePath
destFileName
Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
(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
installCabalBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installCabalBin :: Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBin Version
ver InstallDir
installDir Bool
forceInstall = do
DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Cabal Version
ver
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall
installHLSBindist :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
, ProcessError
, DirNotEmpty
]
m
()
installHLSBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
installHLSBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install hls version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver
PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
..} <- m PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
Bool
regularHLSInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
HLS Version
ver
if
| Bool -> Bool
not Bool
forceInstall
, Bool
regularHLSInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
HLS Version
ver
| Bool
forceInstall
, Bool
regularHLSInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of HLS before force installing!"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadResource m, MonadThrow m, HasLog env, MonadIO m,
MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlinfo Maybe FilePath
forall a. Maybe a
Nothing
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)
Bool
legacy <- IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool)
-> IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
isLegacyHLSBindist FilePath
workdir
if
| Bool -> Bool
not Bool
forceInstall
, Bool -> Bool
not Bool
legacy
, (IsolateDir FilePath
fp) <- InstallDir
installDir -> Excepts '[DirNotEmpty] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DirNotEmpty] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[DirNotEmpty] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ InstallDirResolved -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
fp)
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
case InstallDir
installDir of
IsolateDir FilePath
isoDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
if Bool
legacy
then Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
else Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack Maybe FilePath
forall a. Maybe a
Nothing (Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
HasLog env, HasDirs env, HasSettings env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
installHLSUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver
InstallDir
GHCupInternal -> do
if Bool
legacy
then Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall
else do
FilePath
inst <- Version
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
inst)
(Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m,
HasLog env, HasDirs env, HasSettings env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
installHLSUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
inst) Version
ver
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
ver SetHLS
SetHLS_XYZ Maybe FilePath
forall a. Maybe a
Nothing
isLegacyHLSBindist :: FilePath
-> IO Bool
isLegacyHLSBindist :: FilePath -> IO Bool
isLegacyHLSBindist FilePath
path = do
Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
"GNUmakefile")
installHLSUnpacked :: (MonadMask m, MonadUnliftIO m, MonadReader env m, MonadFail m, HasLog env, HasDirs env, HasSettings env, MonadCatch m, MonadIO m)
=> FilePath
-> InstallDirResolved
-> Version
-> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled] m ()
installHLSUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
installHLSUnpacked FilePath
path (InstallDirResolved -> FilePath
fromInstallDir -> FilePath
inst) Version
_ = do
m ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
())
-> m ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing HLS"
IO ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
())
-> IO ()
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
inst
m (Either ProcessError ())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
())
-> m (Either ProcessError ())
-> Excepts
'[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"PREFIX=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inst, FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
path InstallDirResolved
installDir Version
ver Bool
forceInstall = do
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing HLS"
IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir)
bins :: [FilePath]
bins@(FilePath
_:[FilePath]
_) <- IO [FilePath]
-> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
-> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath])
-> IO [FilePath]
-> Excepts '[CopyError, FileAlreadyExistsError] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
path
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^haskell-language-server-[0-9].*$|] :: ByteString)
)
[FilePath]
-> (FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> (FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let toF :: FilePath
toF = FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt FilePath
f
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
IsolateDirResolved FilePath
_ -> FilePath
""
GHCupDir FilePath
_ -> (FilePath
"~" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let srcPath :: FilePath
srcPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
f
let destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
toF
Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
(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
let wrapper :: FilePath
wrapper = FilePath
"haskell-language-server-wrapper"
toF :: FilePath
toF = FilePath
wrapper
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
IsolateDirResolved FilePath
_ -> FilePath
""
GHCupDir FilePath
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
srcWrapperPath :: FilePath
srcWrapperPath = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
wrapper FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
destWrapperPath :: FilePath
destWrapperPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
toF
Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
(Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destWrapperPath)
FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
FilePath
srcWrapperPath
FilePath
destWrapperPath
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destWrapperPath
installHLSBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasGHCupInfo env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
, ProcessError
, DirNotEmpty
]
m
()
installHLSBin :: Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
installHLSBin Version
ver InstallDir
installDir Bool
forceInstall = do
DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
HLS Version
ver
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty]
m
()
installHLSBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall
compileHLS :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
-> Maybe (Either FilePath [URI])
-> [Text]
-> Excepts '[ NoDownload
, GPGError
, DownloadFailed
, DigestError
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, BuildFailed
, NotInstalled
] m Version
compileHLS :: Either Version GitBranch
-> [Version]
-> Maybe Int
-> Maybe Version
-> InstallDir
-> Maybe (Either FilePath URI)
-> Maybe URI
-> Maybe (Either FilePath [URI])
-> [Text]
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Version
compileHLS Either Version GitBranch
targetHLS [Version]
ghcs Maybe Int
jobs Maybe Version
ov InstallDir
installDir Maybe (Either FilePath URI)
cabalProject Maybe URI
cabalProjectLocal Maybe (Either FilePath [URI])
patches [Text]
cabalArgs = do
PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
Dirs { FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
.. } <- m Dirs
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
(FilePath
workdir, Version
tver) <- case Either Version GitBranch
targetHLS of
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
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
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
())
-> Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
-> (TarDir
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
(Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
(Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
(FilePath, Version)
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
(FilePath, Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
workdir, Version
tver)
Right GitBranch{FilePath
Maybe FilePath
$sel:repo:GitBranch :: GitBranch -> Maybe FilePath
$sel:ref:GitBranch :: GitBranch -> FilePath
repo :: Maybe FilePath
ref :: FilePath
..} -> do
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
let git :: [FilePath] -> m (Either ProcessError ())
git [FilePath]
args = FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"git" (FilePath
"--no-pager"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
args) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"git" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
Version
tver <- (V '[ProcessError] -> DownloadFailed)
-> Excepts '[ProcessError] m Version
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Version
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[ProcessError] V '[ProcessError] -> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts '[ProcessError] m Version
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Version)
-> Excepts '[ProcessError] m Version
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Version
forall a b. (a -> b) -> a -> b
$ do
let rep :: FilePath
rep = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"https://github.com/haskell/haskell-language-server.git" Maybe FilePath
repo
m () -> Excepts '[ProcessError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[ProcessError] m ())
-> m () -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Fetching git repo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (this may take a while)"
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"init" ]
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"remote"
, FilePath
"add"
, FilePath
"origin"
, FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
rep ]
let fetch_args :: [FilePath]
fetch_args =
[ FilePath
"fetch"
, FilePath
"--depth"
, FilePath
"1"
, FilePath
"--quiet"
, FilePath
"origin"
, FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [FilePath]
fetch_args
m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"checkout", FilePath
"FETCH_HEAD" ]
(Just GenericPackageDescription
gpd) <- ByteString -> Maybe GenericPackageDescription
parseGenericPackageDescriptionMaybe (ByteString -> Maybe GenericPackageDescription)
-> Excepts '[ProcessError] m ByteString
-> Excepts '[ProcessError] m (Maybe GenericPackageDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Excepts '[ProcessError] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
B.readFile (FilePath
tmpUnpack FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server.cabal"))
Version -> Excepts '[ProcessError] m Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version -> Excepts '[ProcessError] m Version)
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> Excepts '[ProcessError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\NonEmpty VChunk
c -> Maybe Word -> NonEmpty VChunk -> [VChunk] -> Maybe Text -> Version
Version Maybe Word
forall a. Maybe a
Nothing NonEmpty VChunk
c [] Maybe Text
forall a. Maybe a
Nothing)
(NonEmpty VChunk -> Version)
-> (GenericPackageDescription -> NonEmpty VChunk)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VChunk] -> NonEmpty VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VChunk] -> NonEmpty VChunk)
-> (GenericPackageDescription -> [VChunk])
-> GenericPackageDescription
-> NonEmpty VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> VChunk) -> [Int] -> [VChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([VUnit] -> VChunk
forall a. [a] -> NonEmpty a
NE.fromList ([VUnit] -> VChunk) -> (Int -> [VUnit]) -> Int -> VChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VUnit -> [VUnit] -> [VUnit]
forall a. a -> [a] -> [a]
:[]) (VUnit -> [VUnit]) -> (Int -> VUnit) -> Int -> [VUnit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> VUnit
digits (Word -> VUnit) -> (Int -> Word) -> Int -> VUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
([Int] -> [VChunk])
-> (GenericPackageDescription -> [Int])
-> GenericPackageDescription
-> [VChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionNumbers
(Version -> [Int])
-> (GenericPackageDescription -> Version)
-> GenericPackageDescription
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion
(PackageIdentifier -> Version)
-> (GenericPackageDescription -> PackageIdentifier)
-> GenericPackageDescription
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package
(PackageDescription -> PackageIdentifier)
-> (GenericPackageDescription -> PackageDescription)
-> GenericPackageDescription
-> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
(GenericPackageDescription -> Excepts '[ProcessError] m Version)
-> GenericPackageDescription -> Excepts '[ProcessError] m Version
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
gpd
Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
())
-> Excepts '[] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
())
-> m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Git version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" corresponds to HLS version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver
(FilePath, Version)
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
(FilePath, Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
tmpUnpack, Version
tver)
let installVer :: Version
installVer = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
tver Maybe Version
ov
Excepts '[BuildFailed] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
())
-> Excepts '[BuildFailed] m ()
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts '[BuildFailed] m ()
-> Excepts '[BuildFailed] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction
FilePath
workdir
Maybe FilePath
forall a. Maybe a
Nothing
((V '[GPGError, DownloadFailed, DigestError, PatchFailed,
ProcessError, FileAlreadyExistsError, CopyError]
-> BuildFailed)
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
-> Excepts '[BuildFailed] m ()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (FilePath
-> V '[GPGError, DownloadFailed, DigestError, PatchFailed,
ProcessError, FileAlreadyExistsError, CopyError]
-> BuildFailed
forall (es :: [*]).
(ToVariantMaybe BuildFailed es, PopVariant BuildFailed es,
Pretty (V es), Show (V es)) =>
FilePath -> V es -> BuildFailed
BuildFailed FilePath
workdir) (Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
-> Excepts '[BuildFailed] m ())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
-> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ do
let tmpInstallDir :: FilePath
tmpInstallDir = FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"out"
IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
tmpInstallDir
Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
patches FilePath
workdir
FilePath
cp <- case Maybe (Either FilePath URI)
cabalProject of
Just (Left FilePath
cp)
| FilePath -> Bool
isAbsolute FilePath
cp -> do
FilePath
-> FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cp (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
| Bool
otherwise -> FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath
takeFileName FilePath
cp)
Just (Right URI
uri) -> do
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
FilePath
cp <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"cabal.project") Bool
False
FilePath
-> FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cp (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.project")
FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
Maybe (Either FilePath URI)
Nothing -> FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"cabal.project"
Maybe URI
-> (URI
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe URI
cabalProjectLocal ((URI
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> (URI
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ \URI
uri -> do
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
FilePath
cpl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing FilePath
tmpUnpack (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")) Bool
False
FilePath
-> FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
cpl (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
cp FilePath -> FilePath -> FilePath
<.> FilePath
"local")
[FilePath]
artifacts <- [Version]
-> (Version
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath)
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
[FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort [Version]
ghcs) ((Version
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath)
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
[FilePath])
-> (Version
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath)
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
[FilePath]
forall a b. (a -> b) -> a -> b
$ \Version
ghc -> do
let ghcInstallDir :: FilePath
ghcInstallDir = FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
tmpInstallDir
m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Building HLS " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
installVer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ghc
Excepts '[ProcessError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ProcessError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts '[ProcessError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"cabal" ( [ FilePath
"v2-install"
, FilePath
"-w"
, FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghc)
, FilePath
"--install-method=copy"
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"--jobs=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j]) Maybe Int
jobs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"--overwrite-policy=always"
, FilePath
"--disable-profiling"
, FilePath
"--disable-tests"
, FilePath
"--installdir=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcInstallDir
, FilePath
"--project-file=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cp
] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
cabalArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [
FilePath
"exe:haskell-language-server"
, FilePath
"exe:haskell-language-server-wrapper"]
)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"cabal" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
ghcInstallDir
[FilePath]
-> (FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
artifacts ((FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> (FilePath
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ \FilePath
artifact -> do
IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
(FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
takeFileName FilePath
artifact FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
artifact FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
(FilePath
tmpInstallDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
<.> FilePath
exeExt)
IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> IO ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
artifact
case InstallDir
installDir of
IsolateDir FilePath
isoDir -> do
m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing HLS to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
tmpInstallDir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
installVer Bool
True
InstallDir
GHCupInternal -> do
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[GPGError, DownloadFailed, DigestError, PatchFailed, ProcessError,
FileAlreadyExistsError, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installHLSUnpackedLegacy FilePath
tmpInstallDir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
installVer Bool
True
)
Version
-> Excepts
'[NoDownload, GPGError, DownloadFailed, DigestError,
UnknownArchive, TarDirDoesNotExist, ArchiveResult, BuildFailed,
NotInstalled]
m
Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
installVer
installStackBin :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, HasGHCupInfo env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installStackBin :: Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installStackBin Version
ver InstallDir
installDir Bool
forceInstall = do
DownloadInfo
dlinfo <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
Stack Version
ver
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall
installStackBindist :: ( MonadMask m
, MonadCatch m
, MonadReader env m
, HasPlatformReq env
, HasDirs env
, HasSettings env
, HasLog env
, MonadResource m
, MonadIO m
, MonadUnliftIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, GPGError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
, ArchiveResult
, FileAlreadyExistsError
]
m
()
installStackBindist :: DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
installStackBindist DownloadInfo
dlinfo Version
ver InstallDir
installDir Bool
forceInstall = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to install stack version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
ver
PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
..} <- m PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
Bool
regularStackInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
Bool
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> Version -> m Bool
checkIfToolInstalled Tool
Stack Version
ver
if
| Bool -> Bool
not Bool
forceInstall
, Bool
regularStackInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Stack Version
ver
| Bool
forceInstall
, Bool
regularStackInstalled
, InstallDir
GHCupInternal <- InstallDir
installDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing the currently installed version of Stack first!"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
ver
| Bool
otherwise -> ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack) (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack) (Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlinfo)
case InstallDir
installDir of
IsolateDir FilePath
isoDir -> do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"isolated installing Stack to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir (FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir) Version
ver Bool
forceInstall
InstallDir
GHCupInternal -> do
Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
())
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, GPGError,
DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadCatch m, MonadIO m) =>
FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
workdir (FilePath -> InstallDirResolved
GHCupDir FilePath
binDir) Version
ver Bool
forceInstall
installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
=> FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked :: FilePath
-> InstallDirResolved
-> Version
-> Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
installStackUnpacked FilePath
path InstallDirResolved
installDir Version
ver Bool
forceInstall = do
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing stack"
let stackFile :: FilePath
stackFile = FilePath
"stack"
IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> IO () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir)
let destFileName :: FilePath
destFileName = FilePath
stackFile
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (case InstallDirResolved
installDir of
IsolateDirResolved FilePath
_ -> FilePath
""
GHCupDir FilePath
_ -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
ver
)
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
destPath :: FilePath
destPath = InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
installDir FilePath -> FilePath -> FilePath
</> FilePath
destFileName
Bool
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceInstall
(Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
destPath)
FilePath
-> FilePath -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE
(FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
stackFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
FilePath
destPath
m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[CopyError, FileAlreadyExistsError] m ())
-> m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destPath
setGHC :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
, MonadMask m
, MonadUnliftIO m
)
=> GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC :: GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc Maybe FilePath
mBinDir = do
let verS :: FilePath
verS = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Version -> Text
prettyVer (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
FilePath
ghcdir <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver) (NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))
FilePath
binDir <- case Maybe FilePath
mBinDir of
Just FilePath
x -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x
Maybe FilePath
Nothing -> do
Dirs {$sel:binDir:Dirs :: Dirs -> FilePath
binDir = FilePath
f} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
f
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
case SetGHC
sghc of
SetGHC
SetGHCOnly -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
SetGHC
SetGHC_XY -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks GHCTargetVersion
ver
SetGHC
SetGHC_XYZ -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks GHCTargetVersion
ver
[FilePath]
verfiles <- GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
ver
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
verfiles ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
Maybe FilePath
mTargetFile <- case SetGHC
sghc of
SetGHC
SetGHCOnly -> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file
SetGHC
SetGHC_XY -> do
(ParseError -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Excepts '[NotInstalled] m (Maybe FilePath)
-> Excepts '[NotInstalled] m (Maybe FilePath)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
(\(ParseError
e :: ParseError) -> m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath))
-> m (Maybe FilePath) -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe FilePath)
-> Excepts '[NotInstalled] m (Maybe FilePath))
-> Excepts '[NotInstalled] m (Maybe FilePath)
-> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
(Int
mj, Int
mi) <- Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
let major' :: Text
major' = Int -> Text
forall a. Integral a => a -> Text
intToText Int
mj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Integral a => a -> Text
intToText Int
mi
Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
major')
SetGHC
SetGHC_XYZ ->
Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath))
-> Maybe FilePath -> Excepts '[NotInstalled] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
verS)
Maybe FilePath
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
mTargetFile ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
targetFile -> do
FilePath
bindir <- GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> m FilePath
ghcInternalBinDir GHCTargetVersion
ver
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
targetFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
fileWithExt :: FilePath
fileWithExt = FilePath
bindir FilePath -> FilePath -> FilePath
</> FilePath
file FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
FilePath
destL <- FilePath -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
binarySymLinkDestination FilePath
binDir FilePath
fileWithExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL FilePath
fullF
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (GHCTargetVersion -> Maybe Text) -> GHCTargetVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Maybe Text
_tvTarget (GHCTargetVersion -> Bool) -> GHCTargetVersion -> Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadCatch m, MonadMask m) =>
FilePath -> FilePath -> m ()
symlinkShareDir FilePath
ghcdir FilePath
verS
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SetGHC
sghc SetGHC -> SetGHC -> Bool
forall a. Eq a => a -> a -> Bool
== SetGHC
SetGHCOnly) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadCatch m, MonadIO m) =>
m ()
warnAboutHlsCompatibility
GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
ver
where
symlinkShareDir :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadCatch m
, MonadMask m
)
=> FilePath
-> String
-> m ()
symlinkShareDir :: FilePath -> FilePath -> m ()
symlinkShareDir FilePath
ghcdir FilePath
ver' = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let destdir :: FilePath
destdir = FilePath
baseDir
case SetGHC
sghc of
SetGHC
SetGHCOnly -> do
let sharedir :: FilePath
sharedir = FilePath
"share"
let fullsharedir :: FilePath
fullsharedir = FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
sharedir
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Checking for sharedir existence: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullsharedir
m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
fullsharedir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let fullF :: FilePath
fullF = FilePath
destdir FilePath -> FilePath -> FilePath
</> FilePath
sharedir
let targetF :: FilePath
targetF = FilePath
"." FilePath -> FilePath -> FilePath
</> FilePath
"ghc" FilePath -> FilePath -> FilePath
</> FilePath
ver' FilePath -> FilePath -> FilePath
</> FilePath
sharedir
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
rmDirectoryLink FilePath
fullF
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"ln -s " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
targetF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF
if Bool
isWindows
then IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
permissionErrorType
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
illegalOperationErrorType
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
targetF FilePath
fullF
else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
targetF FilePath
fullF
SetGHC
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
unsetGHC :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Maybe Text
-> Excepts '[NotInstalled] m ()
unsetGHC :: Maybe Text -> Excepts '[NotInstalled] m ()
unsetGHC = Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC
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
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
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
setHLS :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
, MonadFail m
, MonadUnliftIO m
)
=> Version
-> SetHLS
-> Maybe FilePath
-> Excepts '[NotInstalled] m ()
setHLS :: Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
ver SetHLS
shls Maybe FilePath
mBinDir = do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver) (NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver)))
FilePath
binDir <- case Maybe FilePath
mBinDir of
Just FilePath
x -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x
Maybe FilePath
Nothing -> do
Dirs {$sel:binDir:Dirs :: Dirs -> FilePath
binDir = FilePath
f} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
f
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
case SetHLS
shls of
SetHLS
SetHLS_XYZ -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
Version -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks Version
ver
SetHLS
SetHLSOnly -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadMask m) =>
Excepts '[NotInstalled] m ()
rmPlainHLS
case SetHLS
shls of
SetHLS
SetHLS_XYZ -> do
[FilePath]
bins <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
ver Maybe Version
forall a. Maybe a
Nothing
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let fname :: FilePath
fname = FilePath -> FilePath
takeFileName FilePath
f
FilePath
destL <- FilePath -> FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
binarySymLinkDestination FilePath
binDir FilePath
f
let target :: FilePath
target = if FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fname
then FilePath
fname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
else FilePath
fname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"~" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
target)
SetHLS
SetHLSOnly -> do
[FilePath]
bins <- m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> m [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
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)
let destL :: FilePath
destL = FilePath
"haskell-language-server-wrapper-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let wrapper :: FilePath
wrapper = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> m ()
forall (m :: * -> *) env.
(MonadMask m, MonadThrow m, HasLog env, MonadIO m,
MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) =>
FilePath -> FilePath -> m ()
createLink FilePath
destL FilePath
wrapper
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mBinDir) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadCatch m, MonadIO m) =>
m ()
warnAboutHlsCompatibility
unsetHLS :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadIO m)
=> m ()
unsetHLS :: m ()
unsetHLS = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let wrapper :: FilePath
wrapper = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
[FilePath]
bins <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Parsec Void Text Text -> IO [FilePath]
forall a. FilePath -> Parsec Void Text a -> IO [FilePath]
findFiles'
FilePath
binDir
(Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"haskell-language-server-" Parsec Void Text Text
-> ParsecT Void Text Identity PVP -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity PVP
pvp' Parsec Void Text Text
-> Parsec Void Text Text -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk (FilePath -> Text
T.pack FilePath
exeExt) Parsec Void Text Text
-> ParsecT Void Text Identity () -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof)
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
bins (IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
binDir FilePath -> FilePath -> FilePath
</>))
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
wrapper
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
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
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 ()
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
data ListResult = ListResult
{ ListResult -> Tool
lTool :: Tool
, ListResult -> Version
lVer :: Version
, ListResult -> Maybe Text
lCross :: Maybe Text
, ListResult -> [Tag]
lTag :: [Tag]
, ListResult -> Bool
lInstalled :: Bool
, ListResult -> Bool
lSet :: Bool
, ListResult -> Bool
fromSrc :: Bool
, ListResult -> Bool
lStray :: Bool
, ListResult -> Bool
lNoBindist :: Bool
, 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)
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
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
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
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
, 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
, 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
, 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
, hlsPowered :: Bool
hlsPowered = Bool
False
, Bool
lSet :: Bool
lSet :: Bool
..
}
Left FilePath
e -> do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
(Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not parse version of stray directory" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
e
Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
currentGHCup :: Map Version VersionInfo -> Maybe ListResult
currentGHCup Map Version VersionInfo
av =
let currentVer :: Version
currentVer = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ PVP -> Text -> Maybe Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
ghcUpVer Text
""
listVer :: Maybe VersionInfo
listVer = Version -> Map Version VersionInfo -> Maybe VersionInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
currentVer Map Version VersionInfo
av
latestVer :: Maybe Version
latestVer = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Map Version VersionInfo -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Tag
-> Optic'
A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Latest) Map Version VersionInfo
av
recommendedVer :: Maybe Version
recommendedVer = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Map Version VersionInfo -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Tag
-> Optic'
A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Latest) Map Version VersionInfo
av
isOld :: Bool
isOld = Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
currentVer) Maybe Version
latestVer Bool -> Bool -> Bool
&& Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
currentVer) Maybe Version
recommendedVer
in if | Version -> Map Version VersionInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Version
currentVer Map Version VersionInfo
av -> Maybe ListResult
forall a. Maybe a
Nothing
| Bool
otherwise -> ListResult -> Maybe ListResult
forall a. a -> Maybe a
Just (ListResult -> Maybe ListResult) -> ListResult -> Maybe ListResult
forall a b. (a -> b) -> a -> b
$ ListResult :: Tool
-> Version
-> Maybe Text
-> [Tag]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> ListResult
ListResult { lVer :: Version
lVer = Version
currentVer
, lTag :: [Tag]
lTag = [Tag] -> (VersionInfo -> [Tag]) -> Maybe VersionInfo -> [Tag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Bool
isOld then [Tag
Old] else []) VersionInfo -> [Tag]
_viTags Maybe VersionInfo
listVer
, lCross :: Maybe Text
lCross = Maybe Text
forall a. Maybe a
Nothing
, lTool :: Tool
lTool = Tool
GHCup
, fromSrc :: Bool
fromSrc = Bool
False
, lStray :: Bool
lStray = Maybe VersionInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe VersionInfo
listVer
, lSet :: Bool
lSet = Bool
True
, lInstalled :: Bool
lInstalled = Bool
True
, lNoBindist :: Bool
lNoBindist = Bool
False
, hlsPowered :: Bool
hlsPowered = Bool
False
}
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
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
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSetGHC (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc symlinks"
Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadMask m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing ghc-x.y.z symlinks"
Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks GHCTargetVersion
ver
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Removing/rewiring ghc-x.y symlinks"
(ParseError -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
_ :: ParseError) -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks GHCTargetVersion
ver
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing directory recursively: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
dir
Maybe (Int, Int)
v' <-
(ParseError -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
(\(ParseError
e :: ParseError) -> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int)
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just
(Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Maybe (Int, Int)
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Int, Int)
v' (((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP (NonEmpty Word -> PVP
PVP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mj Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mi])) (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver))
Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe FilePath
forall a. Maybe a
Nothing)
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
rmDirectoryLink (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"share")
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)
rmHLSVer :: ( MonadMask m
, MonadReader env m
, HasDirs env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadFail m
, MonadCatch m
, MonadUnliftIO m
)
=> Version
-> Excepts '[NotInstalled] m ()
rmHLSVer :: Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
ver = do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
ver))
Maybe Version
isHlsSet <- m (Maybe Version) -> Excepts '[NotInstalled] m (Maybe Version)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadCatch m) =>
m (Maybe Version)
hlsSet
Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, HasLog env,
MonadThrow m, MonadFail m, MonadMask m) =>
Version -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks Version
ver
FilePath
hlsDir <- Version -> Excepts '[NotInstalled] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
FilePath -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
hlsDir
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadMask m) =>
Excepts '[NotInstalled] m ()
rmPlainHLS
[Version]
hlsVers <- m [Version] -> Excepts '[NotInstalled] m [Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version] -> Excepts '[NotInstalled] m [Version])
-> m [Version] -> Excepts '[NotInstalled] m [Version]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers of
Just Version
latestver -> Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe FilePath -> Excepts '[NotInstalled] m ()
setHLS Version
latestver SetHLS
SetHLSOnly Maybe FilePath
forall a. Maybe a
Nothing
Maybe Version
Nothing -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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)
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
FilePath
p1 <- IOErrorType
-> (IOException -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
(FilePath -> IOException -> m FilePath
forall (m :: * -> *) env p.
(MonadReader env m,
LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
currentRunningExecPath)
(IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath)
FilePath
p2 <- IOErrorType
-> (IOException -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
doesNotExistErrorType
(FilePath -> IOException -> m FilePath
forall (m :: * -> *) env p.
(MonadReader env m,
LabelOptic "loggerConfig" A_Lens env env LoggerConfig LoggerConfig,
MonadIO m) =>
FilePath -> p -> m FilePath
handlePathNotPresent FilePath
ghcupFilepath)
(IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
ghcupFilepath)
let areEqualPaths :: Bool
areEqualPaths = FilePath -> FilePath -> Bool
equalFilePath FilePath
p1 FilePath
p2
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
areEqualPaths (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
nonStandardInstallLocationMsg FilePath
currentRunningExecPath
if Bool
isWindows
then do
FilePath
tempFilepath <- m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
UnsupportedOperation (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> IO ()
moveFile FilePath
ghcupFilepath (FilePath
tempFilepath FilePath -> FilePath -> FilePath
</> FilePath
"ghcup")
else
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
ghcupFilepath
where
handlePathNotPresent :: FilePath -> p -> m FilePath
handlePathNotPresent FilePath
fp p
_err = do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error: The path does not exist, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fp
FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fp
nonStandardInstallLocationMsg :: FilePath -> Text
nonStandardInstallLocationMsg FilePath
path = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
FilePath
"current ghcup is invoked from a non-standard location: \n"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath
"\n you may have to uninstall it manually."
rmTool :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadFail m
, MonadMask m
, MonadUnliftIO m)
=> ListResult
-> Excepts '[NotInstalled ] m ()
rmTool :: ListResult -> Excepts '[NotInstalled] m ()
rmTool ListResult {Version
lVer :: Version
lVer :: ListResult -> Version
lVer, Tool
lTool :: Tool
lTool :: ListResult -> Tool
lTool, Maybe Text
lCross :: Maybe Text
lCross :: ListResult -> Maybe Text
lCross} = do
case Tool
lTool of
Tool
GHC ->
let ghcTargetVersion :: GHCTargetVersion
ghcTargetVersion = Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
lCross Version
lVer
in GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ghcTargetVersion
Tool
HLS -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
lVer
Tool
Cabal -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmCabalVer Version
lVer
Tool
Stack -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmStackVer Version
lVer
Tool
GHCup -> m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m,
HasLog env, MonadMask m, MonadUnliftIO m) =>
m ()
rmGhcup
rmGhcupDirs :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadCatch m
, MonadMask m )
=> m [FilePath]
rmGhcupDirs :: m [FilePath]
rmGhcupDirs = do
Dirs
{ FilePath
baseDir :: FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
baseDir
, FilePath
binDir :: FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
binDir
, FilePath
logsDir :: FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
logsDir
, FilePath
cacheDir :: FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
cacheDir
, FilePath
recycleDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
recycleDir
} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let envFilePath :: FilePath
envFilePath = FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"env"
FilePath
confFilePath <- m FilePath
forall (m :: * -> *). MonadIO m => m FilePath
getConfigFilePath
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmEnvFile FilePath
envFilePath
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmConfFile FilePath
confFilePath
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
logsDir
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
cacheDir
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
rmBinDir FilePath
binDir
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(HasLog env, MonadReader env m, HasDirs env, MonadMask m,
MonadIO m, MonadCatch m) =>
FilePath -> m ()
rmDir FilePath
recycleDir
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isWindows (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"removing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"msys64")
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"msys64")
m () -> m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, HasLog env, MonadIO m) =>
m () -> m ()
handleRm (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
removeEmptyDirsRecursive FilePath
baseDir
[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 =
[IOErrorType] -> () -> m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] () (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"removing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir
[FilePath]
contents <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
dir
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents (FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m) =>
FilePath -> m ()
deleteFile (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>))
rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
rmBinDir :: FilePath -> m ()
rmBinDir FilePath
binDir
| Bool
isWindows = FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
| Bool
otherwise = do
Bool
isXDGStyle <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
useXDG
if Bool -> Bool
not Bool
isXDGStyle
then FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadMask m, MonadIO m,
MonadCatch m) =>
FilePath -> m ()
removeDirIfEmptyOrIsSymlink FilePath
binDir
else () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
reportRemainingFiles :: MonadIO m => FilePath -> m [FilePath]
reportRemainingFiles :: FilePath -> m [FilePath]
reportRemainingFiles FilePath
dir = do
([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
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
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
.. }
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
-> Maybe Version
-> Either Version FilePath
-> Maybe Int
-> Maybe FilePath
-> Maybe (Either FilePath [URI])
-> [Text]
-> Maybe String
-> Bool
-> InstallDir
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, GPGError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
, DirNotEmpty
, ArchiveResult
, FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, ProcessError
, CopyError
, BuildFailed
]
m
GHCTargetVersion
compileGHC :: Either GHCTargetVersion GitBranch
-> Maybe Version
-> Either Version FilePath
-> Maybe Int
-> Maybe FilePath
-> Maybe (Either FilePath [URI])
-> [Text]
-> Maybe FilePath
-> Bool
-> InstallDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
GHCTargetVersion
compileGHC Either GHCTargetVersion GitBranch
targetGhc Maybe Version
ov Either Version FilePath
bstrap Maybe Int
jobs Maybe FilePath
mbuildConfig Maybe (Either FilePath [URI])
patches [Text]
aargs Maybe FilePath
buildFlavour Bool
hadrian InstallDir
installDir
= do
PlatformRequest { Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
.. } <- m PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
PlatformRequest
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m PlatformRequest
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "pfreq" A_Lens env PlatformRequest) =>
m PlatformRequest
getPlatformReq
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
(FilePath
workdir, FilePath
tmpUnpack, GHCTargetVersion
tver) <- case Either GHCTargetVersion GitBranch
targetGhc of
Left GHCTargetVersion
tver -> do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requested to compile: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GHCTargetVersion -> Text
tVerToText GHCTargetVersion
tver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Version -> Text)
-> (FilePath -> Text) -> Either Version FilePath -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Text
prettyVer FilePath -> Text
T.pack Either Version FilePath
bstrap
DownloadInfo
dlInfo <-
Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
-> GHCupDownloads -> Maybe DownloadInfo
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
An_AffineTraversal
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
VersionInfo
VersionInfo
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
(IxKind (Map Version VersionInfo))
'[]
(Map Version VersionInfo)
(IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (GHCTargetVersion
tver GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion) Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
-> Optic
A_Lens
'[]
VersionInfo
VersionInfo
(Maybe DownloadInfo)
(Maybe DownloadInfo)
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Maybe DownloadInfo)
(Maybe DownloadInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Lens
'[]
VersionInfo
VersionInfo
(Maybe DownloadInfo)
(Maybe DownloadInfo)
viSourceDL Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Maybe DownloadInfo)
(Maybe DownloadInfo)
-> Optic
A_Prism
'[]
(Maybe DownloadInfo)
(Maybe DownloadInfo)
DownloadInfo
DownloadInfo
-> Optic' An_AffineTraversal '[] GHCupDownloads DownloadInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
A_Prism
'[]
(Maybe DownloadInfo)
(Maybe DownloadInfo)
DownloadInfo
DownloadInfo
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
Maybe DownloadInfo
-> NoDownload
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
FilePath
dl <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadResource m, MonadThrow m, HasLog env, MonadIO m,
MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached DownloadInfo
dlInfo Maybe FilePath
forall a. Maybe a
Nothing
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
tmpUnpack (FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m) =>
FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
tmpUnpack FilePath
dl)
Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
FilePath
workdir <- Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
-> (TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath)
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tmpUnpack)
(Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath)
-> (TarDir -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m, MonadThrow m,
MonadCatch m) =>
FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
tmpUnpack)
(Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
-> DownloadInfo -> Maybe TarDir
forall k (is :: [*]) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] DownloadInfo (Maybe TarDir)
dlSubdir DownloadInfo
dlInfo)
Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
patches FilePath
workdir
(FilePath, FilePath, GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(FilePath, FilePath, GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
workdir, FilePath
tmpUnpack, GHCTargetVersion
tver)
Right GitBranch{FilePath
Maybe FilePath
repo :: Maybe FilePath
ref :: FilePath
$sel:repo:GitBranch :: GitBranch -> Maybe FilePath
$sel:ref:GitBranch :: GitBranch -> FilePath
..} -> do
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadUnliftIO m, HasLog env,
MonadCatch m, MonadThrow m, MonadMask m, MonadIO m) =>
m FilePath
mkGhcupTmpDir
let git :: [FilePath] -> m (Either ProcessError ())
git [FilePath]
args = FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
"git" (FilePath
"--no-pager"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
args) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"git" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
Version
tver <- (V '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
-> DownloadFailed)
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Version
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, DownloadFailed, GPGError] V '[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
-> DownloadFailed
forall (xs :: [*]).
(ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs,
Show (V xs), Pretty (V xs)) =>
V xs -> DownloadFailed
DownloadFailed (Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Version)
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Version
forall a b. (a -> b) -> a -> b
$ do
let rep :: FilePath
rep = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"https://gitlab.haskell.org/ghc/ghc.git" Maybe FilePath
repo
m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Fetching git repo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" at ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (this may take a while)"
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"init" ]
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"remote"
, FilePath
"add"
, FilePath
"origin"
, FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
rep ]
let fetch_args :: [FilePath]
fetch_args =
[ FilePath
"fetch"
, FilePath
"--depth"
, FilePath
"1"
, FilePath
"--quiet"
, FilePath
"origin"
, FilePath -> FilePath
forall a. IsString a => FilePath -> a
fromString FilePath
ref ]
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [FilePath]
fetch_args
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"checkout", FilePath
"FETCH_HEAD" ]
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m (Either ProcessError ())
git [ FilePath
"submodule", FilePath
"update", FilePath
"--init", FilePath
"--depth", FilePath
"1" ]
Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
patches FilePath
tmpUnpack
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"python3" [FilePath
"./boot"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"ghc-bootstrap"
m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"sh" [FilePath
"./configure"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack) FilePath
"ghc-bootstrap"
CapturedProcess {ByteString
ExitCode
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
$sel:_stdOut:CapturedProcess :: CapturedProcess -> ByteString
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
_stdErr :: ByteString
_stdOut :: ByteString
_exitCode :: ExitCode
..} <- m CapturedProcess
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
CapturedProcess
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
CapturedProcess)
-> m CapturedProcess
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
CapturedProcess
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m CapturedProcess
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
[FilePath] -> Maybe FilePath -> m CapturedProcess
makeOut
[FilePath
"show!", FilePath
"--quiet", FilePath
"VALUE=ProjectVersion" ] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
tmpUnpack)
case ExitCode
_exitCode of
ExitCode
ExitSuccess -> Either (ParseErrorBundle Text Void) Version
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) Version
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version)
-> (ByteString -> Either (ParseErrorBundle Text Void) Version)
-> ByteString
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
ghcProjectVersion FilePath
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version)
-> ByteString
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut
ExitFailure Int
c -> FilePath
-> Excepts
'[PatchFailed, ProcessError, NotFoundInPATH, DigestError,
DownloadFailed, GPGError]
m
Version
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Could not figure out GHC project version. Exit code was: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
". Error was: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (ByteString -> Text
decUTF8Safe' ByteString
_stdErr))
Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[ProcessError] m () -> Excepts '[] m ()
forall (es :: [*]) (m :: * -> *) env.
(Pretty (V es), MonadReader env m, HasLog env, MonadIO m,
Monad m) =>
Excepts es m () -> Excepts '[] m ()
catchWarn (Excepts '[ProcessError] m () -> Excepts '[] m ())
-> Excepts '[ProcessError] m () -> Excepts '[] m ()
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
forall a (m :: * -> *).
(Monad m, ProcessError :< '[ProcessError]) =>
m (Either ProcessError a) -> Excepts '[ProcessError] m a
lEM @_ @'[ProcessError] (m (Either ProcessError ()) -> Excepts '[ProcessError] m ())
-> m (Either ProcessError ()) -> Excepts '[ProcessError] m ()
forall a b. (a -> b) -> a -> b
$ Platform -> FilePath -> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
_rPlatform FilePath
tmpUnpack
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Git version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" corresponds to GHC version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
tver
(FilePath, FilePath, GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(FilePath, FilePath, GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
tmpUnpack, FilePath
tmpUnpack, Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
tver)
let installVer :: GHCTargetVersion
installVer = GHCTargetVersion
-> (Version -> GHCTargetVersion)
-> Maybe Version
-> GHCTargetVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GHCTargetVersion
tver (\Version
ov' -> GHCTargetVersion
tver { $sel:_tvVersion:GHCTargetVersion :: Version
_tvVersion = Version
ov' }) Maybe Version
ov
Bool
alreadyInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
installVer
Bool
alreadySet <- (Maybe GHCTargetVersion -> Bool)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
installVer) (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
Bool
forall a b. (a -> b) -> a -> b
$ m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
installVer)
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ do
case InstallDir
installDir of
IsolateDir FilePath
isoDir ->
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Isolate installing to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
isoDir
InstallDir
GHCupInternal ->
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"GHC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (GHCTargetVersion -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow GHCTargetVersion
installVer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already installed. Will overwrite existing version."
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 10 seconds before continuing, you can still abort..."
IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
10000000
InstallDirResolved
ghcdir <- case InstallDir
installDir of
IsolateDir FilePath
isoDir -> InstallDirResolved
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
InstallDirResolved
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InstallDirResolved
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
InstallDirResolved)
-> InstallDirResolved
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
InstallDirResolved
forall a b. (a -> b) -> a -> b
$ FilePath -> InstallDirResolved
IsolateDirResolved FilePath
isoDir
InstallDir
GHCupInternal -> FilePath -> InstallDirResolved
GHCupDir (FilePath -> InstallDirResolved)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
InstallDirResolved
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
installVer)
(Maybe FilePath
mBindist, ByteString
bmk) <- Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe FilePath, ByteString)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe FilePath, ByteString))
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
(Maybe FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe FilePath
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
forall env (m :: * -> *) (e :: [*]) a.
(MonadReader env m, HasDirs env, HasSettings env, MonadIO m,
MonadMask m, HasLog env, MonadUnliftIO m, MonadFail m,
MonadCatch m) =>
FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction
FilePath
tmpUnpack
Maybe FilePath
forall a. Maybe a
Nothing
(do
Maybe FilePath
b <- if Bool
hadrian
then GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
compileHadrianBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
else GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
compileMakeBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
ByteString
bmk <- IO ByteString
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
ByteString)
-> IO ByteString
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ByteString) -> IO ByteString -> IO ByteString
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"") (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile (FilePath -> FilePath
build_mk FilePath
workdir)
(Maybe FilePath, ByteString)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
b, ByteString
bmk)
)
case InstallDir
installDir of
InstallDir
GHCupInternal ->
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Deleting existing installation"
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
installVer
InstallDir
_ -> ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe FilePath
-> (FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
mBindist ((FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> (FilePath
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ \FilePath
bindist -> do
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
HasPlatformReq env, HasSettings env, MonadThrow m, HasLog env,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
FilePath
-> Maybe TarDir
-> InstallDirResolved
-> Version
-> Bool
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError]
m
()
installPackedGHC FilePath
bindist
(TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (TarDir -> Maybe TarDir) -> TarDir -> Maybe TarDir
forall a b. (a -> b) -> a -> b
$ FilePath -> TarDir
RegexDir FilePath
"ghc-.*")
InstallDirResolved
ghcdir
(GHCTargetVersion
installVer GHCTargetVersion
-> Optic' A_Lens '[] GHCTargetVersion Version -> Version
forall k s (is :: [*]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens '[] GHCTargetVersion Version
tvVersion)
Bool
False
IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (InstallDirResolved -> FilePath
fromInstallDir InstallDirResolved
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
ghcUpSrcBuiltFile) ByteString
bmk
case InstallDir
installDir of
InstallDir
GHCupInternal -> do
(V '[NotInstalled] -> GHCupSetError)
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[NotInstalled] -> GHCupSetError
forall (es :: [*]).
(ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es,
Show (V es), Pretty (V es)) =>
V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
installVer
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
installVer SetGHC
SetGHCOnly Maybe FilePath
forall a. Maybe a
Nothing
InstallDir
_ -> ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
GHCTargetVersion
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, GPGError,
DownloadFailed, GHCupSetError, NoDownload, NotFoundInPATH,
PatchFailed, UnknownArchive, TarDirDoesNotExist, NotInstalled,
DirNotEmpty, ArchiveResult, FileDoesNotExistError, HadrianNotFound,
InvalidBuildConfig, ProcessError, CopyError, BuildFailed]
m
GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
installVer
where
defaultConf :: Text
defaultConf =
let cross_mk :: Text
cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
default_mk :: Text
default_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/default" >> runIO (readFile "data/build_mk/default")))
in case Either GHCTargetVersion GitBranch
targetGhc of
Left (GHCTargetVersion (Just Text
_) Version
_) -> Text
cross_mk
Either GHCTargetVersion GitBranch
_ -> Text
default_mk
compileHadrianBindist :: ( MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, MonadThrow m
, MonadCatch m
, HasLog env
, MonadIO m
, MonadFail m
)
=> GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[ FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, PatchFailed
, ProcessError
, NotFoundInPATH
, CopyError]
m
(Maybe FilePath)
compileHadrianBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
compileHadrianBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir = do
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
"python3" [FilePath
"./boot"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"ghc-bootstrap"
Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
configureBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Building (this may take a while)..."
FilePath
hadrian_build <- Excepts '[HadrianNotFound] m FilePath
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[HadrianNotFound] m FilePath
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
FilePath)
-> Excepts '[HadrianNotFound] m FilePath
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[HadrianNotFound] m FilePath
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[HadrianNotFound] m FilePath
findHadrianFile FilePath
workdir
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
hadrian_build
( [FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"-j" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j] ) Maybe Int
jobs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
bf -> [FilePath
"--flavour=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
bf]) Maybe FilePath
buildFlavour
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"binary-dist"]
)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir) FilePath
"ghc-make"
[FilePath
tar] <- IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath])
-> IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
(FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"_build" FilePath -> FilePath -> FilePath
</> FilePath
"bindist")
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^ghc-.*\.tar\..*$|] :: ByteString)
)
Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath))
-> Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe FilePath)
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath))
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
HasLog env) =>
GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
copyBindist GHCTargetVersion
tver FilePath
tar (FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"_build" FilePath -> FilePath -> FilePath
</> FilePath
"bindist")
findHadrianFile :: (MonadIO m)
=> FilePath
-> Excepts
'[HadrianNotFound]
m
FilePath
findHadrianFile :: FilePath -> Excepts '[HadrianNotFound] m FilePath
findHadrianFile FilePath
workdir = do
let possible_files :: [FilePath]
possible_files = if Bool
isWindows
then ((FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"hadrian") FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath
"build.bat"]
else ((FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"hadrian") FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath
"build", FilePath
"build.sh"]
[(Bool, FilePath)]
exsists <- [FilePath]
-> (FilePath -> Excepts '[HadrianNotFound] m (Bool, FilePath))
-> Excepts '[HadrianNotFound] m [(Bool, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
possible_files (\FilePath
f -> IO Bool -> Excepts '[HadrianNotFound] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
f) Excepts '[HadrianNotFound] m Bool
-> (Bool -> (Bool, FilePath))
-> Excepts '[HadrianNotFound] m (Bool, FilePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,FilePath
f))
case ((Bool, FilePath) -> Bool)
-> [(Bool, FilePath)] -> [(Bool, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, FilePath) -> Bool
forall a b. (a, b) -> a
fst [(Bool, FilePath)]
exsists of
[] -> HadrianNotFound -> Excepts '[HadrianNotFound] m FilePath
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE HadrianNotFound
HadrianNotFound
((Bool
_, FilePath
x):[(Bool, FilePath)]
_) -> FilePath -> Excepts '[HadrianNotFound] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x
compileMakeBindist :: ( MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, MonadThrow m
, MonadCatch m
, HasLog env
, MonadIO m
, MonadFail m
)
=> GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[ FileDoesNotExistError
, HadrianNotFound
, InvalidBuildConfig
, PatchFailed
, ProcessError
, NotFoundInPATH
, CopyError]
m
(Maybe FilePath)
compileMakeBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
compileMakeBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir = do
Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadThrow m, MonadCatch m, HasLog env,
MonadIO m, MonadFail m) =>
GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
configureBindist GHCTargetVersion
tver FilePath
workdir InstallDirResolved
ghcdir
case Maybe FilePath
mbuildConfig of
Just FilePath
bc -> IOErrorType
-> FileDoesNotExistError
-> m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (m :: * -> *) e (es' :: [*]) a.
(MonadCatch m, MonadIO m, Monad m, e :< es') =>
IOErrorType -> e -> m a -> Excepts es' m a
liftIOException
IOErrorType
doesNotExistErrorType
(FilePath -> FileDoesNotExistError
FileDoesNotExistError FilePath
bc)
(IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
bc (FilePath -> FilePath
build_mk FilePath
workdir))
Maybe FilePath
Nothing ->
IO ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> IO ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile (FilePath -> FilePath
build_mk FilePath
workdir) (Text -> Text
addBuildFlavourToConf Text
defaultConf)
Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall env (m :: * -> *).
(MonadReader env m, MonadCatch m, MonadIO m, HasLog env) =>
FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig (FilePath -> FilePath
build_mk FilePath
workdir)
m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Building (this may take a while)..."
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make ([FilePath] -> (Int -> [FilePath]) -> Maybe Int -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [FilePath
"-j" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. IsString a => FilePath -> a
fS (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
j)]) Maybe Int
jobs) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
if | GHCTargetVersion -> Bool
isCross GHCTargetVersion
tver -> do
m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Installing cross toolchain..."
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"install"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
Maybe FilePath
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
| Bool
otherwise -> do
m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m ()
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Creating bindist..."
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
forall (m :: * -> *) env.
(MonadThrow m, MonadIO m, MonadReader env m, HasDirs env,
HasLog env, HasSettings env) =>
[FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath
"binary-dist"] (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
[FilePath
tar] <- IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath])
-> IO [FilePath]
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
[FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
workdir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^ghc-.*\.tar\..*$|] :: ByteString)
)
Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath))
-> Excepts '[CopyError] m (Maybe FilePath)
-> Excepts
'[FileDoesNotExistError, HadrianNotFound, InvalidBuildConfig,
PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe FilePath)
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath))
-> Excepts '[CopyError] m FilePath
-> Excepts '[CopyError] m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env,
HasPlatformReq env, MonadIO m, MonadThrow m, MonadCatch m,
HasLog env) =>
GHCTargetVersion
-> FilePath -> FilePath -> Excepts '[CopyError] m FilePath
copyBindist GHCTargetVersion
tver FilePath
tar FilePath
workdir
build_mk :: FilePath -> FilePath
build_mk FilePath
workdir = FilePath
workdir FilePath -> FilePath -> FilePath
</> FilePath
"mk" FilePath -> FilePath -> FilePath
</> FilePath
"build.mk"
copyBindist :: ( MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, MonadIO m
, MonadThrow m
, MonadCatch m
, HasLog env
)
=> GHCTargetVersion
-> FilePath
-> FilePath
-> 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
case Either GHCTargetVersion GitBranch
targetGhc of
Left (GHCTargetVersion (Just Text
_) Version
_) -> Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"Stage1Only = YES" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ InvalidBuildConfig
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
(Text -> InvalidBuildConfig
InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
)
Either GHCTargetVersion GitBranch
_ -> () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe FilePath
-> (FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
buildFlavour ((FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> (FilePath
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
bf ->
Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath -> Text
T.pack (FilePath
"BuildFlavour = " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
bf) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ do
m () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Customly specified build config overwrites --flavour=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" switch! Waiting 5 seconds..."
IO () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> IO ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
addBuildFlavourToConf :: Text -> Text
addBuildFlavourToConf Text
bc = case Maybe FilePath
buildFlavour of
Just FilePath
bf -> Text
"BuildFlavour = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
bf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bc
Maybe FilePath
Nothing -> Text
bc
isCross :: GHCTargetVersion -> Bool
isCross :: GHCTargetVersion -> Bool
isCross = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> (GHCTargetVersion -> Maybe Text) -> GHCTargetVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Maybe Text
_tvTarget
configureBindist :: ( MonadReader env m
, HasDirs env
, HasSettings env
, HasPlatformReq env
, MonadThrow m
, MonadCatch m
, HasLog env
, MonadIO m
, MonadFail m
)
=> GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[ FileDoesNotExistError
, InvalidBuildConfig
, PatchFailed
, ProcessError
, NotFoundInPATH
, CopyError
]
m
()
configureBindist :: GHCTargetVersion
-> FilePath
-> InstallDirResolved
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
configureBindist GHCTargetVersion
tver FilePath
workdir (InstallDirResolved -> FilePath
fromInstallDir -> FilePath
ghcdir) = do
m ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> m ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo [s|configuring build|]
if | GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.8.0|] -> do
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, HasLog env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv
FilePath
"sh"
(FilePath
"./configure" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath]
forall a. Monoid a => a
mempty
(\Text
x -> [FilePath
"--target=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
x])
(GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcdir]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
isWindows then [FilePath
"--enable-tarballs-autodownload"] else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
aargs
)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
FilePath
"ghc-conf"
| Bool
otherwise -> do
m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> m (Either ProcessError ())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged
FilePath
"sh"
( [ FilePath
"./configure", FilePath
"--with-ghc=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FilePath)
-> (FilePath -> FilePath) -> Either FilePath FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id Either FilePath FilePath
bghc
]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath] -> (Text -> [FilePath]) -> Maybe Text -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath]
forall a. Monoid a => a
mempty
(\Text
x -> [FilePath
"--target=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
x])
(GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--prefix=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ghcdir]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
isWindows then [FilePath
"--enable-tarballs-autodownload"] else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack [Text]
aargs
)
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
workdir)
FilePath
"ghc-conf"
Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
execWithGhcEnv :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> FilePath
-> [String]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv :: FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> m (Either ProcessError ())
execWithGhcEnv FilePath
fp [FilePath]
args Maybe FilePath
dir FilePath
logf = do
[(FilePath, FilePath)]
env <- m [(FilePath, FilePath)]
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
m [(FilePath, FilePath)]
ghcEnv
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
fp [FilePath]
args Maybe FilePath
dir FilePath
logf ([(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env)
bghc :: Either FilePath FilePath
bghc = case Either Version FilePath
bstrap of
Right FilePath
g -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
g
Left Version
bver -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath
"ghc-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath
T.unpack (Text -> FilePath) -> (Version -> Text) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer (Version -> FilePath) -> Version -> FilePath
forall a b. (a -> b) -> a -> b
$ Version
bver) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
ghcEnv :: m [(FilePath, FilePath)]
ghcEnv = do
[(FilePath, FilePath)]
cEnv <- IO [(FilePath, FilePath)] -> m [(FilePath, FilePath)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FilePath, FilePath)]
getEnvironment
FilePath
bghcPath <- case Either FilePath FilePath
bghc of
Right FilePath
ghc' -> FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
ghc'
Left FilePath
bver -> do
[FilePath]
spaths <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
NotFoundInPATH -> m (Maybe FilePath) -> m FilePath
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
a -> m (Maybe b) -> m b
throwMaybeM (FilePath -> NotFoundInPATH
NotFoundInPATH FilePath
bver) (m (Maybe FilePath) -> m FilePath)
-> m (Maybe FilePath) -> m FilePath
forall a b. (a -> b) -> a -> b
$ IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
spaths FilePath
bver)
[(FilePath, FilePath)] -> m [(FilePath, FilePath)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
"GHC", FilePath
bghcPath) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
cEnv)
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
-> Bool
-> Bool
-> Excepts
'[ CopyError
, DigestError
, GPGError
, GPGError
, DownloadFailed
, NoDownload
, NoUpdate
, GHCupShadowed
]
m
Version
upgradeGHCup :: Maybe FilePath
-> Bool
-> Bool
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
Version
upgradeGHCup Maybe FilePath
mtarget Bool
force' Bool
fatal = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Upgrading GHCup..."
let latestVer :: Version
latestVer = (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst (Maybe (Version, VersionInfo) -> (Version, VersionInfo)
forall a. HasCallStack => Maybe a -> a
fromJust (GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup))
(Just Version
ghcupPVPVer) <- Maybe Version
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
(Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
(Maybe Version))
-> Maybe Version
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
(Maybe Version)
forall a b. (a -> b) -> a -> b
$ PVP -> Text -> Maybe Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
ghcUpVer Text
""
Bool
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force' Bool -> Bool -> Bool
&& (Version
latestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
ghcupPVPVer)) (Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ NoUpdate
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE NoUpdate
NoUpdate
DownloadInfo
dli <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
forall env (m :: * -> *).
(MonadReader env m, HasPlatformReq env, HasGHCupInfo env) =>
Tool -> Version -> Excepts '[NoDownload] m DownloadInfo
getDownloadInfo Tool
GHCup Version
latestVer
FilePath
tmp <- m FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
let fn :: FilePath
fn = FilePath
"ghcup" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
FilePath
p <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download (DownloadInfo -> URI
_dlUri DownloadInfo
dli) Maybe URI
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just (DownloadInfo -> Text
_dlHash DownloadInfo
dli)) FilePath
tmp (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fn) Bool
False
let destDir :: FilePath
destDir = FilePath -> FilePath
takeDirectory FilePath
destFile
destFile :: FilePath
destFile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
fn) Maybe FilePath
mtarget
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destDir
IO ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> IO ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
createDirRecursive' FilePath
destDir
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
NoSuchThing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile FilePath
destFile
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cp " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destFile
FilePath
-> FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (xs :: [*]) (m :: * -> *).
(CopyError :< xs, MonadCatch m, MonadIO m) =>
FilePath -> FilePath -> Excepts xs m ()
copyFileE FilePath
p
FilePath
destFile
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
FilePath -> m ()
chmod_755 FilePath
destFile
IO Bool
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
isInPath FilePath
destFile) Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
Bool
-> (Bool
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> FilePath
takeFileName FilePath
destFile) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not in PATH! You have to add it in order to use ghcup."
IO (Maybe FilePath)
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
(Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
isShadowed FilePath
destFile) Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
(Maybe FilePath)
-> (Maybe FilePath
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just FilePath
pa
| Bool
fatal -> GHCupShadowed
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FilePath -> FilePath -> Version -> GHCupShadowed
GHCupShadowed FilePath
pa FilePath
destFile Version
latestVer)
| Bool
otherwise ->
m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"ghcup is shadowed by "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pa
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". The upgrade will not be in effect, unless you remove "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
pa
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" or make sure "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
destDir
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" comes before "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
takeDirectory FilePath
pa)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in PATH."
Version
-> Excepts
'[CopyError, DigestError, GPGError, GPGError, DownloadFailed,
NoDownload, NoUpdate, GHCupShadowed]
m
Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
latestVer
postGHCInstall :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
, MonadMask m
, MonadUnliftIO m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
postGHCInstall :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
..} = do
Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
SetGHC_XYZ Maybe FilePath
forall a. Maybe a
Nothing
Maybe (Int, Int)
v' <-
(ParseError -> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
e :: ParseError) -> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall e. Exception e => e -> FilePath
displayException ParseError
e) m () -> m (Maybe (Int, Int)) -> m (Maybe (Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Int, Int) -> m (Maybe (Int, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Int, Int)
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Maybe (Int, Int))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just
(Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int)))
-> Excepts '[NotInstalled] m (Int, Int)
-> Excepts '[NotInstalled] m (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version
_tvVersion
Maybe (Int, Int)
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Int, Int)
v' (((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> ((Int, Int) -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) -> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP (NonEmpty Word -> PVP
PVP (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mj Word -> [Word] -> NonEmpty Word
forall a. a -> [a] -> NonEmpty a
:| [Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mi])) Maybe Text
_tvTarget)
Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe FilePath
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY Maybe FilePath
forall a. Maybe a
Nothing)
whereIsTool :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
, MonadMask m
, MonadUnliftIO m
)
=> Tool
-> GHCTargetVersion
-> Excepts '[NotInstalled] m FilePath
whereIsTool :: Tool -> GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
whereIsTool Tool
tool ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
..} = do
Dirs
dirs <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
case Tool
tool of
Tool
GHC -> do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver)
(Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver)
FilePath
bdir <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> GHCTargetVersion -> FilePath
ghcBinaryName GHCTargetVersion
ver)
Tool
Cabal -> do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
_tvVersion)
(Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Cabal (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"cabal-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
HLS -> do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
_tvVersion)
(Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
HLS (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
_tvVersion)
(FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt))
(Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath)
-> Excepts '[NotInstalled] m FilePath
-> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ do
FilePath
bdir <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ Version -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
_tvVersion
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
Stack -> do
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool -> Excepts '[NotInstalled] m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> Excepts '[NotInstalled] m Bool)
-> m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled Version
_tvVersion)
(Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
Stack (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing Version
_tvVersion))
FilePath -> Excepts '[NotInstalled] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dirs -> FilePath
binDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"stack-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt)
Tool
GHCup -> do
FilePath
currentRunningExecPath <- IO FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getExecutablePath
IO FilePath -> Excepts '[NotInstalled] m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Excepts '[NotInstalled] m FilePath)
-> IO FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
currentRunningExecPath
checkIfToolInstalled :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
Version ->
m Bool
checkIfToolInstalled :: Tool -> Version -> m Bool
checkIfToolInstalled Tool
tool Version
ver = Tool -> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool (Version -> GHCTargetVersion
mkTVer Version
ver)
checkIfToolInstalled' :: ( MonadIO m
, MonadReader env m
, HasDirs env
, MonadCatch m) =>
Tool ->
GHCTargetVersion ->
m Bool
checkIfToolInstalled' :: Tool -> GHCTargetVersion -> m Bool
checkIfToolInstalled' Tool
tool GHCTargetVersion
ver =
case Tool
tool of
Tool
Cabal -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
cabalInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
HLS -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
hlsInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
Stack -> Version -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
stackInstalled (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Tool
GHC -> GHCTargetVersion -> m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver
Tool
_ -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
throwIfFileAlreadyExists :: ( MonadIO m ) =>
FilePath ->
Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists :: FilePath -> Excepts '[FileAlreadyExistsError] m ()
throwIfFileAlreadyExists FilePath
fp = Excepts '[FileAlreadyExistsError] m Bool
-> Excepts '[FileAlreadyExistsError] m ()
-> Excepts '[FileAlreadyExistsError] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> Excepts '[FileAlreadyExistsError] m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
checkFileAlreadyExists FilePath
fp)
(FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ())
-> FileAlreadyExistsError -> Excepts '[FileAlreadyExistsError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileAlreadyExistsError
FileAlreadyExistsError FilePath
fp)
rmOldGHC :: ( MonadReader env m
, HasGHCupInfo env
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> Excepts '[NotInstalled] m ()
rmOldGHC :: Excepts '[NotInstalled] m ()
rmOldGHC = do
GHCupInfo { $sel:_ghcupDownloads:GHCupInfo :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo -> Excepts '[NotInstalled] m GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
let oldGHCs :: [GHCTargetVersion]
oldGHCs = Version -> GHCTargetVersion
mkTVer (Version -> GHCTargetVersion) -> [Version] -> [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Fold '[] GHCupDownloads Version
-> GHCupDownloads -> [Version]
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> [a]
toListOf (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic'
A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
-> Optic
A_Fold
'[]
GHCupDownloads
GHCupDownloads
(Version, VersionInfo)
(Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag
-> Optic'
A_Fold '[] (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Old Optic
A_Fold
'[]
GHCupDownloads
GHCupDownloads
(Version, VersionInfo)
(Version, VersionInfo)
-> Optic
A_Getter
'[]
(Version, VersionInfo)
(Version, VersionInfo)
Version
Version
-> Optic' A_Fold '[] GHCupDownloads Version
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((Version, VersionInfo) -> Version)
-> Optic
A_Getter
'[]
(Version, VersionInfo)
(Version, VersionInfo)
Version
Version
forall s a. (s -> a) -> Getter s a
to (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst) GHCupDownloads
dls
[GHCTargetVersion]
ghcs <- m [GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion])
-> m [GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall a b. (a -> b) -> a -> b
$ ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
[GHCTargetVersion]
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GHCTargetVersion
ghc GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GHCTargetVersion]
oldGHCs) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, HasLog env,
MonadIO m, MonadFail m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
ghc
rmProfilingLibs :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> m ()
rmProfilingLibs :: m ()
rmProfilingLibs = do
[GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
let regexes :: [ByteString]
regexes :: [ByteString]
regexes = [[s|.*_p\.a$|], [s|.*\.p_hi$|]]
[ByteString] -> (ByteString -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ByteString]
regexes ((ByteString -> m ()) -> m ()) -> (ByteString -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
regex ->
[GHCTargetVersion] -> (GHCTargetVersion -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> m ()) -> m ())
-> (GHCTargetVersion -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
FilePath
d <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ghc
[FilePath]
matches <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFilesDeep
FilePath
d
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
ByteString
regex
)
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
matches ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
m -> do
let p :: FilePath
p = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
m
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p
rmShareDir :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
)
=> m ()
rmShareDir :: m ()
rmShareDir = do
[GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
[GHCTargetVersion] -> (GHCTargetVersion -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
ghcs ((GHCTargetVersion -> m ()) -> m ())
-> (GHCTargetVersion -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
FilePath
d <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ghc
let p :: FilePath
p = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"share"
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
p
rmHLSNoGHC :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
, MonadFail m
, MonadUnliftIO m
)
=> Excepts '[NotInstalled] m ()
rmHLSNoGHC :: Excepts '[NotInstalled] m ()
rmHLSNoGHC = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- Excepts '[NotInstalled] m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[GHCTargetVersion]
ghcs <- ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> Excepts '[NotInstalled] m [Either FilePath GHCTargetVersion]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights Excepts '[NotInstalled] m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
[Version]
hlses <- ([Either FilePath Version] -> [Version])
-> Excepts '[NotInstalled] m [Either FilePath Version]
-> Excepts '[NotInstalled] m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights Excepts '[NotInstalled] m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
[Version]
-> (Version -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version]
hlses ((Version -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Version -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Version
hls -> do
[GHCTargetVersion]
hlsGHCs <- (Version -> GHCTargetVersion) -> [Version] -> [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> GHCTargetVersion
mkTVer ([Version] -> [GHCTargetVersion])
-> Excepts '[NotInstalled] m [Version]
-> Excepts '[NotInstalled] m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Excepts '[NotInstalled] m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadCatch m) =>
Version -> m [Version]
hlsGHCVersions' Version
hls
let candidates :: [GHCTargetVersion]
candidates = (GHCTargetVersion -> Bool)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (GHCTargetVersion -> [GHCTargetVersion] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCTargetVersion]
ghcs) [GHCTargetVersion]
hlsGHCs
if ([GHCTargetVersion] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
hlsGHCs Int -> Int -> Int
forall a. Num a => a -> a -> a
- [GHCTargetVersion] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GHCTargetVersion]
candidates) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, MonadThrow m,
HasLog env, MonadIO m, MonadFail m, MonadCatch m,
MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
rmHLSVer Version
hls
else
[GHCTargetVersion]
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GHCTargetVersion]
candidates ((GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ghc -> do
[FilePath]
bins1 <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
binDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
bins2 <- Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Version -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) =>
Version -> m Bool
isLegacyHLS Version
hls) ([FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
shs <- Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
bins <- Version -> Maybe Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadFail m) =>
Version -> Maybe Version -> m [FilePath]
hlsInternalServerBinaries Version
hls (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath]
libs <- Version -> Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadFail m) =>
Version -> Version -> m [FilePath]
hlsInternalServerLibs Version
hls (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghc)
[FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath]
shs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
bins [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
libs)
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath]
bins1 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
bins2) ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
Text -> Excepts '[NotInstalled] m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> Excepts '[NotInstalled] m ())
-> Text -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
f
FilePath -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
f
() -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
rmCache :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
)
=> m ()
rmCache :: m ()
rmCache = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
contents <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
cacheDir
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
contents ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let p :: FilePath
p = FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
f
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
p
rmTmp :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadIO m
, MonadMask m
)
=> m ()
rmTmp :: m ()
rmTmp = do
FilePath
tmpdir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCanonicalTemporaryDirectory
[FilePath]
ghcup_dirs <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
tmpdir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^ghcup-.*$|] :: ByteString)
)
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
ghcup_dirs ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let p :: FilePath
p = FilePath
tmpdir FilePath -> FilePath -> FilePath
</> FilePath
f
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -rf " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
p
FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
p
applyAnyPatch :: ( MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
, MonadUnliftIO m
, MonadCatch m
, MonadResource m
, MonadThrow m
, MonadMask m
, MonadIO m)
=> Maybe (Either FilePath [URI])
-> FilePath
-> Excepts '[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch :: Maybe (Either FilePath [URI])
-> FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
applyAnyPatch Maybe (Either FilePath [URI])
Nothing FilePath
_ = ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
applyAnyPatch (Just (Left FilePath
pdir)) FilePath
workdir = Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatches FilePath
pdir FilePath
workdir
applyAnyPatch (Just (Right [URI]
uris)) FilePath
workdir = do
FilePath
tmpUnpack <- m FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, HasSettings env,
MonadUnliftIO m, MonadCatch m, MonadResource m, MonadThrow m,
MonadMask m, MonadIO m) =>
m FilePath
withGHCupTmpDir
[URI]
-> (URI
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [URI]
uris ((URI
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> (URI
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ \URI
uri -> do
FilePath
patch <- Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m FilePath
forall a b. (a -> b) -> a -> b
$ URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasDirs env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m) =>
URI
-> Maybe URI
-> Maybe Text
-> FilePath
-> Maybe FilePath
-> Bool
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
download URI
uri Maybe URI
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing FilePath
tmpUnpack Maybe FilePath
forall a. Maybe a
Nothing Bool
False
Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ())
-> Excepts '[PatchFailed] m ()
-> Excepts
'[PatchFailed, DownloadFailed, DigestError, GPGError] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatch FilePath
patch FilePath
workdir