diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs index 9904c60..151d47b 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 c03b849..7cde559 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 c4121d2..80df955 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 164454c..9a94a15 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 |] 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 2bccf63..8252ab0 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 f3341ac..f763ea1 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 3bd66d0..0564534 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 76d611c..c209421 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"