Allow to specify custom bindist, fixes #14

This commit is contained in:
Julian Ospald 2020-07-21 20:18:51 +02:00
parent e1cf11f9d4
commit dad926f3ba
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 112 additions and 32 deletions

View File

@ -38,6 +38,7 @@ import Control.Monad.Fail ( MonadFail )
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Aeson ( eitherDecode )
import Data.Bifunctor
import Data.Char
import Data.Either
@ -68,6 +69,7 @@ import URI.ByteString
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Lazy.UTF8 as BLU
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
@ -119,6 +121,7 @@ data InstallCommand = InstallGHC InstallOptions
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
, instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe DownloadInfo
}
data SetCommand = SetGHC SetOptions
@ -405,7 +408,7 @@ installParser =
installOpts :: Parser InstallOptions
installOpts =
(flip InstallOptions)
(\p u v -> InstallOptions v p u)
<$> (optional
(option
(eitherReader platformParser)
@ -417,6 +420,17 @@ installOpts =
)
)
)
<*> (optional
(option
(eitherReader bindistParser)
( short 'u'
<> long "url"
<> metavar "BINDIST_URL"
<> help
"Provide DownloadInfo as json string, e.g.: '{ \"dlHash\": \"<sha256 hash>\", \"dlSubdir\": \"ghc-<ver>\", \"dlUri\": \"<uri>\" }'"
)
)
)
<*> optional toolVersionArgument
@ -800,6 +814,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
pure v
bindistParser :: String -> Either String DownloadInfo
bindistParser = eitherDecode . BLU.fromString
toSettings :: Options -> Settings
@ -1047,7 +1063,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installGHC InstallOptions{..} =
(runInstTool $ do
v <- liftE $ fromVersion dls instVer GHC
liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
case instBindist of
Nothing -> liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> liftE $ installGHCBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
)
>>= \case
VRight _ -> do
@ -1081,7 +1099,9 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let installCabal InstallOptions{..} =
(runInstTool $ do
v <- liftE $ fromVersion dls instVer Cabal
liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
case instBindist of
Nothing -> liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
Just uri -> liftE $ installCabalBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
)
>>= \case
VRight _ -> do

View File

@ -341,6 +341,7 @@ executable ghcup
import:
config
, base
, aeson
, bytestring
, containers
, haskus-utils-variant

View File

@ -77,7 +77,7 @@ import qualified Data.Text.Encoding as E
installGHCBin :: ( MonadFail m
installGHCBindist :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader Settings m
@ -85,7 +85,7 @@ installGHCBin :: ( MonadFail m
, MonadResource m
, MonadIO m
)
=> GHCupDownloads
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
@ -102,14 +102,13 @@ installGHCBin :: ( MonadFail m
]
m
()
installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
installGHCBindist dlinfo ver (PlatformRequest {..}) = do
let tver = (mkTVer ver)
lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
whenM (liftIO $ ghcInstalled tver)
$ (throwE $ AlreadyInstalled GHC ver)
-- download (or use cached version)
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
@ -150,7 +149,37 @@ installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
| otherwise = []
installCabalBin :: ( MonadMask m
installGHCBin :: ( MonadFail m
, MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadLogger m
, MonadResource m
, MonadIO m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, BuildFailed
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installGHCBin bDls ver pfreq = do
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
installGHCBindist dlinfo ver pfreq
installCabalBindist :: ( MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadLogger m
@ -158,7 +187,7 @@ installCabalBin :: ( MonadMask m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
=> DownloadInfo
-> Version
-> PlatformRequest
-> Excepts
@ -175,7 +204,7 @@ installCabalBin :: ( MonadMask m
]
m
()
installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
installCabalBindist dlinfo ver (PlatformRequest {..}) = do
lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
bindir <- liftIO ghcupBinDir
@ -190,7 +219,6 @@ installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
$ (throwE $ AlreadyInstalled Cabal ver)
-- download (or use cached version)
dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
dl <- liftE $ downloadCached dlinfo Nothing
-- unpack
@ -227,6 +255,37 @@ installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
Overwrite
installCabalBin :: ( MonadMask m
, MonadCatch m
, MonadReader Settings m
, MonadLogger m
, MonadResource m
, MonadIO m
, MonadFail m
)
=> GHCupDownloads
-> Version
-> PlatformRequest
-> Excepts
'[ AlreadyInstalled
, CopyError
, DigestError
, DownloadFailed
, NoDownload
, NotInstalled
, UnknownArchive
#if !defined(TAR)
, ArchiveResult
#endif
]
m
()
installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
installCabalBindist dlinfo ver pfreq
---------------------
--[ Set GHC/cabal ]--