From f00324bad0d5a4775796d6d0a7e25bd53059f02f Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sun, 10 Sep 2023 21:21:59 -0700 Subject: [PATCH 1/5] Add fixity troubleshooting in README --- README.md | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/README.md b/README.md index 178efd99..1ef14406 100644 --- a/README.md +++ b/README.md @@ -18,6 +18,8 @@ * [Regions](#regions) * [Exit codes](#exit-codes) * [Using as a library](#using-as-a-library) +* [Troubleshooting](#troubleshooting) + * [Operators are being formatted weirdly!](#operators-are-being-formatted-weirdly) * [Limitations](#limitations) * [Running on Hackage](#running-on-hackage) * [Forks and modifications](#forks-and-modifications) @@ -272,6 +274,23 @@ For these purposes only the top `Ormolu` module should be considered stable. It follows [PVP](https://pvp.haskell.org/) starting from the version 0.5.3.0. Rely on other modules at your own risk. +## Troubleshooting + +### Operators are being formatted weirdly! + +This can happen when Ormolu doesn't know or can't determine the fixity of an operator. + +* If this is a custom operator, see the instructions in the "Language extensions, dependencies, and fixities" section to specify the correct fixities in a `.ormolu` file. + +* If this is a third-party operator (e.g. from `base` or some other package from Hackage), Ormolu probably doesn't recognize that the operator is the same as the third-party one. + + Some reasons this might be the case: + + * You might have a custom Prelude that re-exports things from Prelude + * You might have `-XNoImplicitPrelude` turned on + + If any of these are true, make sure to specify the reexports correctly in a `.ormolu` file. + ## Limitations * CPP support is experimental. CPP is virtually impossible to handle From 50834108652ea8d93cd12bf7282b89439a3575da Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sun, 10 Sep 2023 21:39:03 -0700 Subject: [PATCH 2/5] Break out Ormolu.Logging --- app/Main.hs | 26 ++++++++++---------------- ormolu.cabal | 1 + src/Ormolu.hs | 30 +++++++++++++++++------------- src/Ormolu/Logging.hs | 31 +++++++++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 29 deletions(-) create mode 100644 src/Ormolu/Logging.hs diff --git a/app/Main.hs b/app/Main.hs index a44765c7..514a38ff 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -24,6 +24,7 @@ import Options.Applicative import Ormolu import Ormolu.Diff.Text (diffText, printTextDiff) import Ormolu.Fixity +import Ormolu.Logging import Ormolu.Parser (manualExts) import Ormolu.Terminal import Ormolu.Utils (showOutputable) @@ -33,7 +34,7 @@ import Paths_ormolu (version) import System.Directory import System.Exit (ExitCode (..), exitWith) import System.FilePath qualified as FP -import System.IO (hPutStrLn, stderr) +import System.IO (stderr) -- | Entry point of the program. main :: IO () @@ -82,22 +83,17 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = withPrettyOrmoluExceptions (cfgColorMode rawConfig) $ do let getCabalInfoForSourceFile' sourceFile = do cabalSearchResult <- getCabalInfoForSourceFile sourceFile - let debugEnabled = cfgDebug rawConfig case cabalSearchResult of CabalNotFound -> do - when debugEnabled $ - hPutStrLn stderr $ - "Could not find a .cabal file for " <> sourceFile + logDebug rawConfig "CABAL FILE" $ "Could not find a .cabal file for " <> sourceFile return Nothing CabalDidNotMention cabalInfo -> do - when debugEnabled $ do - relativeCabalFile <- - makeRelativeToCurrentDirectory (ciCabalFilePath cabalInfo) - hPutStrLn stderr $ - "Found .cabal file " - <> relativeCabalFile - <> ", but it did not mention " - <> sourceFile + relativeCabalFile <- makeRelativeToCurrentDirectory (ciCabalFilePath cabalInfo) + logDebug rawConfig "CABAL FILE" $ + "Found .cabal file " + <> relativeCabalFile + <> ", but it did not mention " + <> sourceFile return (Just cabalInfo) CabalFound cabalInfo -> return (Just cabalInfo) getDotOrmoluForSourceFile' sourceFile = do @@ -120,9 +116,7 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = ormoluStdin config >>= TIO.putStr return ExitSuccess InPlace -> do - hPutStrLn - stderr - "In place editing is not supported when input comes from stdin." + logError "In place editing is not supported when input comes from stdin." -- 101 is different from all the other exit codes we already use. return (ExitFailure 101) Check -> do diff --git a/ormolu.cabal b/ormolu.cabal index 93a545ec..988aca13 100644 --- a/ormolu.cabal +++ b/ormolu.cabal @@ -47,6 +47,7 @@ library Ormolu.Diff.Text Ormolu.Exception Ormolu.Imports + Ormolu.Logging Ormolu.Parser Ormolu.Parser.CommentStream Ormolu.Parser.Pragma diff --git a/src/Ormolu.hs b/src/Ormolu.hs index d0131196..c9b561a3 100644 --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -45,7 +45,6 @@ import Data.Maybe (fromMaybe) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T -import Debug.Trace import GHC.Driver.Errors.Types import GHC.Types.Error import GHC.Types.SrcLoc @@ -55,6 +54,7 @@ import Ormolu.Diff.ParseResult import Ormolu.Diff.Text import Ormolu.Exception import Ormolu.Fixity +import Ormolu.Logging import Ormolu.Parser import Ormolu.Parser.CommentStream (CommentStream (..)) import Ormolu.Parser.Result @@ -93,20 +93,24 @@ ormolu cfgWithIndices path originalInput = do fixityMap = packageFixityMap (overapproximatedDependencies cfg) -- memoized on the set of dependencies - when (cfgDebug cfg) $ do - traceM $ unwords ["*** CONFIG ***", show cfg] + + -- log inputs in debug logs + logDebug cfg "CONFIG" $ show cfg + (warnings, result0) <- parseModule' cfg fixityMap OrmoluParsingFailed path originalInput - when (cfgDebug cfg) $ do - forM_ warnings $ \driverMsg -> do - let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg - traceM $ unwords ["*** WARNING ***", showOutputable driverMsgSDoc] - forM_ result0 $ \case - ParsedSnippet r -> do - let CommentStream comments = prCommentStream r - forM_ comments $ \(L loc comment) -> - traceM $ unwords ["*** COMMENT ***", showOutputable loc, show comment] - _ -> pure () + + -- log parsing results in debug logs + forM_ warnings $ \driverMsg -> do + let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg + logDebug cfg "WARNING" $ unwords [showOutputable driverMsgSDoc] + forM_ result0 $ \case + ParsedSnippet r -> do + let CommentStream comments = prCommentStream r + forM_ comments $ \(L loc comment) -> + logDebug cfg "COMMENT" $ unwords [showOutputable loc, show comment] + _ -> pure () + -- We're forcing 'formattedText' here because otherwise errors (such as -- messages about not-yet-supported functionality) will be thrown later -- when we try to parse the rendered code back, inside of GHC monad diff --git a/src/Ormolu/Logging.hs b/src/Ormolu/Logging.hs new file mode 100644 index 00000000..8ec080ad --- /dev/null +++ b/src/Ormolu/Logging.hs @@ -0,0 +1,31 @@ +module Ormolu.Logging + ( logDebug, + logError, + ) +where + +import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO (..)) +import Ormolu.Config (Config (..)) +import System.IO (hPutStrLn, stderr) + +logDebug :: + (MonadIO m) => + Config region -> + -- | Some label to prefix the message with + String -> + -- | The message, ideally on a single line + String -> + m () +logDebug Config {cfgDebug} label msg = + when cfgDebug $ + logToStderr . unwords $ + [ "*** " <> label <> " ***", + msg + ] + +logError :: (MonadIO m) => String -> m () +logError = logToStderr + +logToStderr :: (MonadIO m) => String -> m () +logToStderr = liftIO . hPutStrLn stderr From d35f06dd702ba91c690602ac8037b1a1570e00c5 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sun, 10 Sep 2023 22:02:04 -0700 Subject: [PATCH 3/5] Allow logging anywhere --- app/Main.hs | 7 ++-- src/Ormolu.hs | 8 +++-- src/Ormolu/Logging.hs | 79 +++++++++++++++++++++++++++++++++---------- 3 files changed, 71 insertions(+), 23 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 514a38ff..ae3621d6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -40,6 +40,7 @@ import System.IO (stderr) main :: IO () main = do Opts {..} <- execParser optsParserInfo + initializeLogging optConfig let formatOne' = formatOne optConfigFileOpts @@ -85,11 +86,11 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = cabalSearchResult <- getCabalInfoForSourceFile sourceFile case cabalSearchResult of CabalNotFound -> do - logDebug rawConfig "CABAL FILE" $ "Could not find a .cabal file for " <> sourceFile + logDebugM "CABAL FILE" $ "Could not find a .cabal file for " <> sourceFile return Nothing CabalDidNotMention cabalInfo -> do relativeCabalFile <- makeRelativeToCurrentDirectory (ciCabalFilePath cabalInfo) - logDebug rawConfig "CABAL FILE" $ + logDebugM "CABAL FILE" $ "Found .cabal file " <> relativeCabalFile <> ", but it did not mention " @@ -116,7 +117,7 @@ formatOne ConfigFileOpts {..} mode reqSourceType rawConfig mpath = ormoluStdin config >>= TIO.putStr return ExitSuccess InPlace -> do - logError "In place editing is not supported when input comes from stdin." + logErrorM "In place editing is not supported when input comes from stdin." -- 101 is different from all the other exit codes we already use. return (ExitFailure 101) Check -> do diff --git a/src/Ormolu.hs b/src/Ormolu.hs index c9b561a3..9c886b99 100644 --- a/src/Ormolu.hs +++ b/src/Ormolu.hs @@ -88,6 +88,8 @@ ormolu :: Text -> m Text ormolu cfgWithIndices path originalInput = do + liftIO $ initializeLogging cfgWithIndices + let totalLines = length (T.lines originalInput) cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices fixityMap = @@ -95,7 +97,7 @@ ormolu cfgWithIndices path originalInput = do (overapproximatedDependencies cfg) -- memoized on the set of dependencies -- log inputs in debug logs - logDebug cfg "CONFIG" $ show cfg + logDebugM "CONFIG" $ show cfg (warnings, result0) <- parseModule' cfg fixityMap OrmoluParsingFailed path originalInput @@ -103,12 +105,12 @@ ormolu cfgWithIndices path originalInput = do -- log parsing results in debug logs forM_ warnings $ \driverMsg -> do let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg - logDebug cfg "WARNING" $ unwords [showOutputable driverMsgSDoc] + logDebugM "WARNING" $ unwords [showOutputable driverMsgSDoc] forM_ result0 $ \case ParsedSnippet r -> do let CommentStream comments = prCommentStream r forM_ comments $ \(L loc comment) -> - logDebug cfg "COMMENT" $ unwords [showOutputable loc, show comment] + logDebugM "COMMENT" $ unwords [showOutputable loc, show comment] _ -> pure () -- We're forcing 'formattedText' here because otherwise errors (such as diff --git a/src/Ormolu/Logging.hs b/src/Ormolu/Logging.hs index 8ec080ad..ab9d84de 100644 --- a/src/Ormolu/Logging.hs +++ b/src/Ormolu/Logging.hs @@ -1,31 +1,76 @@ module Ormolu.Logging - ( logDebug, + ( initializeLogging, + logDebug, + logDebugM, logError, + logErrorM, ) where -import Control.Monad (when) -import Control.Monad.IO.Class (MonadIO (..)) +import Data.Foldable (traverse_) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Ormolu.Config (Config (..)) import System.IO (hPutStrLn, stderr) +import System.IO.Unsafe (unsafePerformIO) +data LoggerConfig = LoggerConfig + { debugEnabled :: Bool + } + +loggerConfig :: IORef LoggerConfig +loggerConfig = unsafePerformIO $ newIORef (error "Logger not configured yet") +{-# NOINLINE loggerConfig #-} + +initializeLogging :: Config region -> IO () +initializeLogging cfg = + writeIORef loggerConfig $ + LoggerConfig + { debugEnabled = cfgDebug cfg + } + +-- | Output a debug log to stderr. +-- +-- Requires initializeLogging to be called first. logDebug :: - (MonadIO m) => - Config region -> + -- | Some label to prefix the message with + String -> + -- | The message, ideally on a single line + String -> + a -> + a +logDebug label msg = logToStderr getMessage + where + getMessage = do + cfg <- readIORef loggerConfig + pure $ + if debugEnabled cfg + then + Just . unwords $ + [ "*** " <> label <> " ***", + msg + ] + else Nothing + +-- | Output a debug log to stderr. +-- +-- Requires initializeLogging to be called first. +logDebugM :: + (Monad m) => -- | Some label to prefix the message with String -> -- | The message, ideally on a single line String -> m () -logDebug Config {cfgDebug} label msg = - when cfgDebug $ - logToStderr . unwords $ - [ "*** " <> label <> " ***", - msg - ] - -logError :: (MonadIO m) => String -> m () -logError = logToStderr - -logToStderr :: (MonadIO m) => String -> m () -logToStderr = liftIO . hPutStrLn stderr +logDebugM label msg = logDebug label msg $ pure () + +logError :: String -> a -> a +logError = logToStderr . pure . Just + +logErrorM :: (Monad m) => String -> m () +logErrorM msg = logError msg $ pure () + +logToStderr :: IO (Maybe String) -> a -> a +logToStderr getMessage a = + unsafePerformIO $ do + traverse_ (hPutStrLn stderr) =<< getMessage + pure a From 2469699de4f83dc6ad127a78d232af15837eee8e Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sun, 10 Sep 2023 22:38:07 -0700 Subject: [PATCH 4/5] Warn if operators are using different fixity than those in base --- src/Ormolu/Fixity.hs | 17 +++++++++++++++++ src/Ormolu/Fixity/Internal.hs | 1 + src/Ormolu/Logging.hs | 4 ++++ src/Ormolu/Printer/Operators.hs | 14 +++++++++++++- 4 files changed, 35 insertions(+), 1 deletion(-) diff --git a/src/Ormolu/Fixity.hs b/src/Ormolu/Fixity.hs index f6ba5260..dbb01f8f 100644 --- a/src/Ormolu/Fixity.hs +++ b/src/Ormolu/Fixity.hs @@ -29,6 +29,7 @@ module Ormolu.Fixity packageFixityMap', moduleFixityMap, applyFixityOverrides, + getShadowedFixities, ) where @@ -43,6 +44,7 @@ import Data.Set (Set) import Data.Set qualified as Set import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..)) import Ormolu.Fixity.Imports (FixityImport (..)) import Ormolu.Fixity.Internal @@ -181,3 +183,18 @@ memoSet f = memo (f . Set.fromAscList . fmap mkPackageName) . fmap unPackageName . Set.toAscList + +-- | Return the fixity information that the given operator's fixity is shadowing. +-- +-- https://github.com/tweag/ormolu/issues/1060 +getShadowedFixities :: RdrName -> FixityApproximation -> Maybe [FixityInfo] +getShadowedFixities rdrName fixityApprox = + case Map.lookup opName m of + Just opInfo + | let fixityInfos = NE.map (\(_, _, fixityInfo) -> fixityInfo) opInfo, + all ((fixityApprox /=) . fixityInfoToApproximation) fixityInfos -> + Just $ NE.toList fixityInfos + _ -> Nothing + where + opName = occOpName (rdrNameOcc rdrName) + PackageFixityMap m = packageFixityMap defaultDependencies diff --git a/src/Ormolu/Fixity/Internal.hs b/src/Ormolu/Fixity/Internal.hs index 40d69621..0ad34327 100644 --- a/src/Ormolu/Fixity/Internal.hs +++ b/src/Ormolu/Fixity/Internal.hs @@ -16,6 +16,7 @@ module Ormolu.Fixity.Internal defaultFixityInfo, FixityApproximation (..), defaultFixityApproximation, + fixityInfoToApproximation, HackageInfo (..), FixityOverrides (..), defaultFixityOverrides, diff --git a/src/Ormolu/Logging.hs b/src/Ormolu/Logging.hs index ab9d84de..d3aac561 100644 --- a/src/Ormolu/Logging.hs +++ b/src/Ormolu/Logging.hs @@ -2,6 +2,7 @@ module Ormolu.Logging ( initializeLogging, logDebug, logDebugM, + logWarn, logError, logErrorM, ) @@ -63,6 +64,9 @@ logDebugM :: m () logDebugM label msg = logDebug label msg $ pure () +logWarn :: String -> a -> a +logWarn = logDebug "WARNING" + logError :: String -> a -> a logError = logToStderr . pure . Just diff --git a/src/Ormolu/Printer/Operators.hs b/src/Ormolu/Printer/Operators.hs index 6f881db6..be0b9012 100644 --- a/src/Ormolu/Printer/Operators.hs +++ b/src/Ormolu/Printer/Operators.hs @@ -18,6 +18,7 @@ import Data.List.NonEmpty qualified as NE import GHC.Types.Name.Reader import GHC.Types.SrcLoc import Ormolu.Fixity +import Ormolu.Logging import Ormolu.Utils -- | Intermediate representation of operator trees, where a branching is not @@ -125,7 +126,18 @@ addFixityInfo modFixityMap getOpName (OpBranches exprs ops) = mrdrName = getOpName o fixityApproximation = case mrdrName of Nothing -> defaultFixityApproximation - Just rdrName -> inferFixity rdrName modFixityMap + Just rdrName -> + let fixityApprox = inferFixity rdrName modFixityMap + logIfOverridden = + case getShadowedFixities rdrName fixityApprox of + Just infos -> + logWarn . unwords $ + [ "Operator is possibly using the wrong fixity.", + "Got: " <> show fixityApprox <> ",", + "Fixities being shadowed: " <> show infos + ] + Nothing -> id + in logIfOverridden fixityApprox -- | Given a 'OpTree' of any shape, produce a flat 'OpTree', where every -- node and operator is directly connected to the root. From 2c9e39efadafbd4fcc35f2d287aa6d4be963267d Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Sun, 10 Sep 2023 22:54:50 -0700 Subject: [PATCH 5/5] Initialize logging for tests --- ormolu.cabal | 3 ++- tests/Main.hs | 11 +++++++++++ tests/Spec.hs | 2 +- weeder.toml | 1 + 4 files changed, 15 insertions(+), 2 deletions(-) create mode 100644 tests/Main.hs diff --git a/ormolu.cabal b/ormolu.cabal index 988aca13..a28c7272 100644 --- a/ormolu.cabal +++ b/ormolu.cabal @@ -156,10 +156,11 @@ executable ormolu test-suite tests type: exitcode-stdio-1.0 - main-is: Spec.hs + main-is: Main.hs build-tool-depends: hspec-discover:hspec-discover >=2 && <3 hs-source-dirs: tests other-modules: + Spec Ormolu.CabalInfoSpec Ormolu.Diff.TextSpec Ormolu.Fixity.ParserSpec diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 index 00000000..e6205337 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,11 @@ +module Main where + +import Ormolu.Config qualified as Ormolu +import Ormolu.Logging (initializeLogging) +import Spec qualified +import Test.Hspec.Runner + +main :: IO () +main = do + initializeLogging Ormolu.defaultConfig + hspec Spec.spec diff --git a/tests/Spec.hs b/tests/Spec.hs index a824f8c3..5416ef6a 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/weeder.toml b/weeder.toml index 9a2c8b63..81155607 100644 --- a/weeder.toml +++ b/weeder.toml @@ -1,6 +1,7 @@ roots = [ "^Main.main$", "^Paths_", + "^Spec.main$", "^Ormolu.Terminal.QualifiedDo.>>$" # https://github.com/ocharles/weeder/issues/112 ] type-class-roots = true