diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,16 @@ +## Ormolu 0.1.4.1 + +* Added command line option `--color` to control how diffs are printed. + Standardized the way errors are printed. + ## Ormolu 0.1.4.0 * Added support for monad comprehensions. [Issue - 665](https://github.com/tweag/ormolu/issues/658). + 665](https://github.com/tweag/ormolu/issues/665). * Fixed a bug when a space was inserted in front of promoted types even when it wasn't strictly necessary. [Issue - 668](https://github.com/tweag/ormolu/issues/688). + 668](https://github.com/tweag/ormolu/issues/668). * Now the checking mode displays diffs per file when unformatted files are found. The rendering of the diffs is also improved. [Issue diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -17,9 +17,11 @@ import Ormolu import Ormolu.Diff.Text (diffText, printTextDiff) import Ormolu.Parser (manualExts) +import Ormolu.Terminal import Ormolu.Utils (showOutputable) import Paths_ormolu (version) import System.Exit (ExitCode (..), exitWith) +import qualified System.FilePath as FP import System.IO (hPutStrLn, stderr) -- | Entry point of the program. @@ -56,8 +58,8 @@ -- | File to format or stdin as 'Nothing' Maybe FilePath -> IO ExitCode -formatOne mode config mpath = withPrettyOrmoluExceptions $ - case mpath of +formatOne mode config mpath = withPrettyOrmoluExceptions (cfgColorMode config) $ + case FP.normalise <$> mpath of Nothing -> do r <- ormoluStdin config case mode of @@ -88,7 +90,7 @@ case diffText originalInput formattedInput inputFile of Nothing -> return ExitSuccess Just diff -> do - printTextDiff stderr diff + runTerm (printTextDiff diff) (cfgColorMode config) stderr -- 100 is different to all the other exit code that are emitted -- either from an 'OrmoluException' or from 'error' and -- 'notImplemented'. @@ -163,13 +165,13 @@ short 'm', metavar "MODE", value Stdout, - help "Mode of operation: 'stdout' (default), 'inplace', or 'check'" + help "Mode of operation: 'stdout' (the default), 'inplace', or 'check'" ] ) <*> configParser <*> (many . strArgument . mconcat) [ metavar "FILE", - help "Haskell source files to format or stdin (default)" + help "Haskell source files to format or stdin (the default)" ] configParser :: Parser (Config RegionIndices) @@ -196,6 +198,12 @@ short 'c', help "Fail if formatting is not idempotent" ] + <*> (option parseColorMode . mconcat) + [ long "color", + metavar "WHEN", + value Auto, + help "Colorize the output; WHEN can be 'never', 'always', or 'auto' (the default)" + ] <*> ( RegionIndices <$> (optional . option auto . mconcat) [ long "start-line", @@ -219,3 +227,10 @@ "inplace" -> Right InPlace "check" -> Right Check s -> Left $ "unknown mode: " ++ s + +parseColorMode :: ReadM ColorMode +parseColorMode = eitherReader $ \case + "never" -> Right Never + "always" -> Right Always + "auto" -> Right Auto + s -> Left $ "unknown color mode: " ++ s diff --git a/ormolu.cabal b/ormolu.cabal --- a/ormolu.cabal +++ b/ormolu.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: ormolu -version: 0.1.4.0 +version: 0.1.4.1 license: BSD3 license-file: LICENSE.md maintainer: Mark Karpov @@ -110,6 +110,7 @@ Ormolu.Processing.Cpp Ormolu.Processing.Postprocess Ormolu.Processing.Preprocess + Ormolu.Terminal Ormolu.Utils hs-source-dirs: src @@ -147,6 +148,7 @@ default-language: Haskell2010 build-depends: base >=4.12 && <5.0, + filepath >=1.2 && <1.5, ghc-lib-parser >=8.10 && <8.11, gitrev >=1.3 && <1.4, optparse-applicative >=0.14 && <0.17, diff --git a/src/Ormolu.hs b/src/Ormolu.hs --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -6,6 +6,7 @@ ormoluFile, ormoluStdin, Config (..), + ColorMode (..), RegionIndices (..), defaultConfig, DynOption (..), diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs --- a/src/Ormolu/Config.hs +++ b/src/Ormolu/Config.hs @@ -4,6 +4,7 @@ -- | Configuration options used by the tool. module Ormolu.Config ( Config (..), + ColorMode (..), RegionIndices (..), RegionDeltas (..), defaultConfig, @@ -13,6 +14,7 @@ ) where +import Ormolu.Terminal (ColorMode (..)) import qualified SrcLoc as GHC -- | Ormolu configuration. @@ -25,6 +27,8 @@ cfgDebug :: !Bool, -- | Checks if re-formatting the result is idempotent cfgCheckIdempotence :: !Bool, + -- | Whether to use colors and other features of ANSI terminals + cfgColorMode :: !ColorMode, -- | Region selection cfgRegion :: !region } @@ -57,6 +61,7 @@ cfgUnsafe = False, cfgDebug = False, cfgCheckIdempotence = False, + cfgColorMode = Auto, cfgRegion = RegionIndices { regionStartLine = Nothing, diff --git a/src/Ormolu/Diff/Text.hs b/src/Ormolu/Diff/Text.hs --- a/src/Ormolu/Diff/Text.hs +++ b/src/Ormolu/Diff/Text.hs @@ -17,9 +17,7 @@ import Data.Maybe (listToMaybe) import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T -import System.Console.ANSI -import System.IO +import Ormolu.Terminal ---------------------------------------------------------------------------- -- Types @@ -70,53 +68,22 @@ D.First _ -> False D.Second _ -> False --- | Print the given 'TextDiff' to 'Handle'. This function tries to mimic --- the style of @git diff@. -printTextDiff :: Handle -> TextDiff -> IO () -printTextDiff h (TextDiff path xs) = do - supports <- hSupportsANSI h - let bold m = - if supports - then do - hSetSGR h [SetConsoleIntensity BoldIntensity] - m - hSetSGR h [Reset] - else m - cyan m = - if supports - then do - hSetSGR h [SetColor Foreground Dull Cyan] - m - hSetSGR h [Reset] - else m - green m = - if supports - then do - hSetSGR h [SetColor Foreground Dull Green] - m - hSetSGR h [Reset] - else m - red m = - if supports - then do - hSetSGR h [SetColor Foreground Dull Red] - m - hSetSGR h [Reset] - else m - put = T.hPutStr h - newline = hPutStr h "\n" - (bold . put . T.pack) path +-- | Print the given 'TextDiff' as a 'Term' action. This function tries to +-- mimic the style of @git diff@. +printTextDiff :: TextDiff -> Term () +printTextDiff (TextDiff path xs) = do + (bold . putS) path newline forM_ (toHunks (assignLines xs)) $ \Hunk {..} -> do cyan $ do put "@@ -" - put (T.pack $ show hunkFirstStartLine) + putS (show hunkFirstStartLine) put "," - put (T.pack $ show hunkFirstLength) + putS (show hunkFirstLength) put " +" - put (T.pack $ show hunkSecondStartLine) + putS (show hunkSecondStartLine) put "," - put (T.pack $ show hunkSecondLength) + putS (show hunkSecondLength) put " @@" newline forM_ hunkDiff $ \case @@ -140,7 +107,6 @@ put " " put y newline - hFlush h ---------------------------------------------------------------------------- -- Helpers diff --git a/src/Ormolu/Exception.hs b/src/Ormolu/Exception.hs --- a/src/Ormolu/Exception.hs +++ b/src/Ormolu/Exception.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -- | 'OrmoluException' type and surrounding definitions. @@ -9,12 +10,13 @@ where import Control.Exception +import Control.Monad (forM_) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T import qualified GHC import Ormolu.Diff.Text (TextDiff, printTextDiff) -import Ormolu.Utils (showOutputable) -import qualified Outputable as GHC +import Ormolu.Terminal import System.Exit (ExitCode (..)) import System.IO @@ -34,47 +36,63 @@ instance Exception OrmoluException --- | -printOrmoluException :: Handle -> OrmoluException -> IO () -printOrmoluException h = \case - OrmoluParsingFailed s e -> - hPutStrLn h $ - showParsingErr "The GHC parser (in Haddock mode) failed:" s [e] - OrmoluOutputParsingFailed s e -> - hPutStrLn h $ - showParsingErr "Parsing of formatted code failed:" s [e] - ++ "Please, consider reporting the bug.\n" - OrmoluASTDiffers path ss -> - hPutStrLn h . unlines $ - [ "AST of input and AST of formatted code differ." - ] - ++ fmap - withIndent - ( case fmap (\s -> "at " ++ showOutputable s) ss of - [] -> ["in " ++ path] - xs -> xs - ) - ++ ["Please, consider reporting the bug."] +-- | Print an 'OrmoluException'. +printOrmoluException :: + OrmoluException -> + Term () +printOrmoluException = \case + OrmoluParsingFailed s e -> do + bold (putSrcSpan s) + newline + put " The GHC parser (in Haddock mode) failed:" + newline + put " " + put (T.pack e) + newline + OrmoluOutputParsingFailed s e -> do + bold (putSrcSpan s) + newline + put " Parsing of formatted code failed:" + put " " + put (T.pack e) + newline + OrmoluASTDiffers path ss -> do + putS path + newline + put " AST of input and AST of formatted code differ." + newline + forM_ ss $ \s -> do + put " at " + putSrcSpan s + newline + put " Please, consider reporting the bug." + newline OrmoluNonIdempotentOutput diff -> do - hPutStrLn h "Formatting is not idempotent:\n" - printTextDiff h diff - hPutStrLn h "\nPlease, consider reporting the bug.\n" - OrmoluUnrecognizedOpts opts -> - hPutStrLn h . unlines $ - [ "The following GHC options were not recognized:", - (withIndent . unwords . NE.toList) opts - ] + printTextDiff diff + newline + put " Formatting is not idempotent." + newline + put " Please, consider reporting the bug." + newline + OrmoluUnrecognizedOpts opts -> do + put "The following GHC options were not recognized:" + newline + put " " + (putS . unwords . NE.toList) opts + newline -- | Inside this wrapper 'OrmoluException' will be caught and displayed -- nicely. withPrettyOrmoluExceptions :: + -- | Color mode + ColorMode -> -- | Action that may throw an exception IO ExitCode -> IO ExitCode -withPrettyOrmoluExceptions m = m `catch` h +withPrettyOrmoluExceptions colorMode m = m `catch` h where h e = do - printOrmoluException stderr e + runTerm (printOrmoluException e) colorMode stderr return . ExitFailure $ case e of -- Error code 1 is for 'error' or 'notImplemented' @@ -84,19 +102,3 @@ OrmoluASTDiffers {} -> 5 OrmoluNonIdempotentOutput {} -> 6 OrmoluUnrecognizedOpts {} -> 7 - ----------------------------------------------------------------------------- --- Helpers - --- | Show a parse error. -showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String -showParsingErr msg spn err = - unlines $ - [ msg, - withIndent (showOutputable spn) - ] - ++ map withIndent err - --- | Indent with 2 spaces for readability. -withIndent :: String -> String -withIndent txt = " " ++ txt diff --git a/src/Ormolu/Printer/Internal.hs b/src/Ormolu/Printer/Internal.hs --- a/src/Ormolu/Printer/Internal.hs +++ b/src/Ormolu/Printer/Internal.hs @@ -148,7 +148,7 @@ OnNextLine deriving (Eq, Show) --- | Run an 'R' monad. +-- | Run 'R' monad. runR :: -- | Monad to run R () -> diff --git a/src/Ormolu/Terminal.hs b/src/Ormolu/Terminal.hs new file mode 100644 --- /dev/null +++ b/src/Ormolu/Terminal.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | An abstraction for colorful output in terminal. +module Ormolu.Terminal + ( -- * The 'Term' monad + Term, + ColorMode (..), + runTerm, + + -- * Styling + bold, + cyan, + green, + red, + + -- * Printing + put, + putS, + putSrcSpan, + newline, + ) +where + +import Control.Monad.Reader +import Data.Text (Text) +import qualified Data.Text.IO as T +import qualified GHC +import Ormolu.Utils (showOutputable) +import System.Console.ANSI +import System.IO (Handle, hFlush, hPutStr) + +---------------------------------------------------------------------------- +-- The 'Term' monad + +-- | Terminal monad. +newtype Term a = Term (ReaderT RC IO a) + deriving (Functor, Applicative, Monad) + +-- | Reader context of 'Term'. +data RC = RC + { -- | Whether to use colors + rcUseColor :: Bool, + -- | Handle to print to + rcHandle :: Handle + } + +-- | Whether to use colors and other features of ANSI terminals. +data ColorMode = Never | Always | Auto + deriving (Eq, Show) + +-- | Run 'Term' monad. +runTerm :: + -- | Monad to run + Term a -> + -- | Color mode + ColorMode -> + -- | Handle to print to + Handle -> + IO a +runTerm (Term m) colorMode rcHandle = do + rcUseColor <- case colorMode of + Never -> return False + Always -> return True + Auto -> hSupportsANSI rcHandle + x <- runReaderT m RC {..} + hFlush rcHandle + return x + +---------------------------------------------------------------------------- +-- Styling + +-- | Make the inner computation output bold text. +bold :: Term a -> Term a +bold = withSGR [SetConsoleIntensity BoldIntensity] + +-- | Make the inner computation output cyan text. +cyan :: Term a -> Term a +cyan = withSGR [SetColor Foreground Dull Cyan] + +-- | Make the inner computation output green text. +green :: Term a -> Term a +green = withSGR [SetColor Foreground Dull Green] + +-- | Make the inner computation output red text. +red :: Term a -> Term a +red = withSGR [SetColor Foreground Dull Red] + +-- | Alter 'SGR' for inner computation. +withSGR :: [SGR] -> Term a -> Term a +withSGR sgrs (Term m) = Term $ do + RC {..} <- ask + if rcUseColor + then do + liftIO $ hSetSGR rcHandle sgrs + x <- m + liftIO $ hSetSGR rcHandle [Reset] + return x + else m + +---------------------------------------------------------------------------- +-- Printing + +-- | Output 'Text'. +put :: Text -> Term () +put txt = Term $ do + RC {..} <- ask + liftIO $ T.hPutStr rcHandle txt + +-- | Output 'String'. +putS :: String -> Term () +putS str = Term $ do + RC {..} <- ask + liftIO $ hPutStr rcHandle str + +-- | Output a 'GHC.SrcSpan'. +putSrcSpan :: GHC.SrcSpan -> Term () +putSrcSpan = putS . showOutputable + +-- | Output a newline. +newline :: Term () +newline = Term $ do + RC {..} <- ask + liftIO $ T.hPutStr rcHandle "\n" diff --git a/tests/Ormolu/Diff/TextSpec.hs b/tests/Ormolu/Diff/TextSpec.hs --- a/tests/Ormolu/Diff/TextSpec.hs +++ b/tests/Ormolu/Diff/TextSpec.hs @@ -5,10 +5,11 @@ import Data.Text (Text) import qualified Data.Text.IO as T import Ormolu.Diff.Text +import Ormolu.Terminal import Path import Path.IO import qualified System.FilePath as FP -import System.IO (Handle, hClose) +import System.IO (hClose) import Test.Hspec spec :: Spec @@ -44,14 +45,14 @@ parseRelFile expectedDiffPath >>= T.readFile . toFilePath . (diffOutputsDir ) let Just actualDiff = diffText inputA inputB "TEST" - actualDiffText <- printToText (\h -> printTextDiff h actualDiff) + actualDiffText <- printDiff actualDiff actualDiffText `shouldBe` expectedDiffText -- | Print to a 'Text' value. -printToText :: (Handle -> IO ()) -> IO Text -printToText action = +printDiff :: TextDiff -> IO Text +printDiff diff = withSystemTempFile "ormolu-diff-test" $ \path h -> do - action h + runTerm (printTextDiff diff) Never h hClose h T.readFile (toFilePath path)