ormolu 0.1.4.0 → 0.1.4.1

raw patch · 10 files changed

+229/−107 lines, 10 filesdep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−2
• app/Main.hs +20/−5
• ormolu.cabal +3/−1
• src/Ormolu.hs +1/−0
• src/Ormolu/Config.hs +5/−0
• src/Ormolu/Diff/Text.hs +10/−44
• src/Ormolu/Exception.hs +51/−49
• src/Ormolu/Printer/Internal.hs +1/−1
• src/Ormolu/Terminal.hs +125/−0
• tests/Ormolu/Diff/TextSpec.hs +6/−5

@@ -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

@@ -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

@@ -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 <mark.karpov@tweag.io>@@ -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,

@@ -6,6 +6,7 @@     ormoluFile,     ormoluStdin,     Config (..),+    ColorMode (..),     RegionIndices (..),     defaultConfig,     DynOption (..),

@@ -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,

@@ -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

@@ -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

@@ -148,7 +148,7 @@     OnNextLine   deriving (Eq, Show) --- | Run an 'R' monad.+-- | Run 'R' monad. runR ::   -- | Monad to run   R () ->

@@ -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"

@@ -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)