From 29349969f046a6b2247f136a474dc9ab99bbbb4d Mon Sep 17 00:00:00 2001 From: hololeap Date: Sat, 23 Mar 2024 12:32:40 -0600 Subject: [PATCH] Display summary of warnings at end of execution Hackport is noisy. At the end of the output, display any warnings that were fired so that they are easier to notice. We use a DList to hold the list of warnings. This adds `StateT WarningBuffer` to the Env monad stack and runs displayWarnings (new function) as the last part of runEnv. Add `warn` function to the Util module and display warnings whenever `die` is called. Convert `errorWarnOnUnbuildable` in the Merge module to use the new warning functionality. Signed-off-by: hololeap --- src/Hackport/Env.hs | 46 ++++++++++++++++++++-- src/Hackport/Util.hs | 5 ++- src/Merge.hs | 91 +++++++++++++++++++++++++------------------- src/Util.hs | 31 ++++++++++++--- 4 files changed, 122 insertions(+), 51 deletions(-) diff --git a/src/Hackport/Env.hs b/src/Hackport/Env.hs index 5cd991e6..6c77434f 100644 --- a/src/Hackport/Env.hs +++ b/src/Hackport/Env.hs @@ -10,6 +10,10 @@ module Hackport.Env , HasGlobalEnv (..) , Env , runEnv + , WarningBuffer + , getWarningBuffer + , modifyWarningBuffer + , displayWarnings -- * Global env , GlobalEnv (..) -- * Subcommand env @@ -29,14 +33,28 @@ module Hackport.Env ) where import Control.Monad.Reader +import Control.Monad.State.Strict +import qualified Data.DList as DL +import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup (Last(..)) +import qualified Distribution.Simple.Utils as Cabal import qualified Distribution.Verbosity as V import Status.Types (StatusDirection) -type MonadEnv env m = (HasGlobalEnv m, HasEnv env m, MonadIO m) -type Env env = ReaderT (GlobalEnv, env) IO +-- | @hackport@ is noisy. Hold off on displaying any warnings until the bulk +-- of the output has been printed. We use a 'DL.DList' to hold the pending +-- warnings. +type WarningBuffer = DL.DList String + +type MonadEnv env m = + ( HasGlobalEnv m + , HasEnv env m + , MonadIO m + , MonadState WarningBuffer m + ) +type Env env = ReaderT (GlobalEnv, env) (StateT WarningBuffer IO) class HasGlobalEnv m where askGlobalEnv :: m GlobalEnv @@ -50,6 +68,23 @@ class HasEnv env m where instance Monad m => HasEnv env (ReaderT (a,env) m) where askEnv = asks snd +getWarningBuffer :: MonadState WarningBuffer m => m WarningBuffer +getWarningBuffer = get + +modifyWarningBuffer :: MonadState WarningBuffer m + => (WarningBuffer -> WarningBuffer) -> m () +modifyWarningBuffer = modify + +-- | Read the warning buffer and output using 'Cabal.warn'. +displayWarnings :: MonadIO m => V.Verbosity -> WarningBuffer -> m () +displayWarnings v dl = + liftIO $ Cabal.warn v $ unlines $ L.intercalate [""] $ + ["hackport emitted the following warnings:"] + : (indent <$> DL.toList dl) + where + indent :: String -> [String] + indent = map (" " ++) . lines + data GlobalEnv = GlobalEnv { globalVerbosity :: V.Verbosity , globalPathToOverlay :: Maybe FilePath @@ -102,9 +137,14 @@ data MergeEnv = MergeEnv instance WritesMetadata MergeEnv where useHackageRemote _ = True +-- | Run with environment information. This calls 'displayWarnings' at the +-- end of the execution. runEnv :: Env env a -> env -> GlobalEnv -> IO a -runEnv env e global = runReaderT env (global, e) +runEnv env e global = do + (a, dl) <- runStateT (runReaderT env (global, e)) DL.empty + displayWarnings (V.verboseNoWrap (globalVerbosity global)) dl + pure a diff --git a/src/Hackport/Util.hs b/src/Hackport/Util.hs index 2ab88e0d..b170d6f2 100644 --- a/src/Hackport/Util.hs +++ b/src/Hackport/Util.hs @@ -43,14 +43,15 @@ getPortageDir = do withHackportContext :: (DCG.GlobalFlags -> DCG.RepoContext -> Env env a) -> Env env a withHackportContext callback = do (GlobalEnv verbosity _ _, _) <- ask + warnBuffer <- getWarningBuffer overlayPath <- getOverlayPath let flags = DCG.defaultGlobalFlags { DCG.globalRemoteRepos = DUN.toNubList [defaultRemoteRepo] , DCG.globalCacheDir = DSS.Flag $ overlayPath ".hackport" } control - $ \runInIO -> DCG.withRepoContext verbosity flags - $ runInIO . (callback flags <=< restoreM) + $ \runInIO -> DCG.withRepoContext verbosity flags + $ \ctx -> runInIO $ restoreM (ctx, warnBuffer) >>= callback flags -- | Default remote repository. Defaults to [hackage](hackage.haskell.org). defaultRemoteRepo :: DCT.RemoteRepo diff --git a/src/Merge.hs b/src/Merge.hs index de9a5ea1..50df2c87 100644 --- a/src/Merge.hs +++ b/src/Merge.hs @@ -399,7 +399,7 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do debug $ "buildDepends pkgDesc: " ++ show (map prettyShow (Merge.buildDepends pkgDesc)) -- - warnings <- errorWarnOnUnbuildable + errorWarnOnUnbuildable (prettyShow cat) (prettyShow merged_cabal_pkg_name) pkgDesc0 @@ -477,8 +477,6 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do fetchDigestAndCheck (overlayPath prettyShow cat prettyShow norm_pkgName) $ Portage.fromCabalPackageId cat cabal_pkgId - forM_ warnings $ notice . ("\n" ++) - -- | Run @ebuild@ and @pkgcheck@ commands in the directory of the -- newly-generated ebuild. -- @@ -601,50 +599,63 @@ mergeEbuild existing_meta pkgdir ebuild flags = do notice $ "Writing " ++ emeta liftIO $ T.writeFile mpath updatedMetaText +--- + -- -- TODO: Make it so this is automatically fixed instead of requiring manual -- intervention + +-- | Check for unbuildable components. Unbuildable libraries are considered +-- a fatal error, whereas any other unbuildable components only require a +-- warning. This may produce false negatives when components are toggled by +-- flags, but it also helps catch .cabal files that hackport has a hard time +-- processing. errorWarnOnUnbuildable :: String -- Category name -> String -- Package name -> Cabal.PackageDescription - -> Env env [String] -errorWarnOnUnbuildable cn pn pkgdesc = execWriterT $ do - let lib = Cabal.library pkgdesc -- Main library - subLibs = Cabal.subLibraries pkgdesc -- sub-libraries - exes = Cabal.executables pkgdesc -- executables - tests = Cabal.testSuites pkgdesc -- test-suites - ubLib = findUnbuildable Cabal.libName Cabal.libBuildInfo lib - ubSubLibs = findUnbuildable Cabal.libName Cabal.libBuildInfo subLibs - ubExes = findUnbuildable Cabal.exeName Cabal.buildInfo exes - ubTests = findUnbuildable Cabal.testName Cabal.testBuildInfo tests - ubErrs = execWriter $ do - forM_ ubLib $ \_ -> - tell ["main library"] - forM_ ubSubLibs $ \l -> - tell ["sub-library: " ++ Cabal.showLibraryName l] - ubWarns = execWriter $ do - forM_ ubExes $ \e -> - tell ["executable: " ++ Cabal.unUnqualComponentName e] - forM_ ubTests $ \t -> - tell ["test-suite: " ++ Cabal.unUnqualComponentName t] - - unless (null ubWarns) $ tell $ pure $ unlines - $ [ "WARNING: The following components are unbuildable!" ] - ++ map (" - " ++) ubWarns - - unless (null ubErrs) $ error $ unlines - $ [ "FATAL: The following library components are unbuildable!" ] - ++ map (" - " ++) ubErrs - ++ [ "" - , "You can edit the .cabal file to make the needed components buildable," - , "then merge the package manually:" - , " $ cabal get " ++ pn - , " $ cd " ++ pn ++ "*/" - , " # fix " ++ pn ++ ".cabal" - , " $ hackport make-ebuild " ++ cn ++ " " ++ pn ++ ".cabal" - ] - + -> Env env () +errorWarnOnUnbuildable cn pn pkgdesc = do + unless (null ubWarns) $ warn $ unlines $ + [ "The following components are unbuildable!" ] + ++ map (" - " ++) ubWarns + unless (null ubErrs) $ die ubErrMsg where findUnbuildable toName toBuildable = fmap toName . mfilter (not . Cabal.buildable . toBuildable) + + lib = Cabal.library pkgdesc -- Main library + subLibs = Cabal.subLibraries pkgdesc -- sub-libraries + exes = Cabal.executables pkgdesc -- executables + tests = Cabal.testSuites pkgdesc -- test-suites + ubLib = findUnbuildable Cabal.libName Cabal.libBuildInfo lib + ubSubLibs = findUnbuildable Cabal.libName Cabal.libBuildInfo subLibs + ubExes = findUnbuildable Cabal.exeName Cabal.buildInfo exes + ubTests = findUnbuildable Cabal.testName Cabal.testBuildInfo tests + + ubWarns :: [String] + ubWarns = execWriter $ do + forM_ ubExes $ \e -> + tell ["executable: " ++ Cabal.unUnqualComponentName e] + forM_ ubTests $ \t -> + tell ["test-suite: " ++ Cabal.unUnqualComponentName t] + + ubErrs :: [String] + ubErrs = execWriter $ do + forM_ ubLib $ \_ -> + tell ["main library"] + forM_ ubSubLibs $ \l -> + tell ["sub-library: " ++ Cabal.showLibraryName l] + + ubErrMsg :: String + ubErrMsg = unlines + $ [ "FATAL: The following library components are unbuildable!" ] + ++ map (" - " ++) ubErrs + ++ [ "" + , "You can edit the .cabal file to make the needed components buildable," + , "then merge the package manually:" + , " $ cabal get " ++ pn + , " $ cd " ++ pn ++ "*/" + , " # fix " ++ pn ++ ".cabal" + , " $ hackport make-ebuild " ++ cn ++ " " ++ pn ++ ".cabal" + ] diff --git a/src/Util.hs b/src/Util.hs index 039f1bdb..6427771f 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -11,14 +11,19 @@ module Util , debug , notice , info + , warn + , displayWarnings , die ) where import Control.Monad.IO.Class +import Control.Monad.State.Strict +import qualified Data.DList as DL import System.IO import System.Process import System.Exit (ExitCode(..)) import qualified Distribution.Simple.Utils as Cabal +import qualified Distribution.Verbosity as Cabal import Hackport.Env -- | 'run_cmd' executes command and returns it's standard output @@ -38,14 +43,28 @@ run_cmd cmd = liftIO $ do else Just output debug :: (HasGlobalEnv m, MonadIO m) => String -> m () -debug s = askGlobalEnv >>= \(GlobalEnv v _ _) -> liftIO $ Cabal.debug v s +debug s = withVerbosity $ \v -> liftIO $ Cabal.debug v s notice :: (HasGlobalEnv m, MonadIO m) => String -> m () -notice s = askGlobalEnv >>= \(GlobalEnv v _ _) -> liftIO $ Cabal.notice v s +notice s = withVerbosity $ \v -> liftIO $ Cabal.notice v s info :: (HasGlobalEnv m, MonadIO m) => String -> m () -info s = askGlobalEnv >>= \(GlobalEnv v _ _) -> liftIO $ Cabal.info v s +info s = withVerbosity $ \v -> liftIO $ Cabal.info v s --- | Terminate with an error message -die :: (HasGlobalEnv m, MonadIO m) => String -> m a -die s = askGlobalEnv >>= \(GlobalEnv v _ _) -> liftIO $ Cabal.die' v s +-- | Display a warning, then add a it to the global 'WarningBuffer', so that +-- it will be displayed at the end of hackport's output. +warn :: (HasGlobalEnv m, MonadIO m, MonadState WarningBuffer m) => String -> m () +warn s = withVerbosity $ \v -> do + liftIO $ Cabal.warn v s + modifyWarningBuffer (<> DL.singleton s) + +-- | Display all pending warnings, then terminate with an error message +die :: (MonadState WarningBuffer m, HasGlobalEnv m, MonadIO m) => String -> m a +die s = withVerbosity $ \v -> getWarningBuffer >>= \dl -> do + displayWarnings v dl + liftIO $ error s + +withVerbosity :: (Monad m, HasGlobalEnv m) => (Cabal.Verbosity -> m a) -> m a +withVerbosity f = do + verbosity <- globalVerbosity <$> askGlobalEnv + f (Cabal.verboseNoWrap verbosity)