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