Add --raw-format to 'tool-requirements' subcommand
This commit is contained in:
parent
e511fc3c0a
commit
f9a38e616d
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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 ""
|
||||||
|
Loading…
Reference in New Issue
Block a user