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
| 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

View File

@ -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

View File

@ -228,7 +228,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Nuke -> pure ()
Whereis _ _ -> pure ()
DInfo -> pure ()
ToolRequirements -> pure ()
ToolRequirements _ -> pure ()
ChangeLog _ -> pure ()
UnSet _ -> pure ()
#if defined(BRICK)
@ -308,7 +308,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
#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

View File

@ -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 ""