{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
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.Prelude
import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ
import GHCup.Version
#if !defined(TAR)
import Codec.Archive ( ArchiveResult )
#endif
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Data.ByteString ( ByteString )
import Data.Either
import Data.List
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import GHC.IO.Exception
import HPath
import HPath.IO hiding ( hideError )
import Haskus.Utils.Variant.Excepts
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import Safe hiding ( at )
import System.IO.Error
import System.Posix.Env.ByteString ( getEnvironment, getEnv )
import System.Posix.FilePath ( getSearchPath, takeExtension )
import System.Posix.Files.ByteString
import Text.Regex.Posix
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
installGHCBindist :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
)
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installGHCBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installGHCBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq = do
let tver :: GHCTargetVersion
tver = Version -> GHCTargetVersion
mkTVer Version
ver
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install GHC with #{ver}|]
Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver) (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
GHC Version
ver)
Path Abs
dl <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing
Path Abs
ghcdir <- m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
tver
Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
toolchainSanityChecks
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadThrow m,
MonadLogger m, MonadIO m) =>
Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
installPackedGHC Path Abs
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) Path Abs
ghcdir Version
ver PlatformRequest
pfreq
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver
where
toolchainSanityChecks :: Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
toolchainSanityChecks = do
[Maybe ByteString]
r <- [ByteString]
-> (ByteString
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Maybe ByteString))
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Maybe ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ByteString
"CC", ByteString
"LD"] (IO (Maybe ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Maybe ByteString))
-> (ByteString -> IO (Maybe ByteString))
-> ByteString
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO (Maybe ByteString)
getEnv)
case [Maybe ByteString] -> [ByteString]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ByteString]
r of
[] -> ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[ByteString]
_ -> do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"CC/LD environment variable is set. This will change the compiler/linker"
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"GHC uses internally and can cause defunct GHC in some cases (e.g. in Anaconda"
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) Text
"environments). If you encounter problems, unset CC and LD and reinstall."
installPackedGHC :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadThrow m
, MonadLogger m
, MonadIO m
)
=> Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[ BuildFailed
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
installPackedGHC :: Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
installPackedGHC Path Abs
dl Maybe TarDir
msubdir Path Abs
inst Version
ver pfreq :: PlatformRequest
pfreq@PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
..} = do
Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack
Path Abs
workdir <- Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
-> (TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs))
-> Maybe TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack)
(Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
(Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
tmpUnpack)
Maybe TarDir
msubdir
Excepts '[BuildFailed] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
())
-> Excepts '[BuildFailed] m ()
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe (Path Abs)
-> Excepts '[ProcessError] m ()
-> Excepts '[BuildFailed] m ()
forall (e :: [*]) (m :: * -> *) a.
(Show (V e), MonadReader AppState m, MonadIO m, MonadMask m) =>
Path Abs
-> Maybe (Path Abs) -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction Path Abs
tmpUnpack
(Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
inst)
(Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m) =>
Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC Path Abs
workdir Path Abs
inst Version
ver PlatformRequest
pfreq)
installUnpackedGHC :: ( MonadReader AppState m
, MonadThrow m
, MonadLogger m
, MonadIO m
)
=> Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC :: Path Abs
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts '[ProcessError] m ()
installUnpackedGHC Path Abs
path Path Abs
inst Version
ver PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = 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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
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
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged ByteString
"./configure"
Bool
False
((ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
inst) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
alpineArgs)
[rel|ghc-configure|]
(Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
path)
Maybe [(ByteString, ByteString)]
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
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make [ByteString
"install"] (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
path)
() -> Excepts '[ProcessError] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
alpineArgs :: [ByteString]
alpineArgs
| Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.2.2|], Linux LinuxDistro
Alpine <- Platform
_rPlatform
= [ByteString
"--disable-ld-override"]
| Bool
otherwise
= []
installGHCBin :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installGHCBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installGHCBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHC Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *).
(MonadFail m, MonadMask m, MonadCatch m, MonadReader AppState m,
MonadLogger m, MonadResource m, MonadIO m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installGHCBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq
installCabalBindist :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installCabalBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver PlatformRequest {Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install cabal version #{ver}|]
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
..}} <- m AppState
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM
(m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Version -> m Bool
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
cabalInstalled Version
ver) Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
-> (Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
a -> IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool)
-> IO Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall a b. (a -> b) -> a -> b
$
(IOException -> IO Bool) -> IO Bool -> IO Bool
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
(IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FileStatus
x -> Bool
a Bool -> Bool -> Bool
&& FileStatus -> Bool
isSymbolicLink FileStatus
x)
(IO FileStatus -> IO Bool) -> IO FileStatus -> IO Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> IO FileStatus
getSymbolicLinkStatus (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|]))
)
(AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
Cabal Version
ver)
Path Abs
dl <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing
Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack
Path Abs
workdir <- Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack) (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
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 '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[CopyError] m ()
forall (m :: * -> *).
(MonadLogger m, MonadCatch m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installCabal' Path Abs
workdir Path Abs
binDir
[Version]
cVers <- m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version])
-> m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledCabals
let lInstCabal :: Maybe Version
lInstCabal = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
cVers
Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstCabal) (Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver
where
installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs
-> Path Abs
-> Excepts '[CopyError] m ()
installCabal' :: Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installCabal' Path Abs
path Path Abs
inst = do
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Installing cabal"
let cabalFile :: Path Rel
cabalFile = [rel|cabal|]
IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
inst
Path Rel
destFileName <- m (Path Rel) -> Excepts '[CopyError] m (Path Rel)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Rel) -> Excepts '[CopyError] m (Path Rel))
-> m (Path Rel) -> Excepts '[CopyError] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
cabalFile ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
let destPath :: Path Abs
destPath = Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
destFileName
(IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
(Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
cabalFile)
Path Abs
destPath
CopyMode
Overwrite
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
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 Path Abs
destPath
installCabalBin :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installCabalBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installCabalBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
Cabal Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadLogger m,
MonadResource m, MonadIO m, MonadFail m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installCabalBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq
installHLSBindist :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installHLSBindist :: DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installHLSBindist DownloadInfo
dlinfo Version
ver PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..} = do
m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to install hls version #{ver}|]
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (m Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Version -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadCatch m) =>
Version -> m Bool
hlsInstalled Version
ver))
(AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> AlreadyInstalled
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Tool -> Version -> AlreadyInstalled
AlreadyInstalled Tool
HLS Version
ver)
Path Abs
dl <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlinfo Maybe (Path Rel)
forall a. Maybe a
Nothing
Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack
Path Abs
workdir <- Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
-> (TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack) (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
(Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
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 '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[CopyError] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[CopyError] m ()
forall (m :: * -> *).
(MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installHLS' Path Abs
workdir Path Abs
binDir
[Version]
hlsVers <- m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version])
-> m [Version]
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
[Version]
forall a b. (a -> b) -> a -> b
$ ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
let lInstHLS :: Maybe Version
lInstHLS = [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers
Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Version
ver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
lInstHLS) (Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadLogger m, MonadThrow m,
MonadFail m, MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver
where
installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
=> Path Abs
-> Path Abs
-> Excepts '[CopyError] m ()
installHLS' :: Path Abs -> Path Abs -> Excepts '[CopyError] m ()
installHLS' Path Abs
path Path Abs
inst = do
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Installing HLS"
IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
inst
bins :: [Path Rel]
bins@(Path Rel
_:[Path Rel]
_) <- IO [Path Rel] -> Excepts '[CopyError] m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> Excepts '[CopyError] m [Path Rel])
-> IO [Path Rel] -> Excepts '[CopyError] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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)
)
[Path Rel]
-> (Path Rel -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m ())
-> (Path Rel -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
Path Rel
toF <- ByteString -> Excepts '[CopyError] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"~" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
(IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
(Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
(Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
CopyMode
Overwrite
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
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
let wrapper :: Path Rel
wrapper = [rel|haskell-language-server-wrapper|]
Path Rel
toF <- ByteString -> Excepts '[CopyError] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
wrapper ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
(IOException -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError -> Excepts '[CopyError] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError -> Excepts '[CopyError] m ())
-> (IOException -> CopyError)
-> IOException
-> Excepts '[CopyError] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts '[CopyError] m () -> Excepts '[CopyError] m ())
-> Excepts '[CopyError] m () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Excepts '[CopyError] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[CopyError] m ())
-> IO () -> Excepts '[CopyError] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile
(Path Abs
path Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
wrapper)
(Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
CopyMode
Overwrite
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
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 (Path Abs
inst Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
toF)
installHLSBin :: ( MonadMask m
, MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
, TarDirDoesNotExist
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installHLSBin :: GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installHLSBin GHCupDownloads
bDls Version
ver PlatformRequest
pfreq = do
DownloadInfo
dlinfo <- Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
HLS Version
ver PlatformRequest
pfreq GHCupDownloads
bDls
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadLogger m,
MonadResource m, MonadIO m, MonadFail m) =>
DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, DownloadFailed,
NoDownload, NotInstalled, UnknownArchive, TarDirDoesNotExist,
ArchiveResult]
m
()
installHLSBindist DownloadInfo
dlinfo Version
ver PlatformRequest
pfreq
setGHC :: ( MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
)
=> GHCTargetVersion
-> SetGHC
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC :: GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
sghc = do
let verBS :: ByteString
verBS = Version -> ByteString
verToBS (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Path Abs
ghcdir <- m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs))
-> m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
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 :: * -> *).
(MonadIO m, MonadReader AppState m, 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))
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir
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 (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
SetGHC
SetGHC_XY -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks GHCTargetVersion
ver
SetGHC
SetGHC_XYZ -> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks GHCTargetVersion
ver
[Path Rel]
verfiles <- GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
ver
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
verfiles ((Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m (Maybe ()))
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
file -> do
Maybe (Path Rel)
mTargetFile <- case SetGHC
sghc of
SetGHC
SetGHCOnly -> Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> Maybe (Path Rel) -> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just Path Rel
file
SetGHC
SetGHC_XY -> do
Maybe CharPos
v' <-
(ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
(\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
(Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m (Path Rel))
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m (Path Rel))
-> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> (CharPos -> Excepts '[NotInstalled] m (Path Rel))
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ \(Int
mj, Int
mi) ->
let major' :: ByteString
major' = Text -> ByteString
E.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ 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
in ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
major')
SetGHC
SetGHC_XYZ ->
(Path Rel -> Maybe (Path Rel))
-> Excepts '[NotInstalled] m (Path Rel)
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just (Excepts '[NotInstalled] m (Path Rel)
-> Excepts '[NotInstalled] m (Maybe (Path Rel)))
-> Excepts '[NotInstalled] m (Path Rel)
-> Excepts '[NotInstalled] m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS)
Maybe (Path Rel)
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Path Rel)
mTargetFile ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ()))
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m (Maybe ())
forall a b. (a -> b) -> a -> b
$ \Path Rel
targetFile -> do
let fullF :: Path Abs
fullF = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
targetFile
ByteString
destL <- m ByteString -> Excepts '[NotInstalled] m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> Excepts '[NotInstalled] m ByteString)
-> m ByteString -> Excepts '[NotInstalled] m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> GHCTargetVersion -> m ByteString
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
ByteString -> GHCTargetVersion -> m ByteString
ghcLinkDestination (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
file) 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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath fullF}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
fullF ByteString
destL
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
$ Path Abs -> ByteString -> m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m) =>
Path Abs -> ByteString -> m ()
symlinkShareDir Path Abs
ghcdir ByteString
verBS
GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
ver
where
symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m)
=> Path Abs
-> ByteString
-> m ()
symlinkShareDir :: Path Abs -> ByteString -> m ()
symlinkShareDir Path Abs
ghcdir ByteString
verBS = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
let destdir :: Path Abs
destdir = Path Abs
baseDir
case SetGHC
sghc of
SetGHC
SetGHCOnly -> do
let sharedir :: Path Rel
sharedir = [rel|share|]
let fullsharedir :: Path Abs
fullsharedir = Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
sharedir
m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path Abs
fullsharedir) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let fullF :: Path Abs
fullF = Path Abs
destdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
sharedir
let targetF :: ByteString
targetF = ByteString
"./ghc/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
sharedir
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{fullF}|]
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
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
fullF
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{targetF} #{fullF}|]
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
fullF ByteString
targetF
SetGHC
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
setCabal :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
=> Version
-> Excepts '[NotInstalled] m ()
setCabal :: Version -> Excepts '[NotInstalled] m ()
setCabal Version
ver = do
let verBS :: ByteString
verBS = Version -> ByteString
verToBS Version
ver
Path Rel
targetFile <- ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"cabal-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
verBS)
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir
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
<$> Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesFileExist (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
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 :: Path Abs
cabalbin = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|]
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath cabalbin}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile
Path Abs
cabalbin
let destL :: ByteString
destL = Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath cabalbin}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
cabalbin ByteString
destL
() -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
setHLS :: ( MonadCatch m
, MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Version
-> Excepts '[NotInstalled] m ()
setHLS :: Version -> Excepts '[NotInstalled] m ()
setHLS Version
ver = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
binDir
[Path Rel]
oldSyms <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Path Rel]
hlsSymlinks
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
oldSyms ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm #{toFilePath (binDir </> f)}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
[Path Rel]
bins <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
Version -> m [Path Rel]
hlsServerBinaries Version
ver
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Path Rel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel]
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)
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
let destL :: ByteString
destL = Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f
Path Rel
target <- ByteString -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> Excepts '[NotInstalled] m (Path Rel))
-> (Path Rel -> ByteString)
-> Path Rel
-> Excepts '[NotInstalled] m (Path Rel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString)
-> (Path Rel -> [ByteString]) -> Path Rel -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
_tilde (ByteString -> [ByteString])
-> (Path Rel -> ByteString) -> Path Rel -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> Excepts '[NotInstalled] m (Path Rel))
-> Path Rel -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ Path Rel
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath (binDir </> target)}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
target)
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath (binDir </> target)}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
target) ByteString
destL
let destL :: ByteString
destL = ByteString
"haskell-language-server-wrapper-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver
let wrapper :: Path Abs
wrapper = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|haskell-language-server-wrapper|]
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath wrapper}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
wrapper
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|ln -s #{destL} #{toFilePath wrapper}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString -> IO ()
forall b. Path b -> ByteString -> IO ()
createSymlink Path Abs
wrapper ByteString
destL
() -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data ListCriteria = ListInstalled
| ListSet
deriving Int -> ListCriteria -> ShowS
[ListCriteria] -> ShowS
ListCriteria -> String
(Int -> ListCriteria -> ShowS)
-> (ListCriteria -> String)
-> ([ListCriteria] -> ShowS)
-> Show ListCriteria
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCriteria] -> ShowS
$cshowList :: [ListCriteria] -> ShowS
show :: ListCriteria -> String
$cshow :: ListCriteria -> String
showsPrec :: Int -> ListCriteria -> ShowS
$cshowsPrec :: Int -> ListCriteria -> ShowS
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 -> ShowS
[ListResult] -> ShowS
ListResult -> String
(Int -> ListResult -> ShowS)
-> (ListResult -> String)
-> ([ListResult] -> ShowS)
-> Show ListResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListResult] -> ShowS
$cshowList :: [ListResult] -> ShowS
show :: ListResult -> String
$cshow :: ListResult -> String
showsPrec :: Int -> ListResult -> ShowS
$cshowsPrec :: Int -> ListResult -> ShowS
Show)
availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
availableToolVersions :: GHCupDownloads -> Tool -> Map Version [Tag]
availableToolVersions GHCupDownloads
av Tool
tool = Optic' A_Getter '[] GHCupDownloads (Map Version [Tag])
-> GHCupDownloads -> Map Version [Tag]
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
GHCupDownloads
(Map Version VersionInfo)
(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 Optic
A_Lens
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version [Tag])
(Map Version [Tag])
-> Optic' A_Getter '[] GHCupDownloads (Map Version [Tag])
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 -> Map Version [Tag])
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version [Tag])
(Map Version [Tag])
forall s a. (s -> a) -> Getter s a
to ((VersionInfo -> [Tag])
-> Map Version VersionInfo -> Map Version [Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VersionInfo -> [Tag]
_viTags))
GHCupDownloads
av
listVersions :: ( MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadReader AppState m
)
=> GHCupDownloads
-> Maybe Tool
-> Maybe ListCriteria
-> PlatformRequest
-> m [ListResult]
listVersions :: GHCupDownloads
-> Maybe Tool
-> Maybe ListCriteria
-> PlatformRequest
-> m [ListResult]
listVersions GHCupDownloads
av Maybe Tool
lt' Maybe ListCriteria
criteria PlatformRequest
pfreq = do
Maybe Version
cSet <- m (Maybe Version)
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m,
MonadCatch m) =>
m (Maybe Version)
cabalSet
[Either (Path Rel) Version]
cabals <- Maybe Version -> m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
Maybe Version -> m [Either (Path Rel) Version]
getInstalledCabals' Maybe Version
cSet
Maybe Version
hlsSet' <- m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
[Either (Path Rel) Version]
hlses <- m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go Maybe Tool
lt' Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
where
go :: Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go Maybe Tool
lt Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses = do
case Maybe Tool
lt of
Just Tool
t -> do
let avTools :: Map Version [Tag]
avTools = GHCupDownloads -> Tool -> Map Version [Tag]
availableToolVersions GHCupDownloads
av 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, [Tag])]
-> ((Version, [Tag]) -> m ListResult) -> m [ListResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Version [Tag] -> [(Version, [Tag])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Version [Tag]
avTools) (Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses)
case Tool
t of
Tool
GHC -> do
[ListResult]
slr <- Map Version [Tag] -> m [ListResult]
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m,
MonadIO m) =>
Map Version [Tag] -> m [ListResult]
strayGHCs Map Version [Tag]
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 [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m,
MonadIO m) =>
Map Version [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
strayCabals Map Version [Tag]
avTools Maybe Version
cSet [Either (Path Rel) 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 [Tag] -> m [ListResult]
forall (m :: * -> *).
(MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m,
MonadIO m) =>
Map Version [Tag] -> m [ListResult]
strayHLS Map Version [Tag]
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
GHCup -> [ListResult] -> m [ListResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ListResult]
lr
Maybe Tool
Nothing -> do
[ListResult]
ghcvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
[ListResult]
cabalvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Cabal) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
[ListResult]
hlsvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
HLS) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
[ListResult]
ghcupvers <- Maybe Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
go (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHCup) Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses
[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]
ghcupvers)
strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayGHCs :: Map Version [Tag] -> m [ListResult]
strayGHCs Map Version [Tag]
avTools = do
[Either (Path Rel) GHCTargetVersion]
ghcs <- m [Either (Path Rel) GHCTargetVersion]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
m [Either (Path Rel) 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 (Path Rel) GHCTargetVersion]
-> (Either (Path Rel) 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 (Path Rel) GHCTargetVersion]
ghcs ((Either (Path Rel) GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult])
-> (Either (Path Rel) GHCTargetVersion -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
Right tver :: GHCTargetVersion
tver@GHCTargetVersion{ _tvTarget :: GHCTargetVersion -> Maybe Text
_tvTarget = Maybe Text
Nothing, Version
_tvVersion :: Version
_tvVersion :: GHCTargetVersion -> Version
.. } -> do
case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version [Tag]
avTools of
Just [Tag]
_ -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
Maybe [Tag]
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 (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, 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 (m :: * -> *).
(MonadReader AppState m, 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 [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
_tvVersion Map Version [Tag]
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
_tvTarget :: GHCTargetVersion -> Maybe Text
_tvVersion :: 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 (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
_tvTarget
Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, 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 (m :: * -> *).
(MonadReader AppState m, 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 Path Rel
e -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> Maybe Version
-> [Either (Path Rel) Version]
-> m [ListResult]
strayCabals :: Map Version [Tag]
-> Maybe Version -> [Either (Path Rel) Version] -> m [ListResult]
strayCabals Map Version [Tag]
avTools Maybe Version
cSet [Either (Path Rel) 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 (Path Rel) Version]
-> (Either (Path Rel) 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 (Path Rel) Version]
cabals ((Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult])
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
Right Version
ver ->
case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools of
Just [Tag]
_ -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
Maybe [Tag]
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 [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools)
, lNoBindist :: Bool
lNoBindist = Bool
False
, fromSrc :: Bool
fromSrc = Bool
False
, hlsPowered :: Bool
hlsPowered = Bool
False
, Bool
lSet :: Bool
lSet :: Bool
..
}
Left Path Rel
e -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
=> Map.Map Version [Tag]
-> m [ListResult]
strayHLS :: Map Version [Tag] -> m [ListResult]
strayHLS Map Version [Tag]
avTools = do
[Either (Path Rel) Version]
hlss <- m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
([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 (Path Rel) Version]
-> (Either (Path Rel) 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 (Path Rel) Version]
hlss ((Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult])
-> (Either (Path Rel) Version -> m (Maybe ListResult))
-> m [Maybe ListResult]
forall a b. (a -> b) -> a -> b
$ \case
Right Version
ver ->
case Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools of
Just [Tag]
_ -> Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
Maybe [Tag]
Nothing -> do
Bool
lSet <- (Maybe Version -> Bool) -> m (Maybe Version) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver) m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
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 [Tag] -> Bool
forall a. Maybe a -> Bool
isNothing (Version -> Map Version [Tag] -> Maybe [Tag]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Version
ver Map Version [Tag]
avTools)
, lNoBindist :: Bool
lNoBindist = Bool
False
, fromSrc :: Bool
fromSrc = Bool
False
, hlsPowered :: Bool
hlsPowered = Bool
False
, Bool
lSet :: Bool
lSet :: Bool
..
}
Left Path Rel
e -> do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn)
[i|Could not parse version of stray directory #{toFilePath e}|]
Maybe ListResult -> m (Maybe ListResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ListResult
forall a. Maybe a
Nothing
toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
=> Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
toListResult :: Tool
-> Maybe Version
-> [Either (Path Rel) Version]
-> Maybe Version
-> [Either (Path Rel) Version]
-> (Version, [Tag])
-> m ListResult
toListResult Tool
t Maybe Version
cSet [Either (Path Rel) Version]
cabals Maybe Version
hlsSet' [Either (Path Rel) Version]
hlses (Version
v, [Tag]
tags) = case Tool
t of
Tool
GHC -> do
let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHC Version
v PlatformRequest
pfreq GHCupDownloads
av
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 (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
forall a. Maybe a
Nothing
Bool
lInstalled <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver
Bool
fromSrc <- GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, 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 (m :: * -> *).
(MonadReader AppState m, 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
let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
Cabal Version
v PlatformRequest
pfreq GHCupDownloads
av
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 (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either (Path Rel) 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
let lNoBindist :: Bool
lNoBindist = Either NoDownload DownloadInfo -> Bool
forall a b. Either a b -> Bool
isLeft (Either NoDownload DownloadInfo -> Bool)
-> Either NoDownload DownloadInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
HLS Version
v PlatformRequest
pfreq GHCupDownloads
av
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 (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights [Either (Path Rel) 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
..
}
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
rmGHCVer :: ( MonadReader AppState m
, MonadThrow m
, MonadLogger m
, MonadIO m
, MonadFail m
, MonadCatch 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 (m :: * -> *).
(MonadReader AppState m, 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 :: * -> *).
(MonadIO m, MonadReader AppState m, 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))
Path Abs
dir <- m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs))
-> m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|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 (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m) =>
Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|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 (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks GHCTargetVersion
ver
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|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 (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadLogger m, MonadThrow m,
MonadFail m, MonadReader AppState m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks 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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path Abs
dir
Maybe CharPos
v' <-
(ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
(\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
(Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ver)
Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (CharPos -> 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 (Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForMajor Int
mj Int
mi (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
ver))
Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY)
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
baseDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|share|])
rmCabalVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch 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 :: * -> *).
(MonadLogger m, MonadIO m, MonadReader AppState m, 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 (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m,
MonadCatch m) =>
m (Maybe Version)
cabalSet
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Path Rel
cabalFile <- m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel))
-> m (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"cabal-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
ver)
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
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 (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) 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 :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
latestver
Maybe Version
Nothing -> IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile
(Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|])
rmHLSVer :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m, MonadFail m, MonadCatch 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 :: * -> *).
(MonadIO m, MonadReader AppState m, 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 (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
bins <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Version -> m [Path Rel]
hlsAllBinaries Version
ver
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
bins ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
ver Maybe Version -> Maybe Version -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Version
isHlsSet) (Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ do
[Path Rel]
oldSyms <- m [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Path Rel]
hlsSymlinks
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
oldSyms ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm #{toFilePath (binDir </> f)}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f)
[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 (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) Version]
getInstalledHLSs
case [Version] -> Maybe Version
forall a. [a] -> Maybe a
headMay ([Version] -> Maybe Version)
-> ([Version] -> [Version]) -> [Version] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version] -> [Version])
-> ([Version] -> [Version]) -> [Version] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Version] -> [Version]
forall a. Ord a => [a] -> [a]
sort ([Version] -> Maybe Version) -> [Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Version]
hlsVers of
Just Version
latestver -> Version -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadCatch m, MonadReader AppState m, MonadLogger m, MonadThrow m,
MonadFail m, MonadIO m) =>
Version -> Excepts '[NotInstalled] m ()
setHLS Version
latestver
Maybe Version
Nothing -> () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getDebugInfo :: (MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m)
=> Excepts
'[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
m
DebugInfo
getDebugInfo :: Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
DebugInfo
getDebugInfo = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
let diBaseDir :: Path Abs
diBaseDir = Path Abs
baseDir
let diBinDir :: Path Abs
diBinDir = Path Abs
binDir
Path Abs
diGHCDir <- m (Path Abs)
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). MonadReader AppState m => m (Path Abs)
ghcupGHCBaseDir
let diCacheDir :: Path Abs
diCacheDir = Path Abs
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 :: * -> *).
(MonadLogger m, MonadCatch m, MonadIO 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 :: Path Abs
-> Path Abs
-> Path Abs
-> Path Abs
-> Architecture
-> PlatformResult
-> DebugInfo
DebugInfo { Path Abs
PlatformResult
Architecture
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: Path Abs
diGHCDir :: Path Abs
diBinDir :: Path Abs
diBaseDir :: Path Abs
diPlatform :: PlatformResult
diArch :: Architecture
diCacheDir :: Path Abs
diGHCDir :: Path Abs
diBinDir :: Path Abs
diBaseDir :: Path Abs
.. }
compileGHC :: ( MonadMask m
, MonadReader AppState m
, MonadThrow m
, MonadResource m
, MonadLogger m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
-> GHCTargetVersion
-> Either Version (Path Abs)
-> Maybe Int
-> Maybe (Path Abs)
-> Maybe (Path Abs)
-> [Text]
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DownloadFailed
, GHCupSetError
, NoDownload
, NotFoundInPATH
, PatchFailed
, UnknownArchive
, TarDirDoesNotExist
, NotInstalled
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
compileGHC :: GHCupDownloads
-> GHCTargetVersion
-> Either Version (Path Abs)
-> Maybe Int
-> Maybe (Path Abs)
-> Maybe (Path Abs)
-> [Text]
-> PlatformRequest
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
compileGHC GHCupDownloads
dls GHCTargetVersion
tver Either Version (Path Abs)
bstrap Maybe Int
jobs Maybe (Path Abs)
mbuildConfig Maybe (Path Abs)
patchdir [Text]
aargs pfreq :: PlatformRequest
pfreq@PlatformRequest{Maybe Versioning
Platform
Architecture
_rVersion :: Maybe Versioning
_rPlatform :: Platform
_rArch :: Architecture
_rVersion :: PlatformRequest -> Maybe Versioning
_rPlatform :: PlatformRequest -> Platform
_rArch :: PlatformRequest -> Architecture
..}
= do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
Bool
alreadyInstalled <- m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool)
-> m Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
tver
Bool
alreadySet <- (Maybe GHCTargetVersion -> Bool)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe GHCTargetVersion -> Maybe GHCTargetVersion -> Bool
forall a. Eq a => a -> a -> Bool
== GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just GHCTargetVersion
tver) (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
Bool
forall a b. (a -> b) -> a -> b
$ m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet (GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
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
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, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Maybe a -> e -> Excepts es m a
?? NoDownload
NoDownload
Path Abs
dl <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadResource m, MonadThrow m, MonadLogger m,
MonadIO m, MonadReader AppState m) =>
DownloadInfo
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
downloadCached DownloadInfo
dlInfo Maybe (Path Rel)
forall a. Maybe a
Nothing
Path Abs
tmpUnpack <- m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *). (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir
Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts '[UnknownArchive, ArchiveResult] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m) =>
Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
tmpUnpack Path Abs
dl
Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ()))
-> IO (Either ProcessError ())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
_rPlatform Path Abs
tmpUnpack
Either (Path Rel) (Path Abs)
bghc <- case Either Version (Path Abs)
bstrap of
Right Path Abs
g -> Either (Path Rel) (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either (Path Rel) (Path Abs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either (Path Rel) (Path Abs)))
-> Either (Path Rel) (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either (Path Rel) (Path Abs))
forall a b. (a -> b) -> a -> b
$ Path Abs -> Either (Path Rel) (Path Abs)
forall a b. b -> Either a b
Right Path Abs
g
Left Version
bver -> Path Rel -> Either (Path Rel) (Path Abs)
forall a b. a -> Either a b
Left (Path Rel -> Either (Path Rel) (Path Abs))
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Rel)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Either (Path Rel) (Path Abs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString
"ghc-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
bver)
Path Abs
workdir <- Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
-> (TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs))
-> Maybe TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tmpUnpack)
(Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[TarDirDoesNotExist] m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs))
-> (TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDir
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m) =>
Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
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)
Path Abs
ghcdir <- m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs))
-> m (Path Abs)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
tver
(Path Abs
bindist, ByteString
bmk) <- Excepts '[BuildFailed] m (Path Abs, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs, ByteString)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[BuildFailed] m (Path Abs, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs, ByteString))
-> Excepts '[BuildFailed] m (Path Abs, ByteString)
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
(Path Abs, ByteString)
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe (Path Abs)
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs, ByteString)
-> Excepts '[BuildFailed] m (Path Abs, ByteString)
forall (e :: [*]) (m :: * -> *) a.
(Show (V e), MonadReader AppState m, MonadIO m, MonadMask m) =>
Path Abs
-> Maybe (Path Abs) -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction
Path Abs
tmpUnpack
Maybe (Path Abs)
forall a. Maybe a
Nothing
(do
Path Abs
b <- Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadCatch m, MonadLogger m,
MonadIO m, MonadFail m) =>
Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
compileBindist Either (Path Rel) (Path Abs)
bghc Path Abs
ghcdir Path Abs
workdir
ByteString
bmk <- IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString)
-> IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFileStrict (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir)
(Path Abs, ByteString)
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
b, ByteString
bmk)
)
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadyInstalled (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ do
m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Deleting existing installation|]
Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m,
MonadFail m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmGHCVer GHCTargetVersion
tver
Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
forall (m :: * -> *).
(MonadMask m, MonadCatch m, MonadReader AppState m, MonadThrow m,
MonadLogger m, MonadIO m) =>
Path Abs
-> Maybe TarDir
-> Path Abs
-> Version
-> PlatformRequest
-> Excepts
'[BuildFailed, UnknownArchive, TarDirDoesNotExist, ArchiveResult]
m
()
installPackedGHC Path Abs
bindist
(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)
Path Abs
ghcdir
(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)
PlatformRequest
pfreq
IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> IO ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFile (Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ghcUpSrcBuiltFile) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
bmk
(V '[NotInstalled] -> GHCupSetError)
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es') =>
(V es -> e) -> Excepts es m a -> Excepts es' m a
reThrowAll V '[NotInstalled] -> GHCupSetError
forall (es :: [*]). Show (V es) => V es -> GHCupSetError
GHCupSetError (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall GHCTargetVersion
tver
Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alreadySet (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
())
-> Excepts '[NotInstalled] m ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, DownloadFailed,
GHCupSetError, NoDownload, NotFoundInPATH, PatchFailed,
UnknownArchive, TarDirDoesNotExist, NotInstalled, ArchiveResult]
m
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
tver SetGHC
SetGHCOnly
where
defaultConf :: ByteString
defaultConf = case GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver of
Maybe Text
Nothing -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = YES|]
Just Text
_ -> [s|
V=0
BUILD_MAN = NO
BUILD_SPHINX_HTML = NO
BUILD_SPHINX_PDF = NO
HADDOCK_DOCS = NO
Stage1Only = YES|]
compileBindist :: ( MonadReader AppState m
, MonadThrow m
, MonadCatch m
, MonadLogger m
, MonadIO m
, MonadFail m
)
=> Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed, ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
compileBindist :: Either (Path Rel) (Path Abs)
-> Path Abs
-> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
compileBindist Either (Path Rel) (Path Abs)
bghc Path Abs
ghcdir Path Abs
workdir = 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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|configuring build|]
Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts
'[FileDoesNotExistError, 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 ()
forall (m :: * -> *).
(MonadCatch m, MonadIO m) =>
Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe (Path Abs)
-> (Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Path Abs)
patchdir ((Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> (Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ \Path Abs
dir -> Excepts '[PatchFailed] m ()
-> Excepts
'[FileDoesNotExistError, 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 '[PatchFailed] m ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts '[PatchFailed] m ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Excepts '[PatchFailed] m ()
forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
Path Abs -> Path Abs -> Excepts '[PatchFailed] m ()
applyPatches Path Abs
dir Path Abs
workdir
[(ByteString, ByteString)]
cEnv <- IO [(ByteString, ByteString)]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[(ByteString, ByteString)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(ByteString, ByteString)]
getEnvironment
if
| GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
tver Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|8.8.0|] -> do
Path Abs
bghcPath <- case Either (Path Rel) (Path Abs)
bghc of
Right Path Abs
ghc' -> Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
ghc'
Left Path Rel
bver -> do
[Path Abs]
spaths <- [Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ([ByteString] -> [Path Abs])
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[ByteString]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getSearchPath
IO (Maybe (Path Abs)) -> m (Maybe (Path Abs))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs]
spaths Path Rel
bver) m (Maybe (Path Abs))
-> NotFoundInPATH
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? Path Rel -> NotFoundInPATH
NotFoundInPATH Path Rel
bver
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
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged
ByteString
"./configure"
Bool
False
( [ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
ghcdir]
[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
-> (Text -> [ByteString]) -> Maybe Text -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
forall a. Monoid a => a
mempty
(\Text
x -> [ByteString
"--target=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 Text
x])
(GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
E.encodeUtf8 [Text]
aargs
)
[rel|ghc-conf|]
(Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
([(ByteString, ByteString)] -> Maybe [(ByteString, ByteString)]
forall a. a -> Maybe a
Just ((ByteString
"GHC", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
bghcPath) (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
cEnv))
| 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
$ ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged
ByteString
"./configure"
Bool
False
( [ ByteString
"--prefix=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
ghcdir
, ByteString
"--with-ghc=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Path Rel -> ByteString)
-> (Path Abs -> ByteString)
-> Either (Path Rel) (Path Abs)
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Either (Path Rel) (Path Abs)
bghc
]
[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
-> (Text -> [ByteString]) -> Maybe Text -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString]
forall a. Monoid a => a
mempty
(\Text
x -> [ByteString
"--target=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 Text
x])
(GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver)
[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
E.encodeUtf8 [Text]
aargs
)
[rel|ghc-conf|]
(Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
([(ByteString, ByteString)] -> Maybe [(ByteString, ByteString)]
forall a. a -> Maybe a
Just [(ByteString, ByteString)]
cEnv)
case Maybe (Path Abs)
mbuildConfig of
Just Path Abs
bc -> IOErrorType
-> FileDoesNotExistError
-> m ()
-> Excepts
'[FileDoesNotExistError, 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
(ByteString -> FileDoesNotExistError
FileDoesNotExistError (ByteString -> FileDoesNotExistError)
-> ByteString -> FileDoesNotExistError
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
bc)
(IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path Abs
bc (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir) CopyMode
Overwrite)
Maybe (Path Abs)
Nothing ->
IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Maybe FileMode -> ByteString -> IO ()
forall b. Path b -> Maybe FileMode -> ByteString -> IO ()
writeFile (Path Abs -> Path Abs
forall b. Path b -> Path b
build_mk Path Abs
workdir) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
newFilePerms) ByteString
defaultConf
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Building (this may take a while)...|]
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
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make ([ByteString] -> (Int -> [ByteString]) -> Maybe Int -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Int
j -> [ByteString
"-j" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fS (Int -> String
forall a. Show a => a -> String
show Int
j)]) Maybe Int
jobs) (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Creating bindist...|]
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
$ [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
forall (m :: * -> *).
(MonadThrow m, MonadIO m, MonadReader AppState m) =>
[ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make [ByteString
"binary-dist"] (Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
workdir)
[Path Rel
tar] <- IO [Path Rel]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[Path Rel])
-> IO [Path Rel]
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
[Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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)
)
ByteString
c <- IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString)
-> IO ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile (Path Abs
workdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tar)
Text
cDigest <-
(Text -> Text)
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.take Int
8)
(Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text)
-> (ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text)
-> ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Text
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(m Text
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text)
-> (ByteString -> m Text)
-> ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, 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
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text)
-> ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
Text
forall a b. (a -> b) -> a -> b
$ ByteString
c
Path Rel
tarName <-
ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel
[i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{cDigest}.tar#{takeExtension (toFilePath tar)}|]
let tarPath :: Path Abs
tarPath = Path Abs
cacheDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tarName
(IOException
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> (IOException -> CopyError)
-> IOException
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
())
-> IO ()
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile (Path Abs
workdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
tar)
Path Abs
tarPath
CopyMode
Strict
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Copied bindist to #{tarPath}|]
Path Abs
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig, PatchFailed,
ProcessError, NotFoundInPATH, CopyError]
m
(Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs
tarPath
build_mk :: Path b -> Path b
build_mk Path b
workdir = Path b
workdir Path b -> Path Rel -> Path b
forall b. Path b -> Path Rel -> Path b
</> [rel|mk/build.mk|]
checkBuildConfig :: (MonadCatch m, MonadIO m)
=> Excepts
'[FileDoesNotExistError, InvalidBuildConfig]
m
()
checkBuildConfig :: Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
checkBuildConfig = do
ByteString
c <- case Maybe (Path Abs)
mbuildConfig of
Just Path Abs
bc -> do
ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig] m ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
(ByteString -> FileDoesNotExistError
FileDoesNotExistError (ByteString -> FileDoesNotExistError)
-> ByteString -> FileDoesNotExistError
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
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
$ Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
bc)
Maybe (Path Abs)
Nothing -> ByteString
-> Excepts
'[FileDoesNotExistError, InvalidBuildConfig] m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
defaultConf
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 GHCTargetVersion -> Maybe Text
_tvTarget GHCTargetVersion
tver of
Just Text
_ -> Bool
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"Stage1Only = YES" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
lines') (Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ())
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall a b. (a -> b) -> a -> b
$ InvalidBuildConfig
-> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE
(Text -> InvalidBuildConfig
InvalidBuildConfig
[s|Cross compiling needs to be a Stage1 build, add "Stage1Only = YES" to your config!|]
)
Maybe Text
Nothing -> () -> Excepts '[FileDoesNotExistError, InvalidBuildConfig] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
upgradeGHCup :: ( MonadMask m
, MonadReader AppState m
, MonadCatch m
, MonadLogger m
, MonadThrow m
, MonadResource m
, MonadIO m
)
=> GHCupDownloads
-> Maybe (Path Abs)
-> Bool
-> PlatformRequest
-> Excepts
'[ CopyError
, DigestError
, DownloadFailed
, NoDownload
, NoUpdate
]
m
Version
upgradeGHCup :: GHCupDownloads
-> Maybe (Path Abs)
-> Bool
-> PlatformRequest
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
Version
upgradeGHCup GHCupDownloads
dls Maybe (Path Abs)
mtarget Bool
force PlatformRequest
pfreq = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Upgrading GHCup...|]
let latestVer :: Version
latestVer = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ (Version, VersionInfo) -> Version
forall a b. (a, b) -> a
fst ((Version, VersionInfo) -> Version)
-> Maybe (Version, VersionInfo) -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup
Bool
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force Bool -> Bool -> Bool
&& (Version
latestVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= PVP -> Version
pvpToVersion PVP
ghcUpVer)) (Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ NoUpdate
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE NoUpdate
NoUpdate
DownloadInfo
dli <- Either NoDownload DownloadInfo
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
DownloadInfo
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either NoDownload DownloadInfo
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
DownloadInfo
forall a b. (a -> b) -> a -> b
$ Tool
-> Version
-> PlatformRequest
-> GHCupDownloads
-> Either NoDownload DownloadInfo
getDownloadInfo Tool
GHCup Version
latestVer PlatformRequest
pfreq GHCupDownloads
dls
Path Abs
tmp <- m (Path Abs)
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Path Abs)
forall (m :: * -> *).
(MonadResource m, MonadThrow m, MonadIO m) =>
m (Path Abs)
withGHCupTmpDir
let fn :: Path Rel
fn = [rel|ghcup|]
Path Abs
p <- Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Path Abs)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Path Abs))
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Path Abs)
forall a b. (a -> b) -> a -> b
$ DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
forall (m :: * -> *).
(MonadMask m, MonadReader AppState m, MonadThrow m, MonadLogger m,
MonadIO m) =>
DownloadInfo
-> Path Abs
-> Maybe (Path Rel)
-> Excepts '[DigestError, DownloadFailed] m (Path Abs)
download DownloadInfo
dli Path Abs
tmp (Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just Path Rel
fn)
let destDir :: Path Abs
destDir = Path Abs -> Path Abs
dirname Path Abs
destFile
destFile :: Path Abs
destFile = Path Abs -> Maybe (Path Abs) -> Path Abs
forall a. a -> Maybe a -> a
fromMaybe (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
fn) Maybe (Path Abs)
mtarget
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|mkdir -p #{toFilePath destDir}|]
IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
createDirRecursive' Path Abs
destDir
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath destFile}|]
IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
destFile
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|cp #{toFilePath p} #{toFilePath destFile}|]
(IOException
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (CopyError
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (CopyError
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> (IOException -> CopyError)
-> IOException
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CopyError
CopyError (String -> CopyError)
-> (IOException -> String) -> IOException -> CopyError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show) (Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> IO ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> CopyMode -> IO ()
forall b1 b2. Path b1 -> Path b2 -> CopyMode -> IO ()
copyFile Path Abs
p
Path Abs
destFile
CopyMode
Overwrite
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ Path Abs -> m ()
forall (m :: * -> *) a.
(MonadLogger m, MonadIO m) =>
Path a -> m ()
chmod_755 Path Abs
destFile
IO Bool
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs -> IO Bool
isInPath Path Abs
destFile) Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
Bool
-> (Bool
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$
m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|"#{toFilePath (dirname destFile)}" is not in PATH! You have to add it in order to use ghcup.|]
IO (Maybe (Path Abs))
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Maybe (Path Abs))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs -> IO (Maybe (Path Abs))
isShadowed Path Abs
destFile) Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
(Maybe (Path Abs))
-> (Maybe (Path Abs)
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Path Abs)
Nothing -> ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Path Abs
pa -> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
())
-> m ()
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|ghcup is shadowed by "#{toFilePath pa}". The upgrade will not be in effect, unless you remove "#{toFilePath pa}" or make sure "#{toFilePath destDir}" comes before "#{toFilePath (dirname pa)}" in PATH.|]
Version
-> Excepts
'[CopyError, DigestError, DownloadFailed, NoDownload, NoUpdate]
m
Version
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
latestVer
postGHCInstall :: ( MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadCatch m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
postGHCInstall :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
postGHCInstall ver :: GHCTargetVersion
ver@GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
_tvTarget :: GHCTargetVersion -> Maybe Text
_tvVersion :: GHCTargetVersion -> Version
..} = do
Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
ver SetGHC
SetGHC_XYZ
Maybe CharPos
v' <-
(ParseError -> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(ParseError
e :: ParseError) -> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos))
-> m (Maybe CharPos) -> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|#{e}|] m () -> m (Maybe CharPos) -> m (Maybe CharPos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe CharPos -> m (Maybe CharPos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CharPos
forall a. Maybe a
Nothing)
(Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m (Maybe CharPos)
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ (CharPos -> Maybe CharPos)
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CharPos -> Maybe CharPos
forall a. a -> Maybe a
Just
(Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos))
-> Excepts '[NotInstalled] m CharPos
-> Excepts '[NotInstalled] m (Maybe CharPos)
forall a b. (a -> b) -> a -> b
$ Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
getMajorMinorV Version
_tvVersion
Maybe CharPos
-> (CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CharPos
v' ((CharPos -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (CharPos -> 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 (Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForMajor Int
mj Int
mi Maybe Text
_tvTarget)
Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
-> (Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GHCTargetVersion -> Excepts '[NotInstalled] m GHCTargetVersion)
-> Maybe GHCTargetVersion -> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\GHCTargetVersion
v -> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion)
-> Excepts '[NotInstalled] m GHCTargetVersion
-> Excepts '[NotInstalled] m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
forall (m :: * -> *).
(MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m,
MonadIO m, MonadCatch m) =>
GHCTargetVersion
-> SetGHC -> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHC_XY)