Warn if operators are using different fixity than those in base

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

src/Ormolu/Fixity/Internal.hs

@@ -16,6 +16,7 @@ module Ormolu.Fixity.Internal
     defaultFixityInfo,
     FixityApproximation (..),
     defaultFixityApproximation,
+    fixityInfoToApproximation,
     HackageInfo (..),
     FixityOverrides (..),
     defaultFixityOverrides,

src/Ormolu/Logging.hs

@@ -2,6 +2,8 @@ module Ormolu.Logging
   ( initializeLogging,
     logDebug,
     logDebugM,
+    logWarn,
+    logWarnM,
     logError,
     logErrorM,
   )
@@ -63,6 +65,12 @@ logDebugM ::
   m ()
 logDebugM label msg = logDebug label msg $ pure ()
 
+logWarn :: String -> a -> a
+logWarn = logDebug "WARNING"
+
+logWarnM :: (Monad m) => String -> m ()
+logWarnM msg = logWarn msg $ pure ()
+
 logError :: String -> a -> a
 logError = logToStderr . pure . Just
 

src/Ormolu/Printer/Operators.hs

@@ -15,6 +15,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
@@ -119,7 +120,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.