Terminal colors for output

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

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,

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

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

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 "<hpack output>" 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