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 | ||||
|   | 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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 "" | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user