From f3dbb1c208c2fdd27f571604195ea4e614fc2ca1 Mon Sep 17 00:00:00 2001 From: Rebecca Turner Date: Thu, 12 Dec 2024 15:52:35 -0800 Subject: [PATCH] Color output when stderr isatty If stderr isatty (i.e. the output is not being pumped to a file) and `$NO_COLOR` is unset or empty, or if `$FORCE_COLOR` is set and non-empty, output is colored. This helps distinguish `cabal2nix`'s output from the output of the fetchers it runs. --- cabal2nix/cabal2nix.cabal | 2 + cabal2nix/src/Cabal2nix.hs | 7 +- cabal2nix/src/Distribution/Nixpkgs/Color.hs | 70 +++++++++++++++++++ cabal2nix/src/Distribution/Nixpkgs/Fetch.hs | 6 +- .../Nixpkgs/Haskell/PackageSourceSpec.hs | 19 ++--- 5 files changed, 89 insertions(+), 15 deletions(-) create mode 100644 cabal2nix/src/Distribution/Nixpkgs/Color.hs diff --git a/cabal2nix/cabal2nix.cabal b/cabal2nix/cabal2nix.cabal index 851760500..98d4594c0 100644 --- a/cabal2nix/cabal2nix.cabal +++ b/cabal2nix/cabal2nix.cabal @@ -30,6 +30,7 @@ source-repository head library exposed-modules: Cabal2nix + Distribution.Nixpkgs.Color Distribution.Nixpkgs.Fetch Distribution.Nixpkgs.Haskell Distribution.Nixpkgs.Haskell.BuildInfo @@ -53,6 +54,7 @@ library -- with all installation methods mentioned in the README! , Cabal >= 3.0 , aeson > 1 + , ansi-terminal , ansi-wl-pprint , bytestring , containers >= 0.5.9 diff --git a/cabal2nix/src/Cabal2nix.hs b/cabal2nix/src/Cabal2nix.hs index 47799be1b..5398e65f7 100644 --- a/cabal2nix/src/Cabal2nix.hs +++ b/cabal2nix/src/Cabal2nix.hs @@ -17,6 +17,7 @@ import qualified Data.Set as Set import Data.String import Data.Time import Distribution.Compiler +import Distribution.Nixpkgs.Color (colorStderrLn, warningColor) import Distribution.Nixpkgs.Fetch import Distribution.Nixpkgs.Haskell import Distribution.Nixpkgs.Haskell.FromCabal @@ -36,7 +37,7 @@ import Language.Nix import Options.Applicative import Paths_cabal2nix ( version ) import System.Environment ( getArgs ) -import System.IO ( hFlush, hPutStrLn, stdout, stderr ) +import System.IO ( hFlush, stdout, stderr ) import qualified Text.PrettyPrint.ANSI.Leijen as P2 import Text.PrettyPrint.HughesPJClass ( Doc, Pretty(..), text, vcat, hcat, semi, render, prettyShow ) @@ -188,8 +189,8 @@ cabal2nix' opts@Options{..} = do cabal2nixWithDB :: DB.HackageDB -> Options -> IO (Either Doc Derivation) cabal2nixWithDB db opts@Options{..} = do - when (isJust optHackageDb) $ hPutStrLn stderr "WARN: HackageDB provided directly; ignoring --hackage-db" - when (isJust optHackageSnapshot) $ hPutStrLn stderr "WARN: HackageDB provided directly; ignoring --hackage-snapshot" + when (isJust optHackageDb) $ colorStderrLn warningColor "WARN: HackageDB provided directly; ignoring --hackage-db" + when (isJust optHackageSnapshot) $ colorStderrLn warningColor "WARN: HackageDB provided directly; ignoring --hackage-snapshot" pkg <- getPackage' optHpack optFetchSubmodules (return db) $ Source { sourceUrl = optUrl, diff --git a/cabal2nix/src/Distribution/Nixpkgs/Color.hs b/cabal2nix/src/Distribution/Nixpkgs/Color.hs new file mode 100644 index 000000000..34f6c5d0b --- /dev/null +++ b/cabal2nix/src/Distribution/Nixpkgs/Color.hs @@ -0,0 +1,70 @@ +module Distribution.Nixpkgs.Color + ( maybeColor + , colorStderrLn + , infoColor + , warningColor + , errorColor + , commandColor + ) where + +import System.Environment (lookupEnv) +import System.IO (Handle, hIsTerminalDevice, hPutStrLn, stderr) +import System.Console.ANSI.Codes + ( setSGRCode + , SGR(Reset, SetColor, SetConsoleIntensity) + , ConsoleLayer(Foreground) + , ColorIntensity(Vivid) + , Color(Yellow, Red, Cyan) + , ConsoleIntensity(BoldIntensity) + ) +import Control.Monad.IO.Class (MonadIO(liftIO)) + +-- | Colors that indicate a warning message. +warningColor :: [SGR] +warningColor = [SetColor Foreground Vivid Yellow] + +infoColor :: [SGR] +infoColor = [SetColor Foreground Vivid Cyan] + +-- | Colors that indicate an error message. +errorColor :: [SGR] +errorColor = [SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity] + +-- | Colors that indicate a command is being executed. +commandColor :: [SGR] +commandColor = [SetColor Foreground Vivid Cyan, SetConsoleIntensity BoldIntensity] + +-- | Check if an environment variable is set and non-empty. +envIsSet :: String -> IO Bool +envIsSet name = do + value <- lookupEnv name + pure $ case value of + Nothing -> False + Just "" -> False + Just _ -> True + +-- | Should output to the given `Handle` be colored? +shouldColor :: Handle -> IO Bool +shouldColor handle = do + -- See: https://no-color.org/ + noColor <- envIsSet "NO_COLOR" + if noColor + then pure False + else do + forceColor <- envIsSet "FORCE_COLOR" + if forceColor + then pure True + else hIsTerminalDevice handle + +-- | If the given `Handle` should be colored, wrap a `String` in `SGR` codes. +maybeColor :: Handle -> [SGR] -> String -> IO String +maybeColor handle sgrCodes original = do + shouldColor' <- shouldColor handle + if not shouldColor' + then pure original + else pure $ setSGRCode sgrCodes <> original <> setSGRCode [Reset] + +colorStderrLn :: MonadIO m => [SGR] -> String -> m () +colorStderrLn sgrCodes original = liftIO $ do + maybeColored <- maybeColor stderr sgrCodes original + hPutStrLn stderr maybeColored diff --git a/cabal2nix/src/Distribution/Nixpkgs/Fetch.hs b/cabal2nix/src/Distribution/Nixpkgs/Fetch.hs index 0bbd7b9a5..3305670cc 100644 --- a/cabal2nix/src/Distribution/Nixpkgs/Fetch.hs +++ b/cabal2nix/src/Distribution/Nixpkgs/Fetch.hs @@ -25,12 +25,12 @@ import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.List as L import Data.Maybe +import Distribution.Nixpkgs.Color (colorStderrLn, commandColor, warningColor) import GHC.Generics ( Generic ) import Language.Nix.PrettyPrinting as PP import System.Directory import System.Environment import System.Exit -import System.IO import System.Process -- | A source is a location from which we can fetch, such as a HTTP URL, a GIT URL, .... @@ -219,7 +219,7 @@ derivKindFunction = \case fetchWith :: (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, FilePath) fetchWith (supportsRev, kind) source = do unless ((sourceRevision source /= "") || isUnknown (sourceHash source) || not supportsRev) $ - liftIO (hPutStrLn stderr "** need a revision for VCS when the hash is given. skipping.") >> mzero + colorStderrLn warningColor "** need a revision for VCS when the hash is given. skipping." let (script, extraArgs) = case kind of DerivKindUrl UnpackArchive -> ("nix-prefetch-url", ["--unpack"]) @@ -236,7 +236,7 @@ fetchWith (supportsRev, kind) source = do : [ sourceRevision source | supportsRev ] ++ hashToList (sourceHash source) - liftIO $ hPutStrLn stderr $ "$ " ++ unwords (script:args) + colorStderrLn commandColor $ "$ " ++ unwords (script:args) MaybeT $ liftIO $ do envs <- getEnvironment diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageSourceSpec.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageSourceSpec.hs index 4797bef20..f08ea37b8 100644 --- a/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageSourceSpec.hs +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageSourceSpec.hs @@ -16,6 +16,7 @@ import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time +import Distribution.Nixpkgs.Color ( colorStderrLn, infoColor, errorColor ) import Distribution.Nixpkgs.Fetch import Distribution.Nixpkgs.Hashes import qualified Distribution.Nixpkgs.Haskell.Hackage as DB @@ -192,7 +193,7 @@ sourceFromHackage optHash pkgId cabalDir = do seq (length hash) $ urlDerivationSource url hash <$ writeFile cacheFile hash Nothing -> do - hPutStr stderr $ unlines + colorStderrLn errorColor $ unlines [ "*** cannot compute hash. (Not a hackage project?)" , " If your project is not on hackage, please supply the path to the root directory of" , " the project, not to the cabal file." @@ -226,7 +227,7 @@ cabalFromDirectory PackageYamlHpack dir = do useHpack <- liftIO $ shouldUseHpack dir if useHpack then do - liftIO $ hPutStrLn stderr "*** found package.yaml. Using hpack..." + colorStderrLn infoColor "*** found package.yaml. Using hpack..." hpackDirectory dir else onlyCabalFromDirectory dir "*** Found neither a .cabal file nor package.yaml. Exiting." @@ -269,7 +270,7 @@ hpackDirectory dir = do , Hpack.decodeOptionsTarget = dir Hpack.packageConfig } case mPackage of - Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure + Left err -> liftIO $ colorStderrLn errorColor ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure Right r -> do let hpackOutput = let body = Hpack.renderPackage [] (Hpack.decodeResultPackage r) @@ -278,10 +279,10 @@ hpackDirectory dir = do hash = printSHA256 $ digest (digestByName "sha256") hpackOutput case runParseGenericPackageDescription "" hpackOutput of Left msg -> liftIO $ do - hPutStrLn stderr "*** hpack output:" + colorStderrLn errorColor "*** hpack output:" BS.hPutStrLn stderr hpackOutput - hPutStrLn stderr "*** cannot parse hpack output:" - hPutStrLn stderr msg + colorStderrLn errorColor "*** cannot parse hpack output:" + colorStderrLn errorColor msg fail "*** Exiting." Right pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg @@ -290,13 +291,13 @@ cabalFromFile failHard file = -- hGetContents throws an error if it's used on files which contain sequences -- that do not represent valid characters. To catch that exception, we need to -- wrap the whole block in `catchIO`. - MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do + MaybeT $ handleIO (\err -> Nothing <$ colorStderrLn errorColor ("*** parsing cabal file: " ++ show err)) $ do buf <- BS.readFile file let hash = printSHA256 (digest (digestByName "sha256") buf) case runParseGenericPackageDescription file buf of Left msg | failHard -> liftIO $ do - hPutStrLn stderr $ "*** cannot parse " ++ show file ++ ":" - hPutStrLn stderr msg + colorStderrLn errorColor $ "*** cannot parse " ++ show file ++ ":" + colorStderrLn errorColor msg fail "*** Exiting." Left _ -> return Nothing Right pkg -> return $ Just $ setCabalFileHash hash pkg