From dad926f3ba14ad99711785e68bf67285dd886aa5 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 21 Jul 2020 20:18:51 +0200 Subject: [PATCH] Allow to specify custom bindist, fixes #14 --- app/ghcup/Main.hs | 26 +++++++++-- ghcup.cabal | 1 + lib/GHCup.hs | 117 ++++++++++++++++++++++++++++++++++------------ 3 files changed, 112 insertions(+), 32 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 81cd877..7cb639d 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -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\": \"\", \"dlSubdir\": \"ghc-\", \"dlUri\": \"\" }'" + ) + ) + ) <*> 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 |] 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 |] 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 diff --git a/ghcup.cabal b/ghcup.cabal index 730999f..488ff5a 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -341,6 +341,7 @@ executable ghcup import: config , base + , aeson , bytestring , containers , haskus-utils-variant diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 38313c3..d704889 100644 --- a/lib/GHCup.hs +++ b/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 ]--