Add --raw-format to 'tool-requirements' subcommand

This commit is contained in:
Julian Ospald 2022-03-17 15:05:18 +01:00
parent e511fc3c0a
commit f9a38e616d
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
4 changed files with 55 additions and 9 deletions

View File

@ -98,7 +98,7 @@ data Command
#ifndef DISABLE_UPGRADE #ifndef DISABLE_UPGRADE
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
#endif #endif
| ToolRequirements | ToolRequirements ToolReqOpts
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
| Nuke | Nuke
#if defined(BRICK) #if defined(BRICK)
@ -289,8 +289,8 @@ com =
((\_ -> DInfo) <$> info helper (progDesc "Show debug info")) ((\_ -> DInfo) <$> info helper (progDesc "Show debug info"))
<> command <> command
"tool-requirements" "tool-requirements"
( (\_ -> ToolRequirements) ( ToolRequirements
<$> info helper <$> info (toolReqP <**> helper)
(progDesc "Show the requirements for ghc/cabal") (progDesc "Show the requirements for ghc/cabal")
) )
<> command <> command

View File

@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE QuasiQuotes #-}
module GHCup.OptParse.ToolRequirements where module GHCup.OptParse.ToolRequirements where
@ -11,6 +12,7 @@ module GHCup.OptParse.ToolRequirements where
import GHCup.Errors import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Utils.Logger import GHCup.Utils.Logger
import GHCup.Utils.String.QQ
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail ) 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 , MonadFail m
, Alternative m , Alternative m
) )
=> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ())) => ToolReqOpts
-> (ReaderT AppState m (VEither ToolRequirementsEffects ()) -> m (VEither ToolRequirementsEffects ()))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
toolRequirements runAppState runLogger = runToolRequirements runAppState (do toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements runAppState (do
GHCupInfo { .. } <- lift getGHCupInfo GHCupInfo { .. } <- lift getGHCupInfo
platform' <- liftE getPlatform platform' <- liftE getPlatform
req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements req <- getCommonRequirements platform' _toolRequirements ?? NoToolRequirements
liftIO $ T.hPutStr stdout (prettyRequirements req) if tlrRaw
then liftIO $ T.hPutStr stdout (rawRequirements req)
else liftIO $ T.hPutStr stdout (prettyRequirements req)
) )
>>= \case >>= \case
VRight _ -> pure ExitSuccess VRight _ -> pure ExitSuccess

View File

@ -228,7 +228,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Nuke -> pure () Nuke -> pure ()
Whereis _ _ -> pure () Whereis _ _ -> pure ()
DInfo -> pure () DInfo -> pure ()
ToolRequirements -> pure () ToolRequirements _ -> pure ()
ChangeLog _ -> pure () ChangeLog _ -> pure ()
UnSet _ -> pure () UnSet _ -> pure ()
#if defined(BRICK) #if defined(BRICK)
@ -308,7 +308,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#ifndef DISABLE_UPGRADE #ifndef DISABLE_UPGRADE
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
#endif #endif
ToolRequirements -> toolRequirements runAppState runLogger ToolRequirements topts -> toolRequirements topts runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
Nuke -> nuke appState runLogger Nuke -> nuke appState runLogger
Prefetch pfCom -> prefetch pfCom runAppState runLogger Prefetch pfCom -> prefetch pfCom runAppState runLogger

View File

@ -67,3 +67,9 @@ prettyRequirements Requirements {..} =
else "" else ""
n = if not . T.null $ _notes then "\n Note: " <> _notes else "" n = if not . T.null $ _notes then "\n Note: " <> _notes else ""
in "System requirements " <> d <> n in "System requirements " <> d <> n
rawRequirements :: Requirements -> T.Text
rawRequirements Requirements {..} =
if not . null $ _distroPKGs
then T.intercalate " " _distroPKGs
else ""