diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs index 3dad2bc..77fbb00 100644 --- a/app/ghcup/GHCup/OptParse.hs +++ b/app/ghcup/GHCup/OptParse.hs @@ -98,7 +98,7 @@ data Command #ifndef DISABLE_UPGRADE | Upgrade UpgradeOpts Bool #endif - | ToolRequirements + | ToolRequirements ToolReqOpts | ChangeLog ChangeLogOptions | Nuke #if defined(BRICK) @@ -289,8 +289,8 @@ com = ((\_ -> DInfo) <$> info helper (progDesc "Show debug info")) <> command "tool-requirements" - ( (\_ -> ToolRequirements) - <$> info helper + ( ToolRequirements + <$> info (toolReqP <**> helper) (progDesc "Show the requirements for ghc/cabal") ) <> command diff --git a/app/ghcup/GHCup/OptParse/ToolRequirements.hs b/app/ghcup/GHCup/OptParse/ToolRequirements.hs index 2f34d02..f7048ea 100644 --- a/app/ghcup/GHCup/OptParse/ToolRequirements.hs +++ b/app/ghcup/GHCup/OptParse/ToolRequirements.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE QuasiQuotes #-} module GHCup.OptParse.ToolRequirements where @@ -11,6 +12,7 @@ module GHCup.OptParse.ToolRequirements where import GHCup.Errors import GHCup.Types import GHCup.Utils.Logger +import GHCup.Utils.String.QQ #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail ( MonadFail ) @@ -34,6 +36,41 @@ import System.IO + --------------- + --[ Options ]-- + --------------- + + +data ToolReqOpts = ToolReqOpts + { tlrRaw :: Bool + } + + + + + --------------- + --[ Parsers ]-- + --------------- + + +toolReqP :: Parser ToolReqOpts +toolReqP = + ToolReqOpts + <$> switch (short 'r' <> long "raw-format" <> help "machine-parsable format") + + + + + -------------- + --[ Footer ]-- + -------------- + + +toolReqFooter :: String +toolReqFooter = [s|Discussion: + Print tool requirements on the current platform. + If you want to pass this to your package manage, use '--raw-format'.|] + --------------------------- @@ -66,14 +103,17 @@ toolRequirements :: ( Monad m , MonadFail m , Alternative m ) - => (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ())) + => ToolReqOpts + -> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ())) -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode -toolRequirements runAppState runLogger = runToolRequirements runAppState (do +toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements runAppState (do GHCupInfo { .. } <- lift getGHCupInfo platform' <- liftE getPlatform - req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements - liftIO $ T.hPutStr stdout (prettyRequirements req) + req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements + if tlrRaw + then liftIO $ T.hPutStr stdout (rawRequirements req) + else liftIO $ T.hPutStr stdout (prettyRequirements req) ) >>= \case VRight _ -> pure ExitSuccess diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index a09f6cc..c48107c 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -228,7 +228,7 @@ Report bugs at |] Nuke -> pure () Whereis _ _ -> pure () DInfo -> pure () - ToolRequirements -> pure () + ToolRequirements _ -> pure () ChangeLog _ -> pure () UnSet _ -> pure () #if defined(BRICK) @@ -308,7 +308,7 @@ Report bugs at |] #ifndef DISABLE_UPGRADE Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger #endif - ToolRequirements -> toolRequirements runAppState runLogger + ToolRequirements topts -> toolRequirements topts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger Nuke -> nuke appState runLogger Prefetch pfCom -> prefetch pfCom runAppState runLogger diff --git a/lib/GHCup/Requirements.hs b/lib/GHCup/Requirements.hs index 786dc3f..27bb87a 100644 --- a/lib/GHCup/Requirements.hs +++ b/lib/GHCup/Requirements.hs @@ -67,3 +67,9 @@ prettyRequirements Requirements {..} = else "" n = if not . T.null $ _notes then "\n Note: " <> _notes else "" in "System requirements " <> d <> n + +rawRequirements :: Requirements -> T.Text +rawRequirements Requirements {..} = + if not . null $ _distroPKGs + then T.intercalate " " _distroPKGs + else ""