{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
module GHCup.OptParse.Install where
import GHCup.OptParse.Common
import GHCup
import GHCup.Errors
import GHCup.Types
import GHCup.Utils.Dirs
import GHCup.Utils.Parsers (fromVersion, isolateParser, uriParser)
import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import Control.Concurrent (threadDelay)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad (when, forM_)
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Either
import Data.Functor
import Data.Maybe
import Data.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Pretty.Shim ( text )
import Prelude hiding ( appendFile )
import System.Exit
import URI.ByteString hiding ( uriParser )
import qualified Data.Text as T
data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions
| InstallHLS InstallOptions
| InstallStack InstallOptions
deriving (InstallCommand -> InstallCommand -> Bool
(InstallCommand -> InstallCommand -> Bool)
-> (InstallCommand -> InstallCommand -> Bool) -> Eq InstallCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallCommand -> InstallCommand -> Bool
== :: InstallCommand -> InstallCommand -> Bool
$c/= :: InstallCommand -> InstallCommand -> Bool
/= :: InstallCommand -> InstallCommand -> Bool
Eq, Int -> InstallCommand -> ShowS
[InstallCommand] -> ShowS
InstallCommand -> String
(Int -> InstallCommand -> ShowS)
-> (InstallCommand -> String)
-> ([InstallCommand] -> ShowS)
-> Show InstallCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallCommand -> ShowS
showsPrec :: Int -> InstallCommand -> ShowS
$cshow :: InstallCommand -> String
show :: InstallCommand -> String
$cshowList :: [InstallCommand] -> ShowS
showList :: [InstallCommand] -> ShowS
Show)
data InstallOptions = InstallOptions
{ InstallOptions -> Maybe ToolVersion
instVer :: Maybe ToolVersion
, InstallOptions -> Maybe URI
instBindist :: Maybe URI
, InstallOptions -> Bool
instSet :: Bool
, InstallOptions -> Maybe String
isolateDir :: Maybe FilePath
, InstallOptions -> Bool
forceInstall :: Bool
, InstallOptions -> Text
installTargets :: T.Text
, InstallOptions -> [Text]
addConfArgs :: [T.Text]
} deriving (InstallOptions -> InstallOptions -> Bool
(InstallOptions -> InstallOptions -> Bool)
-> (InstallOptions -> InstallOptions -> Bool) -> Eq InstallOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallOptions -> InstallOptions -> Bool
== :: InstallOptions -> InstallOptions -> Bool
$c/= :: InstallOptions -> InstallOptions -> Bool
/= :: InstallOptions -> InstallOptions -> Bool
Eq, Int -> InstallOptions -> ShowS
[InstallOptions] -> ShowS
InstallOptions -> String
(Int -> InstallOptions -> ShowS)
-> (InstallOptions -> String)
-> ([InstallOptions] -> ShowS)
-> Show InstallOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallOptions -> ShowS
showsPrec :: Int -> InstallOptions -> ShowS
$cshow :: InstallOptions -> String
show :: InstallOptions -> String
$cshowList :: [InstallOptions] -> ShowS
showList :: [InstallOptions] -> ShowS
Show)
installCabalFooter :: String
= [s|Discussion:
Installs the specified cabal-install version (or a recommended default one)
into "~/.ghcup/bin", so it can be overwritten by later
"cabal install cabal-install", which installs into "~/.cabal/bin" by
default. Make sure to set up your PATH appropriately, so the cabal
installation takes precedence.|]
installParser :: Parser (Either InstallCommand InstallOptions)
installParser :: Parser (Either InstallCommand InstallOptions)
installParser =
(InstallCommand -> Either InstallCommand InstallOptions
forall a b. a -> Either a b
Left (InstallCommand -> Either InstallCommand InstallOptions)
-> Parser InstallCommand
-> Parser (Either InstallCommand InstallOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields InstallCommand -> Parser InstallCommand
forall a. Mod CommandFields a -> Parser a
subparser
( String
-> ParserInfo InstallCommand -> Mod CommandFields InstallCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command
String
"ghc"
( InstallOptions -> InstallCommand
InstallGHC
(InstallOptions -> InstallCommand)
-> ParserInfo InstallOptions -> ParserInfo InstallCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InstallOptions
-> InfoMod InstallOptions -> ParserInfo InstallOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Maybe Tool -> Parser InstallOptions
installOpts (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC) Parser InstallOptions
-> Parser (InstallOptions -> InstallOptions)
-> Parser InstallOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (InstallOptions -> InstallOptions)
forall a. Parser (a -> a)
helper)
( String -> InfoMod InstallOptions
forall a. String -> InfoMod a
progDesc String
"Install GHC"
InfoMod InstallOptions
-> InfoMod InstallOptions -> InfoMod InstallOptions
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod InstallOptions
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
installGHCFooter)
)
)
Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo InstallCommand -> Mod CommandFields InstallCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command
String
"cabal"
( InstallOptions -> InstallCommand
InstallCabal
(InstallOptions -> InstallCommand)
-> ParserInfo InstallOptions -> ParserInfo InstallCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InstallOptions
-> InfoMod InstallOptions -> ParserInfo InstallOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Maybe Tool -> Parser InstallOptions
installOpts (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Cabal) Parser InstallOptions
-> Parser (InstallOptions -> InstallOptions)
-> Parser InstallOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (InstallOptions -> InstallOptions)
forall a. Parser (a -> a)
helper)
( String -> InfoMod InstallOptions
forall a. String -> InfoMod a
progDesc String
"Install Cabal"
InfoMod InstallOptions
-> InfoMod InstallOptions -> InfoMod InstallOptions
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod InstallOptions
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
installCabalFooter)
)
)
Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo InstallCommand -> Mod CommandFields InstallCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command
String
"hls"
( InstallOptions -> InstallCommand
InstallHLS
(InstallOptions -> InstallCommand)
-> ParserInfo InstallOptions -> ParserInfo InstallCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InstallOptions
-> InfoMod InstallOptions -> ParserInfo InstallOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Maybe Tool -> Parser InstallOptions
installOpts (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
HLS) Parser InstallOptions
-> Parser (InstallOptions -> InstallOptions)
-> Parser InstallOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (InstallOptions -> InstallOptions)
forall a. Parser (a -> a)
helper)
( String -> InfoMod InstallOptions
forall a. String -> InfoMod a
progDesc String
"Install haskell-language-server"
InfoMod InstallOptions
-> InfoMod InstallOptions -> InfoMod InstallOptions
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod InstallOptions
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
installHLSFooter)
)
)
Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
-> Mod CommandFields InstallCommand
forall a. Semigroup a => a -> a -> a
<> String
-> ParserInfo InstallCommand -> Mod CommandFields InstallCommand
forall a. String -> ParserInfo a -> Mod CommandFields a
command
String
"stack"
( InstallOptions -> InstallCommand
InstallStack
(InstallOptions -> InstallCommand)
-> ParserInfo InstallOptions -> ParserInfo InstallCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InstallOptions
-> InfoMod InstallOptions -> ParserInfo InstallOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Maybe Tool -> Parser InstallOptions
installOpts (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Stack) Parser InstallOptions
-> Parser (InstallOptions -> InstallOptions)
-> Parser InstallOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (InstallOptions -> InstallOptions)
forall a. Parser (a -> a)
helper)
( String -> InfoMod InstallOptions
forall a. String -> InfoMod a
progDesc String
"Install stack"
InfoMod InstallOptions
-> InfoMod InstallOptions -> InfoMod InstallOptions
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod InstallOptions
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
installStackFooter)
)
)
)
)
Parser (Either InstallCommand InstallOptions)
-> Parser (Either InstallCommand InstallOptions)
-> Parser (Either InstallCommand InstallOptions)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (InstallOptions -> Either InstallCommand InstallOptions
forall a b. b -> Either a b
Right (InstallOptions -> Either InstallCommand InstallOptions)
-> Parser InstallOptions
-> Parser (Either InstallCommand InstallOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Tool -> Parser InstallOptions
installOpts (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
GHC))
where
installHLSFooter :: String
installHLSFooter :: String
installHLSFooter = [s|Discussion:
Installs haskell-language-server binaries and wrapper
into "~/.ghcup/bin"
Examples:
# install recommended HLS
ghcup install hls|]
installStackFooter :: String
installStackFooter :: String
installStackFooter = [s|Discussion:
Installs stack binaries into "~/.ghcup/bin"
Examples:
# install recommended Stack
ghcup install stack|]
installGHCFooter :: String
installGHCFooter :: String
installGHCFooter = [s|Discussion:
Installs the specified GHC version (or a recommended default one) into
a self-contained "~/.ghcup/ghc/<ghcver>" directory
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
Examples:
# install recommended GHC
ghcup install ghc
# install latest GHC
ghcup install ghc latest
# install GHC 8.10.2
ghcup install ghc 8.10.2
# install GHC 8.10.2 from vanilla channel
ghcup -s vanilla install ghc 8.10.2
# install GHC head fedora bindist
ghcup install ghc -u 'https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head|]
installOpts :: Maybe Tool -> Parser InstallOptions
installOpts :: Maybe Tool -> Parser InstallOptions
installOpts Maybe Tool
tool =
(\(Maybe URI
u, Maybe ToolVersion
v) Bool
b Maybe String
is Bool
f -> Maybe ToolVersion
-> Maybe URI
-> Bool
-> Maybe String
-> Bool
-> Text
-> [Text]
-> InstallOptions
InstallOptions Maybe ToolVersion
v Maybe URI
u Bool
b Maybe String
is Bool
f)
((Maybe URI, Maybe ToolVersion)
-> Bool
-> Maybe String
-> Bool
-> Text
-> [Text]
-> InstallOptions)
-> Parser (Maybe URI, Maybe ToolVersion)
-> Parser
(Bool -> Maybe String -> Bool -> Text -> [Text] -> InstallOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( (,)
(Maybe URI -> Maybe ToolVersion -> (Maybe URI, Maybe ToolVersion))
-> Parser (Maybe URI)
-> Parser (Maybe ToolVersion -> (Maybe URI, Maybe ToolVersion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser URI -> Parser (Maybe URI)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
(ReadM URI -> Mod OptionFields URI -> Parser URI
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
((String -> Either String URI) -> ReadM URI
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String URI
uriParser)
(Char -> Mod OptionFields URI
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields URI
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"url" Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields URI
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"BINDIST_URL" Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields URI
forall (f :: * -> *) a. String -> Mod f a
help
String
"Install the specified version from this bindist"
Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields URI
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Tool -> Completer
toolDlCompleter (Tool -> Maybe Tool -> Tool
forall a. a -> Maybe a -> a
fromMaybe Tool
GHC Maybe Tool
tool))
)
)
Parser (Maybe ToolVersion -> (Maybe URI, Maybe ToolVersion))
-> Parser (Maybe ToolVersion)
-> Parser (Maybe URI, Maybe ToolVersion)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ToolVersion -> Maybe ToolVersion
forall a. a -> Maybe a
Just (ToolVersion -> Maybe ToolVersion)
-> Parser ToolVersion -> Parser (Maybe ToolVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument [] Maybe Tool
tool)
)
Parser (Maybe URI, Maybe ToolVersion)
-> Parser (Maybe URI, Maybe ToolVersion)
-> Parser (Maybe URI, Maybe ToolVersion)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe URI, Maybe ToolVersion)
-> Parser (Maybe URI, Maybe ToolVersion)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URI
forall a. Maybe a
Nothing, Maybe ToolVersion
forall a. Maybe a
Nothing)
)
Parser
(Bool -> Maybe String -> Bool -> Text -> [Text] -> InstallOptions)
-> Parser Bool
-> Parser
(Maybe String -> Bool -> Text -> [Text] -> InstallOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
setDefault) (String
-> Maybe Char -> Bool -> Mod FlagFields Bool -> Parser (Maybe Bool)
invertableSwitch String
"set" Maybe Char
forall a. Maybe a
Nothing Bool
setDefault
(String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help (String -> Mod FlagFields Bool) -> String -> Mod FlagFields Bool
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
setDefault then String
"Set as active version after install" else String
"Don't set as active version after install"))
Parser (Maybe String -> Bool -> Text -> [Text] -> InstallOptions)
-> Parser (Maybe String)
-> Parser (Bool -> Text -> [Text] -> InstallOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
(ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
((String -> Either String String) -> ReadM String
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String String
isolateParser)
( Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"isolate"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"install in an isolated absolute directory instead of the default one"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields String
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"directory")
)
)
Parser (Bool -> Text -> [Text] -> InstallOptions)
-> Parser Bool -> Parser (Text -> [Text] -> InstallOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
(Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
Parser (Text -> [Text] -> InstallOptions)
-> Parser Text -> Parser ([Text] -> InstallOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"install-targets"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGETS"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Space separated list of install targets (default: install)"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields Text
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([String] -> Completer
listCompleter [String
"install", String
"install_bin", String
"install_lib", String
"install_extra", String
"install_man", String
"install_docs", String
"install_data", String
"update_package_db"])
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
"install"
)
Parser ([Text] -> InstallOptions)
-> Parser [Text] -> Parser InstallOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CONFIGURE_ARGS" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
where
setDefault :: Bool
setDefault = case Maybe Tool
tool of
Maybe Tool
Nothing -> Bool
False
Just Tool
GHC -> Bool
False
Just Tool
_ -> Bool
True
installToolFooter :: String
= [s|Discussion:
Installs GHC or cabal. When no command is given, installs GHC
with the specified version/tag.
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
type InstallEffects = '[ AlreadyInstalled
, UnknownArchive
, ArchiveResult
, FileDoesNotExistError
, CopyError
, NotInstalled
, DirNotEmpty
, NoDownload
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
, DownloadFailed
, TarDirDoesNotExist
, NextVerNotFound
, NoToolVersionSet
, FileAlreadyExistsError
, ProcessError
, UninstallFailed
, MergeFileTreeError
, InstallSetError
, URIParseError
]
runInstTool :: AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool :: forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
appstate' =
(ReaderT AppState IO (VEither InstallEffects a)
-> AppState -> IO (VEither InstallEffects a))
-> AppState
-> ReaderT AppState IO (VEither InstallEffects a)
-> IO (VEither InstallEffects a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT AppState IO (VEither InstallEffects a)
-> AppState -> IO (VEither InstallEffects a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppState
appstate'
(ReaderT AppState IO (VEither InstallEffects a)
-> IO (VEither InstallEffects a))
-> (Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> ReaderT AppState IO (VEither InstallEffects a))
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ReaderT AppState IO) (VEither InstallEffects a)
-> ReaderT AppState IO (VEither InstallEffects a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
(ResourceT (ReaderT AppState IO) (VEither InstallEffects a)
-> ReaderT AppState IO (VEither InstallEffects a))
-> (Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> ResourceT (ReaderT AppState IO) (VEither InstallEffects a))
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> ReaderT AppState IO (VEither InstallEffects a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE
@InstallEffects
type InstallGHCEffects = '[ AlreadyInstalled
, ArchiveResult
, BuildFailed
, CopyError
, DigestError
, ContentLengthError
, DirNotEmpty
, DownloadFailed
, FileAlreadyExistsError
, FileDoesNotExistError
, GPGError
, MergeFileTreeError
, NextVerNotFound
, NoDownload
, NoToolVersionSet
, NotInstalled
, ProcessError
, TagNotFound
, DayNotFound
, TarDirDoesNotExist
, UninstallFailed
, UnknownArchive
, InstallSetError
, NoCompatiblePlatform
, GHCup.Errors.ParseError
, UnsupportedSetupCombo
, DistroNotFound
, NoCompatibleArch
, URIParseError
]
runInstGHC :: AppState
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC :: forall a.
AppState
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC AppState
appstate' =
(ReaderT AppState IO (VEither InstallGHCEffects a)
-> AppState -> IO (VEither InstallGHCEffects a))
-> AppState
-> ReaderT AppState IO (VEither InstallGHCEffects a)
-> IO (VEither InstallGHCEffects a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT AppState IO (VEither InstallGHCEffects a)
-> AppState -> IO (VEither InstallGHCEffects a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppState
appstate'
(ReaderT AppState IO (VEither InstallGHCEffects a)
-> IO (VEither InstallGHCEffects a))
-> (Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> ReaderT AppState IO (VEither InstallGHCEffects a))
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ReaderT AppState IO) (VEither InstallGHCEffects a)
-> ReaderT AppState IO (VEither InstallGHCEffects a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
(ResourceT (ReaderT AppState IO) (VEither InstallGHCEffects a)
-> ReaderT AppState IO (VEither InstallGHCEffects a))
-> (Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> ResourceT (ReaderT AppState IO) (VEither InstallGHCEffects a))
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> ReaderT AppState IO (VEither InstallGHCEffects a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE
@InstallGHCEffects
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
install :: Either InstallCommand InstallOptions
-> Settings
-> IO AppState
-> (ReaderT LeanAppState IO () -> IO ())
-> IO ExitCode
install Either InstallCommand InstallOptions
installCommand Settings
settings IO AppState
getAppState' ReaderT LeanAppState IO () -> IO ()
runLogger = case Either InstallCommand InstallOptions
installCommand of
(Right InstallOptions
iGHCopts) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
"This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
InstallOptions -> IO ExitCode
installGHC InstallOptions
iGHCopts
(Left (InstallGHC InstallOptions
iGHCopts)) -> InstallOptions -> IO ExitCode
installGHC InstallOptions
iGHCopts
(Left (InstallCabal InstallOptions
iopts)) -> InstallOptions -> IO ExitCode
installCabal InstallOptions
iopts
(Left (InstallHLS InstallOptions
iopts)) -> InstallOptions -> IO ExitCode
installHLS InstallOptions
iopts
(Left (InstallStack InstallOptions
iopts)) -> InstallOptions -> IO ExitCode
installStack InstallOptions
iopts
where
guessMode :: GuessMode
guessMode = if Settings -> Bool
guessVersion Settings
settings then GuessMode
GLax else GuessMode
GStrict
installGHC :: InstallOptions -> IO ExitCode
installGHC :: InstallOptions -> IO ExitCode
installGHC InstallOptions{Bool
[Text]
Maybe String
Maybe ToolVersion
Maybe URI
Text
instVer :: InstallOptions -> Maybe ToolVersion
instBindist :: InstallOptions -> Maybe URI
instSet :: InstallOptions -> Bool
isolateDir :: InstallOptions -> Maybe String
forceInstall :: InstallOptions -> Bool
installTargets :: InstallOptions -> Text
addConfArgs :: InstallOptions -> [Text]
instVer :: Maybe ToolVersion
instBindist :: Maybe URI
instSet :: Bool
isolateDir :: Maybe String
forceInstall :: Bool
installTargets :: Text
addConfArgs :: [Text]
..} = do
s' :: AppState
s'@AppState{ dirs :: AppState -> Dirs
dirs = Dirs{ String
GHCupPath
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
msys2Dir :: Dirs -> String
tmpDir :: Dirs -> GHCupPath
recycleDir :: Dirs -> GHCupPath
dbDir :: Dirs -> GHCupPath
confDir :: Dirs -> GHCupPath
logsDir :: Dirs -> GHCupPath
cacheDir :: Dirs -> GHCupPath
binDir :: Dirs -> String
baseDir :: Dirs -> GHCupPath
.. } } <- IO AppState -> IO AppState
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AppState
getAppState'
(case Maybe URI
instBindist of
Maybe URI
Nothing -> AppState
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC AppState
s' (Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo)))
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
GHC
Maybe Text
-> (Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallGHCEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallGHCEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Text
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
HasPlatformReq env, HasGHCupInfo env, HasDirs env, HasSettings env,
HasLog env, MonadResource m, MonadIO m, MonadUnliftIO m,
Alternative m) =>
GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Text
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
m
()
installGHCBin
GHCTargetVersion
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
[Text]
addConfArgs
Text
installTargets
)
(Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
NoCompatiblePlatform, ParseError, UnsupportedSetupCombo,
DistroNotFound, NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, NoCompatiblePlatform,
ParseError, UnsupportedSetupCombo, DistroNotFound,
NoCompatibleArch, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe String
-> Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHCOnly Maybe String
forall a. Maybe a
Nothing
Maybe VersionInfo
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
Just URI
uri -> do
AppState
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
runInstGHC AppState
s'{ settings = settings {noVerify = True}} (Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo)))
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallGHCEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
GHC
Maybe Text
-> (Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallGHCEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallGHCEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (DownloadInfo
-> GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Text
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadFail m, MonadMask m, MonadCatch m, MonadReader env m,
HasDirs env, HasSettings env, HasPlatformReq env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> GHCTargetVersion
-> InstallDir
-> Bool
-> [Text]
-> Text
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
m
()
installGHCBindist
(Text
-> Maybe TarDir
-> Text
-> Maybe Integer
-> Maybe String
-> Maybe [Tag]
-> DownloadInfo
DownloadInfo ((ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri) (TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (TarDir -> Maybe TarDir) -> TarDir -> Maybe TarDir
forall a b. (a -> b) -> a -> b
$ String -> TarDir
RegexDir String
"ghc-.*") Text
"" Maybe Integer
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe [Tag]
forall a. Maybe a
Nothing)
GHCTargetVersion
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
[Text]
addConfArgs
Text
installTargets
)
(Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, BuildFailed, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, DirNotEmpty,
ArchiveResult, ProcessError, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, BuildFailed, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, DirNotEmpty, ArchiveResult, ProcessError,
UninstallFailed, MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion
-> SetGHC
-> Maybe String
-> Excepts
'[NotInstalled] (ResourceT (ReaderT AppState IO)) GHCTargetVersion
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadThrow m,
MonadFail m, MonadIO m, MonadCatch m, MonadMask m,
MonadUnliftIO m) =>
GHCTargetVersion
-> SetGHC
-> Maybe String
-> Excepts '[NotInstalled] m GHCTargetVersion
setGHC GHCTargetVersion
v SetGHC
SetGHCOnly Maybe String
forall a. Maybe a
Nothing
Maybe VersionInfo
-> Excepts
InstallGHCEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
)
IO (VEither InstallGHCEffects (Maybe VersionInfo))
-> (VEither InstallGHCEffects (Maybe VersionInfo) -> IO ExitCode)
-> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VRight Maybe VersionInfo
vi -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"GHC installation successful"
Maybe Text -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPostInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
msg ->
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
msg
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft e :: V InstallGHCEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft e :: V InstallGHCEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (DirNotEmpty String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Install directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not empty."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft (V (DirNotEmpty String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Install directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not empty."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft err :: V InstallGHCEffects
err@(V (BuildFailed String
tmpdir V es
_)) -> do
case Settings -> KeepDirs
keepDirs Settings
settings of
KeepDirs
Never -> ReaderT LeanAppState IO () -> IO ()
runLogger (Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
err)
KeepDirs
_ -> ReaderT LeanAppState IO () -> IO ()
runLogger (Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
err) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Check the logs at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and the build directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tmpdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for more clues." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Make sure to clean up " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tmpdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" afterwards.")
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft err :: V InstallGHCEffects
err@(V (BuildFailed String
tmpdir V es
_)) -> do
case Settings -> KeepDirs
keepDirs Settings
settings of
KeepDirs
Never -> ReaderT LeanAppState IO () -> IO ()
runLogger (Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
err)
KeepDirs
_ -> ReaderT LeanAppState IO () -> IO ()
runLogger (Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
err) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Check the logs at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and the build directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tmpdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for more clues." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"Make sure to clean up " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tmpdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" afterwards.")
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft V InstallGHCEffects
e -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallGHCEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallGHCEffects
e
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Also check the logs in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir)
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
installCabal :: InstallOptions -> IO ExitCode
installCabal :: InstallOptions -> IO ExitCode
installCabal InstallOptions{Bool
[Text]
Maybe String
Maybe ToolVersion
Maybe URI
Text
instVer :: InstallOptions -> Maybe ToolVersion
instBindist :: InstallOptions -> Maybe URI
instSet :: InstallOptions -> Bool
isolateDir :: InstallOptions -> Maybe String
forceInstall :: InstallOptions -> Bool
installTargets :: InstallOptions -> Text
addConfArgs :: InstallOptions -> [Text]
instVer :: Maybe ToolVersion
instBindist :: Maybe URI
instSet :: Bool
isolateDir :: Maybe String
forceInstall :: Bool
installTargets :: Text
addConfArgs :: [Text]
..} = do
s' :: AppState
s'@AppState{ dirs :: AppState -> Dirs
dirs = Dirs{ String
GHCupPath
msys2Dir :: Dirs -> String
tmpDir :: Dirs -> GHCupPath
recycleDir :: Dirs -> GHCupPath
dbDir :: Dirs -> GHCupPath
confDir :: Dirs -> GHCupPath
logsDir :: Dirs -> GHCupPath
cacheDir :: Dirs -> GHCupPath
binDir :: Dirs -> String
baseDir :: Dirs -> GHCupPath
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
.. } } <- IO AppState -> IO AppState
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AppState
getAppState'
(case Maybe URI
instBindist of
Maybe URI
Nothing -> AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s' (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
Cabal
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) =>
Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
m
()
installCabalBin
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
v
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
Just URI
uri -> do
AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s'{ settings = settings { noVerify = True}} (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
Cabal
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
m
()
installCabalBindist
(Text
-> Maybe TarDir
-> Text
-> Maybe Integer
-> Maybe String
-> Maybe [Tag]
-> DownloadInfo
DownloadInfo ((ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri) Maybe TarDir
forall a. Maybe a
Nothing Text
"" Maybe Integer
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe [Tag]
forall a. Maybe a
Nothing)
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setCabal Version
v
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
)
IO (VEither InstallEffects (Maybe VersionInfo))
-> (VEither InstallEffects (Maybe VersionInfo) -> IO ExitCode)
-> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VRight Maybe VersionInfo
vi -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Cabal installation successful"
Maybe Text -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPostInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
msg ->
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
msg
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install cabal --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install cabal --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft V InstallEffects
e -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Also check the logs in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir)
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
4
installHLS :: InstallOptions -> IO ExitCode
installHLS :: InstallOptions -> IO ExitCode
installHLS InstallOptions{Bool
[Text]
Maybe String
Maybe ToolVersion
Maybe URI
Text
instVer :: InstallOptions -> Maybe ToolVersion
instBindist :: InstallOptions -> Maybe URI
instSet :: InstallOptions -> Bool
isolateDir :: InstallOptions -> Maybe String
forceInstall :: InstallOptions -> Bool
installTargets :: InstallOptions -> Text
addConfArgs :: InstallOptions -> [Text]
instVer :: Maybe ToolVersion
instBindist :: Maybe URI
instSet :: Bool
isolateDir :: Maybe String
forceInstall :: Bool
installTargets :: Text
addConfArgs :: [Text]
..} = do
s' :: AppState
s'@AppState{ dirs :: AppState -> Dirs
dirs = Dirs{ String
GHCupPath
msys2Dir :: Dirs -> String
tmpDir :: Dirs -> GHCupPath
recycleDir :: Dirs -> GHCupPath
dbDir :: Dirs -> GHCupPath
confDir :: Dirs -> GHCupPath
logsDir :: Dirs -> GHCupPath
cacheDir :: Dirs -> GHCupPath
binDir :: Dirs -> String
baseDir :: Dirs -> GHCupPath
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
.. } } <- IO AppState -> IO AppState
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AppState
getAppState'
(case Maybe URI
instBindist of
Maybe URI
Nothing -> AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s' (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
HLS
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasGHCupInfo env, HasDirs env, HasSettings env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) =>
Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
m
()
installHLSBin
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> SetHLS
-> Maybe String
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe String -> Excepts '[NotInstalled] m ()
setHLS Version
v SetHLS
SetHLSOnly Maybe String
forall a. Maybe a
Nothing
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
Just URI
uri -> do
AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s'{ settings = settings { noVerify = True}} (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
HLS
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
m
()
installHLSBindist
(Text
-> Maybe TarDir
-> Text
-> Maybe Integer
-> Maybe String
-> Maybe [Tag]
-> DownloadInfo
DownloadInfo ((ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri) (if Bool
isWindows then Maybe TarDir
forall a. Maybe a
Nothing else TarDir -> Maybe TarDir
forall a. a -> Maybe a
Just (String -> TarDir
RegexDir String
"haskell-language-server-*")) Text
"" Maybe Integer
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe [Tag]
forall a. Maybe a
Nothing)
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, ProcessError, DirNotEmpty, UninstallFailed,
MergeFileTreeError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
ProcessError, DirNotEmpty, UninstallFailed, MergeFileTreeError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> SetHLS
-> Maybe String
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m,
MonadMask m, MonadFail m, MonadUnliftIO m) =>
Version -> SetHLS -> Maybe String -> Excepts '[NotInstalled] m ()
setHLS Version
v SetHLS
SetHLSOnly Maybe String
forall a. Maybe a
Nothing
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
)
IO (VEither InstallEffects (Maybe VersionInfo))
-> (VEither InstallEffects (Maybe VersionInfo) -> IO ExitCode)
-> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VRight Maybe VersionInfo
vi -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"HLS installation successful"
Maybe Text -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPostInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
msg ->
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
msg
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install hls --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install hls --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft V InstallEffects
e -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Also check the logs in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir)
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
4
installStack :: InstallOptions -> IO ExitCode
installStack :: InstallOptions -> IO ExitCode
installStack InstallOptions{Bool
[Text]
Maybe String
Maybe ToolVersion
Maybe URI
Text
instVer :: InstallOptions -> Maybe ToolVersion
instBindist :: InstallOptions -> Maybe URI
instSet :: InstallOptions -> Bool
isolateDir :: InstallOptions -> Maybe String
forceInstall :: InstallOptions -> Bool
installTargets :: InstallOptions -> Text
addConfArgs :: InstallOptions -> [Text]
instVer :: Maybe ToolVersion
instBindist :: Maybe URI
instSet :: Bool
isolateDir :: Maybe String
forceInstall :: Bool
installTargets :: Text
addConfArgs :: [Text]
..} = do
s' :: AppState
s'@AppState{ dirs :: AppState -> Dirs
dirs = Dirs{ String
GHCupPath
msys2Dir :: Dirs -> String
tmpDir :: Dirs -> GHCupPath
recycleDir :: Dirs -> GHCupPath
dbDir :: Dirs -> GHCupPath
confDir :: Dirs -> GHCupPath
logsDir :: Dirs -> GHCupPath
cacheDir :: Dirs -> GHCupPath
binDir :: Dirs -> String
baseDir :: Dirs -> GHCupPath
baseDir :: GHCupPath
binDir :: String
cacheDir :: GHCupPath
logsDir :: GHCupPath
confDir :: GHCupPath
dbDir :: GHCupPath
recycleDir :: GHCupPath
tmpDir :: GHCupPath
msys2Dir :: String
.. } } <- IO AppState -> IO AppState
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO AppState
getAppState'
(case Maybe URI
instBindist of
Maybe URI
Nothing -> AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s' (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
Stack
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasDirs env,
HasSettings env, HasPlatformReq env, HasGHCupInfo env, HasLog env,
MonadResource m, MonadIO m, MonadUnliftIO m, MonadFail m) =>
Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
m
()
installStackBin
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
v
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
Just URI
uri -> do
AppState
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a.
AppState
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
runInstTool AppState
s'{ settings = settings { noVerify = True}} (Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo)))
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
-> IO (VEither InstallEffects (Maybe VersionInfo))
forall a b. (a -> b) -> a -> b
$ do
(GHCTargetVersion -> Version
_tvVersion -> Version
v, Maybe VersionInfo
vi) <- Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo))
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall a b. (a -> b) -> a -> b
$ Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
(ResourceT (ReaderT AppState IO))
(GHCTargetVersion, Maybe VersionInfo)
forall env (m :: * -> *).
(HasLog env, MonadFail m, MonadReader env m, HasGHCupInfo env,
HasDirs env, MonadThrow m, MonadIO m, MonadCatch m) =>
Maybe ToolVersion
-> GuessMode
-> Tool
-> Excepts
'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet]
m
(GHCTargetVersion, Maybe VersionInfo)
fromVersion Maybe ToolVersion
instVer GuessMode
guessMode Tool
Stack
Maybe Text
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPreInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> (Text
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ \Text
msg -> do
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
msg
ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts InstallEffects m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> ResourceT (ReaderT AppState IO) ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Text -> ResourceT (ReaderT AppState IO) ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn
Text
"...waiting for 5 seconds, you can still abort..."
IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a.
IO a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> IO ()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
5000000
Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ())
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) ()
forall a b. (a -> b) -> a -> b
$ Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (e :: [*]) (m :: * -> *) a b.
(Monad m, Show (V e), Pretty (V e), HFErrorProject (V e),
PopVariant InstallSetError e, LiftVariant' e (InstallSetError : e),
e :<< (InstallSetError : e)) =>
Excepts e m a
-> Excepts e m b -> Excepts (InstallSetError : e) m ()
runBothE' (DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (m :: * -> *) env.
(MonadMask m, MonadCatch m, MonadReader env m, HasPlatformReq env,
HasDirs env, HasSettings env, HasLog env, MonadResource m,
MonadIO m, MonadUnliftIO m, MonadFail m) =>
DownloadInfo
-> Version
-> InstallDir
-> Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
m
()
installStackBindist
(Text
-> Maybe TarDir
-> Text
-> Maybe Integer
-> Maybe String
-> Maybe [Tag]
-> DownloadInfo
DownloadInfo ((ByteString -> Text
decUTF8Safe (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef') URI
uri) Maybe TarDir
forall a. Maybe a
Nothing Text
"" Maybe Integer
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe [Tag]
forall a. Maybe a
Nothing)
Version
v
(InstallDir -> (String -> InstallDir) -> Maybe String -> InstallDir
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallDir
GHCupInternal String -> InstallDir
IsolateDir Maybe String
isolateDir)
Bool
forceInstall
) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[InstallSetError, AlreadyInstalled, CopyError, DigestError,
ContentLengthError, GPGError, DownloadFailed, NoDownload,
NotInstalled, UnknownArchive, TarDirDoesNotExist, ArchiveResult,
FileAlreadyExistsError, URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
instSet (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Bool
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
isolateDir) (Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
())
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
-> Excepts
'[AlreadyInstalled, CopyError, DigestError, ContentLengthError,
GPGError, DownloadFailed, NoDownload, NotInstalled, UnknownArchive,
TarDirDoesNotExist, ArchiveResult, FileAlreadyExistsError,
URIParseError]
(ResourceT (ReaderT AppState IO))
()
forall a b. (a -> b) -> a -> b
$ Version
-> Excepts '[NotInstalled] (ResourceT (ReaderT AppState IO)) ()
forall (m :: * -> *) env.
(MonadMask m, MonadReader env m, HasDirs env, HasLog env,
MonadThrow m, MonadFail m, MonadIO m, MonadUnliftIO m) =>
Version -> Excepts '[NotInstalled] m ()
setStack Version
v
Maybe VersionInfo
-> Excepts
InstallEffects
(ResourceT (ReaderT AppState IO))
(Maybe VersionInfo)
forall a.
a -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VersionInfo
vi
)
IO (VEither InstallEffects (Maybe VersionInfo))
-> (VEither InstallEffects (Maybe VersionInfo) -> IO ExitCode)
-> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
VRight Maybe VersionInfo
vi -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
"Stack installation successful"
Maybe Text -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VersionInfo -> Maybe Text
_viPostInstall (VersionInfo -> Maybe Text) -> Maybe VersionInfo -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe VersionInfo
vi) ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
msg ->
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo Text
msg
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install stack --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft e :: V InstallEffects
e@(V (AlreadyInstalled Tool
_ Version
_)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
ExitSuccess
VLeft (V (FileAlreadyExistsError String
fp)) -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$
Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists. Use 'ghcup install stack --isolate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --force ..." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' if you want to overwrite."
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
3
VLeft V InstallEffects
e -> do
ReaderT LeanAppState IO () -> IO ()
runLogger (ReaderT LeanAppState IO () -> IO ())
-> ReaderT LeanAppState IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ V InstallEffects -> String
forall e. (Pretty e, HFErrorProject e) => e -> String
prettyHFError V InstallEffects
e
Text -> ReaderT LeanAppState IO ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logError (Text -> ReaderT LeanAppState IO ())
-> Text -> ReaderT LeanAppState IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Also check the logs in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (GHCupPath -> String
fromGHCupPath GHCupPath
logsDir)
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
4