diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs
index 9904c600114f26a8fec92e3ec309efd568ee4538..151d47b236786e2785a7dbf317213996b5d67769 100644
--- a/app/ghcup/GHCup/OptParse.hs
+++ b/app/ghcup/GHCup/OptParse.hs
@@ -74,6 +74,7 @@ data Options = Options
optVerbose :: Maybe Bool
, optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
+ , optPlatform :: Maybe PlatformRequest
, optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
@@ -116,6 +117,16 @@ opts =
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
+ <*> optional
+ (option
+ (eitherReader platformParser)
+ ( short 'p'
+ <> long "platform"
+ <> metavar "PLATFORM"
+ <> help
+ "Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
+ )
+ )
<*> optional
(option
(eitherReader parseUri)
diff --git a/app/ghcup/GHCup/OptParse/Config.hs b/app/ghcup/GHCup/OptParse/Config.hs
index c03b8492d59548b66bb6be872fb2d91c6e5ce0f1..7cde5590dd8076f14a70be5c2b1a5abd2f50655b 100644
--- a/app/ghcup/GHCup/OptParse/Config.hs
+++ b/app/ghcup/GHCup/OptParse/Config.hs
@@ -131,7 +131,8 @@ updateSettings UserSettings{..} Settings{..} =
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting
- in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
+ platformOverride' = uPlatformOverride <|> platformOverride
+ in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs
index c4121d2e5025cb7906468993c4a724cb34b257a0..80df95576271ae5e10575474501be1c611a98a56 100644
--- a/app/ghcup/GHCup/OptParse/Install.hs
+++ b/app/ghcup/GHCup/OptParse/Install.hs
@@ -66,7 +66,6 @@ data InstallCommand = InstallGHC InstallOptions
data InstallOptions = InstallOptions
{ instVer :: Maybe ToolVersion
- , instPlatform :: Maybe PlatformRequest
, instBindist :: Maybe URI
, instSet :: Bool
, isolateDir :: Maybe FilePath
@@ -176,18 +175,8 @@ Examples:
installOpts :: Maybe Tool -> Parser InstallOptions
installOpts tool =
- (\p (u, v) b is f -> InstallOptions v p u b is f)
- <$> optional
- (option
- (eitherReader platformParser)
- ( short 'p'
- <> long "platform"
- <> metavar "PLATFORM"
- <> help
- "Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
- )
- )
- <*> ( ( (,)
+ (\(u, v) b is f -> InstallOptions v u b is f)
+ <$> ( ( (,)
<$> optional
(option
(eitherReader uriParser)
@@ -268,11 +257,10 @@ type InstallEffects = '[ AlreadyInstalled
runInstTool :: AppState
- -> Maybe PlatformRequest
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallEffects a)
-runInstTool appstate' mInstPlatform =
- flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+runInstTool appstate' =
+ flip runReaderT appstate'
. runResourceT
. runE
@InstallEffects
@@ -302,11 +290,10 @@ type InstallGHCEffects = '[ AlreadyInstalled
]
runInstGHC :: AppState
- -> Maybe PlatformRequest
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
-> IO (VEither InstallGHCEffects a)
-runInstGHC appstate' mInstPlatform =
- flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
+runInstGHC appstate' =
+ flip runReaderT appstate'
. runResourceT
. runE
@InstallGHCEffects
@@ -331,7 +318,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
installGHC InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
- Nothing -> runInstGHC s' instPlatform $ do
+ Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
(_tvVersion v)
@@ -342,7 +329,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
$ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
pure vi
Just uri -> do
- runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
+ runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
@@ -403,7 +390,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
installCabal InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
- Nothing -> runInstTool s' instPlatform $ do
+ Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBin
v
@@ -412,7 +399,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v
pure vi
Just uri -> do
- runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+ runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "")
@@ -452,7 +439,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
installHLS InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
- Nothing -> runInstTool s' instPlatform $ do
+ Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
liftE $ runBothE' (installHLSBin
v
@@ -461,7 +448,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing
pure vi
Just uri -> do
- runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+ runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
@@ -502,7 +489,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
installStack InstallOptions{..} = do
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
(case instBindist of
- Nothing -> runInstTool s' instPlatform $ do
+ Nothing -> runInstTool s' $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBin
v
@@ -511,7 +498,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v
pure vi
Just uri -> do
- runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
+ runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "")
diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
index 164454ca77cbb6b8dffbd66f781e05e166e53526..9a94a153448361d06b74f94075bb2c71abddd878 100644
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -87,6 +87,7 @@ toSettings options = do
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) (OwnSource . (:[]) . Right) optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
+ platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal
@@ -198,14 +199,14 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
let appState = do
- pfreq <- (
- runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest
- ) >>= \case
- VRight r -> pure r
- VLeft e -> do
- runLogger
- (logError $ T.pack $ prettyShow e)
- exitWith (ExitFailure 2)
+ pfreq <- case platformOverride settings of
+ Just pfreq' -> return pfreq'
+ Nothing -> (runLogger . runE @'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] . liftE $ platformRequest) >>= \case
+ VRight r -> pure r
+ VLeft e -> do
+ runLogger
+ (logError $ T.pack $ prettyShow e)
+ exitWith (ExitFailure 2)
ghcupInfo <-
( flip runReaderT leanAppstate
diff --git a/data/config.yaml b/data/config.yaml
index 2bccf6387aa9ba1e52e2d329130f9de6df2a5951..8252ab0b84f0e051b5a9cd397afbff594ada705a 100644
--- a/data/config.yaml
+++ b/data/config.yaml
@@ -75,3 +75,14 @@ url-source:
# AddSource:
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-prereleases.yaml"
# - Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml"
+
+# This is a way to override platform detection, e.g. when you're running
+# a Ubuntu derivate based on 18.04, you could do:
+#
+# platform-override:
+# arch: A_64
+# platform:
+# contents: Ubuntu
+# tag: Linux
+# version: '18.04'
+platform-override: null
diff --git a/docs/guide.md b/docs/guide.md
index f3341ac5dafe3cff394322b13f5bae2ce6fad4d4..f763ea11b8db86104a1b291d0a7c02739106ecf4 100644
--- a/docs/guide.md
+++ b/docs/guide.md
@@ -71,6 +71,20 @@ explaining all possible configurations can be found in this repo: [config.yaml](
Partial configuration is fine. Command line options always override the config file settings.
+## Overriding distro detection
+
+If you're running e.g. an Ubuntu derivate based on 18.04 and ghcup is picking bindists that
+don't work well, you could do this in `config.yaml`:
+
+```yml
+platform-override:
+ arch: A_64
+ platform:
+ contents: Ubuntu
+ tag: Linux
+ version: '18.04'
+```
+
## Env variables
This is the complete list of env variables that change GHCup behavior:
diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs
index 3bd66d0246f12634a3b5403c6de49536e66f5121..0564534f384bff9ab55d2bdbba0c4ef771234b11 100644
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@@ -309,11 +309,12 @@ data UserSettings = UserSettings
, uUrlSource :: Maybe URLSource
, uNoNetwork :: Maybe Bool
, uGPGSetting :: Maybe GPGSetting
+ , uPlatformOverride :: Maybe PlatformRequest
}
deriving (Show, GHC.Generic)
defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
@@ -328,16 +329,17 @@ fromSettings Settings{..} Nothing =
, uKeyBindings = Nothing
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
+ , uPlatformOverride = platformOverride
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
- { kUp = Just bUp
- , kDown = Just bDown
- , kQuit = Just bQuit
- , kInstall = Just bInstall
- , kUninstall = Just bUninstall
- , kSet = Just bSet
- , kChangelog = Just bChangelog
+ { kUp = Just bUp
+ , kDown = Just bDown
+ , kQuit = Just bQuit
+ , kInstall = Just bInstall
+ , kUninstall = Just bUninstall
+ , kSet = Just bSet
+ , kChangelog = Just bChangelog
, kShowAll = Just bShowAllVersions
, kShowAllTools = Just bShowAllTools
}
@@ -352,6 +354,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
, uKeyBindings = Just ukb
, uUrlSource = Just urlSource
, uGPGSetting = Just gpgSetting
+ , uPlatformOverride = platformOverride
}
data UserKeyBindings = UserKeyBindings
@@ -421,16 +424,17 @@ instance NFData LeanAppState
data Settings = Settings
- { cache :: Bool
- , metaCache :: Integer
- , noVerify :: Bool
- , keepDirs :: KeepDirs
- , downloader :: Downloader
- , verbose :: Bool
- , urlSource :: URLSource
- , noNetwork :: Bool
- , gpgSetting :: GPGSetting
- , noColor :: Bool -- this also exists in LoggerConfig
+ { cache :: Bool
+ , metaCache :: Integer
+ , noVerify :: Bool
+ , keepDirs :: KeepDirs
+ , downloader :: Downloader
+ , verbose :: Bool
+ , urlSource :: URLSource
+ , noNetwork :: Bool
+ , gpgSetting :: GPGSetting
+ , noColor :: Bool -- this also exists in LoggerConfig
+ , platformOverride :: Maybe PlatformRequest
}
deriving (Show, GHC.Generic)
@@ -438,7 +442,7 @@ defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
+defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
instance NFData Settings
diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs
index 76d611c35eed636cb18ed3ea3a23674efdc3b072..c209421cd7a51382ed24cef579ac5b0c6aa07f92 100644
--- a/lib/GHCup/Types/JSON.hs
+++ b/lib/GHCup/Types/JSON.hs
@@ -56,6 +56,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Global
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
+deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "r-") . T.pack . kebab . tail $ str' } ''PlatformRequest
instance ToJSON Tag where
toJSON Latest = String "Latest"