Allow to specify custom bindist, fixes #14
This commit is contained in:
parent
e1cf11f9d4
commit
dad926f3ba
@ -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
|
||||
|
||||
@ -341,6 +341,7 @@ executable ghcup
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, aeson
|
||||
, bytestring
|
||||
, containers
|
||||
, haskus-utils-variant
|
||||
|
||||
117
lib/GHCup.hs
117
lib/GHCup.hs
@ -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,32 +149,62 @@ installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
|
||||
| otherwise = []
|
||||
|
||||
|
||||
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
|
||||
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
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
|
||||
]
|
||||
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
|
||||
, MonadResource m
|
||||
, MonadIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> DownloadInfo
|
||||
-> Version
|
||||
-> PlatformRequest
|
||||
-> Excepts
|
||||
'[ AlreadyInstalled
|
||||
, CopyError
|
||||
, DigestError
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
, NotInstalled
|
||||
, UnknownArchive
|
||||
#if !defined(TAR)
|
||||
, ArchiveResult
|
||||
#endif
|
||||
]
|
||||
m
|
||||
()
|
||||
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 ]--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user