Skip to content

Commit

Permalink
Warn if operators are using different fixity than those in base
Browse files Browse the repository at this point in the history
  • Loading branch information
brandonchinn178 committed Sep 11, 2023
1 parent 1844dfd commit 18a1074
Show file tree
Hide file tree
Showing 4 changed files with 39 additions and 1 deletion.
17 changes: 17 additions & 0 deletions src/Ormolu/Fixity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ module Ormolu.Fixity
packageFixityMap',
moduleFixityMap,
applyFixityOverrides,
getShadowedFixities,
)
where

Expand All @@ -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
Expand Down Expand Up @@ -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
1 change: 1 addition & 0 deletions src/Ormolu/Fixity/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Ormolu.Fixity.Internal
defaultFixityInfo,
FixityApproximation (..),
defaultFixityApproximation,
fixityInfoToApproximation,
HackageInfo (..),
FixityOverrides (..),
defaultFixityOverrides,
Expand Down
8 changes: 8 additions & 0 deletions src/Ormolu/Logging.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@ module Ormolu.Logging
( initializeLogging,
logDebug,
logDebugM,
logWarn,
logWarnM,
logError,
logErrorM,
)
Expand Down Expand Up @@ -62,6 +64,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

Expand Down
14 changes: 13 additions & 1 deletion src/Ormolu/Printer/Operators.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down

0 comments on commit 18a1074

Please sign in to comment.