Implement a more precise inference of fixity information

CHANGELOG.md

@@ -1,5 +1,10 @@
 ## Unreleased
 
+* Inference of operator fixity information is now more precise and takes
+  into account the import section of the module being formatted. [Issue
+  892](https://github.com/tweag/ormolu/issues/892) and [issue
+  929](https://github.com/tweag/ormolu/issues/929).
+
 * Consistently format `do` blocks/`case`s/`MultiWayIf`s with 4 spaces if and
   only if they occur as the applicand. [Issue
   1002](https://github.com/tweag/ormolu/issues/1002) and [issue

app/Main.hs

@@ -20,7 +20,7 @@ import Language.Haskell.TH.Env (envQ)
 import Options.Applicative
 import Ormolu
 import Ormolu.Diff.Text (diffText, printTextDiff)
-import Ormolu.Fixity (FixityInfo, OpName)
+import Ormolu.Fixity (FixityInfo, FixityOverrides (..), OpName)
 import Ormolu.Parser (manualExts)
 import Ormolu.Terminal
 import Ormolu.Utils (showOutputable)
@@ -282,7 +282,7 @@ configParser =
         metavar "OPT",
         help "GHC options to enable (e.g. language extensions)"
       ]
-    <*> ( fmap (Map.fromListWith (<>) . mconcat)
+    <*> ( fmap (FixityOverrides . Map.fromList . mconcat)
             . many
             . option parseFixityDeclaration
             . mconcat

data/examples/declaration/type-synonyms/multi-line-out.hs

@@ -1,3 +1,5 @@
+import Servant.API
+
 type Foo a b c =
   Bar c a b
 

data/examples/declaration/type-synonyms/multi-line.hs

@@ -1,3 +1,5 @@
+import Servant.API
+
 type Foo a b c
   = Bar c a b
 

data/examples/declaration/value/function/infix/esqueleto-0-out.hs

@@ -0,0 +1,12 @@
+import Database.Esqueleto.Experimental
+
+foo = select $ do
+  t <-
+    from $
+      table @Bar
+        `innerJoin` table @Baz
+          `on` do
+            \(br :& bz) -> whatever
+  where_ $
+    t ^. BarInt ==. val 3
+      &&. t ^. BarName `in_` valList ["hello", "world"]

data/examples/declaration/value/function/infix/esqueleto-0.hs

@@ -0,0 +1,10 @@
+import Database.Esqueleto.Experimental
+
+foo = select $ do
+  t <- from $ table @Bar
+    `innerJoin` table @Baz
+      `on` do
+        \(br :& bz) -> whatever
+  where_ $
+    t ^. BarInt ==. val 3
+   &&. t ^. BarName `in_` valList ["hello", "world"]

data/examples/declaration/value/function/infix/esqueleto-1-out.hs

@@ -0,0 +1,9 @@
+import qualified Database.Esqueleto.Experimental as E
+
+foo =
+  E.from $
+    E.table
+      `E.innerJoin` E.table
+        `E.on` ( \(a :& b) ->
+                   a E.^. AField E.==. b E.^. BField
+               )

data/examples/declaration/value/function/infix/esqueleto-1.hs

@@ -0,0 +1,9 @@
+import qualified Database.Esqueleto.Experimental as E
+
+foo =
+  E.from $
+    E.table
+      `E.innerJoin` E.table
+      `E.on` ( \(a :& b) ->
+               a E.^. AField E.==. b E.^. BField
+             )

data/examples/declaration/value/function/infix/lenses-out.hs

@@ -1,3 +1,5 @@
+import Control.Lens.Operators
+
 lenses =
   Just $
     M.fromList $

data/examples/declaration/value/function/infix/lenses.hs

@@ -1,3 +1,5 @@
+import Control.Lens.Operators
+
 lenses = Just $ M.fromList
   $ "type"       .= ("user.connection" :: Text)
   # "connection" .= uc

data/examples/declaration/value/function/infix/qualified-prelude-out.hs

@@ -0,0 +1,12 @@
+module StreamSpec where
+
+import Prelude (($))
+import qualified Prelude
+
+spec :: Spec
+spec = do
+  describe "Comparing list function to" $ do
+    qit "yieldMany" $
+      \(mono :: Seq Int) ->
+        yieldMany mono
+          `checkProducer` otoList mono

data/examples/declaration/value/function/infix/qualified-prelude.hs

@@ -0,0 +1,12 @@
+module StreamSpec where
+
+import qualified Prelude
+import           Prelude (($))
+
+spec :: Spec
+spec = do
+    describe "Comparing list function to" $ do
+        qit "yieldMany" $
+            \(mono :: Seq Int) ->
+                yieldMany mono `checkProducer`
+                otoList mono

data/examples/declaration/value/function/operators-0-out.hs

@@ -1,3 +1,5 @@
+import Control.Lens.Operators
+
 a =
   b
     & c .~ d

data/examples/declaration/value/function/operators-0.hs

@@ -1,3 +1,5 @@
+import Control.Lens.Operators
+
 a =
   b & c .~ d
     & e %~ f

data/examples/declaration/value/function/operators-3-out.hs

@@ -1,3 +1,5 @@
+import Control.Arrow
+
 foo =
   op <> n
     <+> colon

data/examples/declaration/value/function/operators-3.hs

@@ -1,3 +1,5 @@
+import Control.Arrow
+
 foo =
   op <> n <+> colon <+> prettySe <+> text "=" <+>
     prettySe <> text sc

data/examples/declaration/value/function/operators-4-out.hs

@@ -1,3 +1,5 @@
+import Control.Arrow
+
 foo =
   line <> bindingOf
     <+> text "="

data/examples/declaration/value/function/operators-4.hs

@@ -1,3 +1,5 @@
+import Control.Arrow
+
 foo =
   line <> bindingOf <+> text "=" <+> tPretty <+> colon <+>
     align <> prettyPs

data/examples/declaration/value/function/operators-6-out.hs

@@ -1,3 +1,5 @@
+import Servant.API
+
 type PermuteRef =
   "a"
     :> ( "b" :> "c" :> End

data/examples/declaration/value/function/operators-6.hs

@@ -1,3 +1,5 @@
+import Servant.API
+
 type PermuteRef =
        "a" :> (    "b" :> "c" :> End
               :<|> "c" :> "b" :> End

extract-hackage-info.sh

@@ -4,7 +4,6 @@ set -e
 
 WDIR=$(mktemp -d)
 HOOGLE_DATABASE="$WDIR/hoogle-database/"
-HACKAGE_DATABASE="$WDIR/hackage-database.html"
 OUTPUT="$WDIR/hackage-info.bin"
 
 trap cleanup 0 1 2 3 15
@@ -16,9 +15,8 @@ cleanup()
 
 mkdir "$HOOGLE_DATABASE"
 curl "https://hackage.haskell.org/packages/hoogle.tar.gz" | tar -xz -C "$HOOGLE_DATABASE"
-curl "https://hackage.haskell.org/packages/top" -o "$HACKAGE_DATABASE"
 
-nix run .#extract-hackage-info -- "$HOOGLE_DATABASE" "$HACKAGE_DATABASE" -o "$OUTPUT"
+nix run .#extract-hackage-info -- "$HOOGLE_DATABASE" -o "$OUTPUT"
 
 cp "$OUTPUT" "extract-hackage-info/hackage-info.bin"
 

extract-hackage-info/README.md

@@ -34,16 +34,19 @@ only when there is no matching fixity declaration inside the package files
 that a symbol declaration indicates that the operator has the default fixity
 (`infixl 9`).
 
-In addition to the extraction of operator fixities, we also scrap the
+In general, correct resolution of fixities requires taking into account the
-download count of the last 30 days for every package on Hackage, to get a
+import section of a module that is being formatted, as well as knowing the
-popularity metric for packages which will be used to arbitrate between
+provenance (that is, module name) of each operator. Therefore, we also
-conflicting fixity declarations.
+collect and save this information.
 
 The `extract-hackage-info` executable takes care of everything listed above,
-and generates a `hackage-info.bin` file containing two associative maps:
+and generates a `hackage-info.bin` file containing multi-level map from
+package names to module names to operators to their fixities:
 
-+ package name → operator → fixity
+```haskell
-+ package name → popularity score
+newtype HackageInfo
+  = HackageInfo (Map PackageName (Map ModuleName (Map OpName FixityInfo)))
+```
 
 ## How to use `extract-hackage-info`
 

extract-hackage-info/extract-hackage-info.cabal

@@ -7,6 +7,7 @@ author:        Thomas Bagrel <thomas.bagrel@tweag.io>
 executable extract-hackage-info
     main-is:          Main.hs
     hs-source-dirs:   src
+    other-modules:    Hoogle
     default-language: GHC2021
     ghc-options:      -O2 -Wall -rtsopts -Wunused-packages
     build-depends:
@@ -19,7 +20,6 @@ executable extract-hackage-info
         filepath >=1.2 && <1.5,
         optparse-applicative >=0.14 && <0.18,
         ormolu,
-        tagsoup >=0.14 && <0.15,
         text >=2.0 && <3.0,
         formatting >=7.1 && <7.2,
         megaparsec >=9.0

extract-hackage-info/src/Hoogle.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Parse Hoogle txt files.
+module Hoogle
+  ( Package (..),
+    Module (..),
+    Declaration (..),
+    parsePackage,
+  )
+where
+
+import Control.Monad (void)
+import Data.Char (isAlphaNum)
+import Data.Foldable (asum)
+import Data.Text (Text)
+import Data.Void (Void)
+import Distribution.ModuleName (ModuleName)
+import Distribution.ModuleName qualified as ModuleName
+import Distribution.Types.PackageName (PackageName, mkPackageName)
+import Ormolu.Fixity
+import Ormolu.Fixity.Parser (pFixity, pOperator)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+
+type Parser = Parsec Void Text
+
+-- | Parsed Hoogle package.
+data Package = Package
+  { packageName :: PackageName,
+    modules :: [Module]
+  }
+  deriving (Eq, Show)
+
+-- | Parsed Hoogle module.
+data Module = Module
+  { hmModuleName :: ModuleName,
+    hmDeclarations :: [Declaration]
+  }
+  deriving (Eq, Show)
+
+-- | The types of declarations in the Hoogle files we are interested in.
+data Declaration
+  = Symbol OpName
+  | Fixity OpName FixityInfo
+  deriving (Eq, Show)
+
+-- | Parse Hoogle package file.
+parsePackage ::
+  -- | File name
+  FilePath ->
+  -- | Text to parse
+  Text ->
+  Either (ParseErrorBundle Text Void) Package
+parsePackage = parse pPackage
+
+-- | Parse a package. It starts with the word @\@package@ followed by the
+-- name of the package. A package contains zero or more modules.
+pPackage :: Parser Package
+pPackage = do
+  void (skipManyTill (pLineWithoutEol <* eol) (string "@package"))
+  hspace1
+  let isPackageNameConstituent x = x == '-' || isAlphaNum x
+  packageName <- some (satisfy isPackageNameConstituent) <?> "package name"
+  hspace
+  void eol
+  skipManyTill
+    (pLineWithoutEol <* eol)
+    (lookAhead (void (string "module ") <|> eof))
+  modules <- many pModule
+  eof
+  return (Package (mkPackageName packageName) modules)
+
+-- | Match a module declaration. It starts with the word @module@ followed
+-- by one or more spaces and a module identifier. A module contains
+-- 'pDeclaration's and any other arbitrary lines.
+pModule :: Parser Module
+pModule = do
+  void (string "module")
+  hspace1
+  let isModuleNameConstituent x =
+        x == '.' || x == '_' || x == '\'' || isAlphaNum x
+  moduleName <- some (satisfy isModuleNameConstituent) <?> "module name"
+  hspace
+  void eol
+  declarations <- mconcat <$> sepEndBy pDeclaration eol
+  return (Module (ModuleName.fromString moduleName) declarations)
+
+-- | Here we are interested in two kinds of declarations:
+--
+-- > Symbol declaration, e.g.:
+-- > ($) :: (a -> b) -> a -> b
+-- >
+-- > Fixity declaration, e.g.:
+-- > infixr 0 $
+--
+-- We discard everything else while being careful to stop in front of the
+-- beginning of a new module.
+pDeclaration :: Parser [Declaration]
+pDeclaration =
+  asum
+    [ fmap (uncurry Fixity) <$> try pFixity,
+      pure . Symbol <$> try pSymbolDecl,
+      [] <$ (notFollowedBy (string "module ") *> pLineWithoutEol)
+    ]
+  where
+    pSymbolDecl = do
+      void (string "(")
+      r <- pOperator
+      void (string ") :: ")
+      r <$ pLineWithoutEol
+
+pLineWithoutEol :: Parser ()
+pLineWithoutEol = void (takeWhileP Nothing (/= '\n'))

extract-hackage-info/src/Main.hs

@@ -8,74 +8,39 @@ module Main (main) where
 
 import Control.Exception
 import Control.Monad
-import Control.Monad.IO.Class (liftIO)
 import Data.Binary qualified as Binary
 import Data.Binary.Put qualified as Binary
 import Data.ByteString qualified as ByteString
 import Data.ByteString.Lazy qualified as BL
 import Data.List
-import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Maybe
-import Data.Semigroup (sconcat)
-import Data.Set qualified as Set
 import Data.Text (Text)
-import Data.Text qualified as T
 import Data.Text.Encoding (decodeLatin1)
 import Data.Text.IO qualified as TIO
-import Data.Void (Void)
+import Distribution.ModuleName (ModuleName)
-import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
+import Distribution.Types.PackageName (PackageName)
 import Formatting
+import Hoogle qualified
 import Options.Applicative
-import Ormolu.Fixity hiding (packageToOps, packageToPopularity)
+import Ormolu.Fixity
-import Ormolu.Fixity.Parser
 import System.Directory (doesDirectoryExist, listDirectory)
 import System.Exit (ExitCode (ExitFailure), exitWith)
-import System.FilePath (makeRelative, splitPath, (</>))
+import System.FilePath ((</>))
-import System.IO (stderr, stdout)
+import System.IO (hPutStrLn, stderr, stdout)
-import Text.HTML.TagSoup (Tag (TagText), parseTags)
+import Text.Megaparsec.Error (errorBundlePretty)
-import Text.HTML.TagSoup.Match (tagCloseLit, tagOpenLit)
-import Text.Megaparsec qualified as MP
-import Text.Megaparsec.Char qualified as MP
 
 defaultOutputPath :: FilePath
-defaultOutputPath = "extract-hackage-info/hackage-info.bin"
+defaultOutputPath = "hackage-info.bin"
-
--- | This fixity info is used when we find an operator declaration in a
--- package, but no matching fixity declaration.
-unspecifiedFixityInfo :: FixityInfo
-unspecifiedFixityInfo = FixityInfo (Just InfixL) 9 9
 
 -- | Contains the database being constructed during the processing of Hoogle
 -- files.
-data State = State
+newtype State = State
-  { -- | packageName -map-> (operatorName -map-> fixityDefinitions)
+  { -- | Hackage info
-    -- we keep a list of fixity definitions for each pair
+    sHackageInfo :: Map PackageName (Map ModuleName (Map OpName [FixityInfo]))
-    -- (packageName, operatorName) because sometimes a package itself has
-    -- conflicting fixity declarations for a same operator
-    -- (called self-conflicts), and we want to emit a warning message later
-    -- for these
-    sPackageToOps :: Map PackageName (Map OpName [FixityInfo]),
-    -- | How many Hoogle files have been processed
-    sProcessedFiles :: Int
   }
-  deriving (Eq)
+  deriving (Eq, Show)
-
--- | Exit with an error message.
-exitWithMsg :: Text -> IO ()
-exitWithMsg t = do
-  TIO.hPutStrLn stderr t
-  exitWith (ExitFailure 1)
-
-showT :: (Show a) => a -> Text
-showT = T.pack . show
-
-readT :: (Read a) => Text -> a
-readT = read . T.unpack
-
-indentLines :: [Text] -> [Text]
-indentLines = fmap ("  " <>)
 
 -- | Recursively list all files inside directory.
 walkDir ::
@@ -91,33 +56,8 @@ walkDir top = do
       False -> return [path]
   return (concat paths)
 
--- | Extract the package name from a path to a Hoogle file.
+-- | Try to read the specified file using utf-8 encoding first, and latin1
-getPackageName ::
+-- otherwise.
-  -- | Path to the Hoogle directory containing all package directories
-  FilePath ->
-  -- | Path to the Hoogle file
-  FilePath ->
-  -- | Package name extracted from the Hoogle file
-  IO PackageName
-getPackageName rootPath filePath = do
-  unless (rootPath `isPrefixOf` filePath) $
-    exitWithMsg $
-      sformat (string % " does not start with " % string) rootPath filePath
-  let packageName =
-        stripSuffix' "/" $
-          T.pack . head . splitPath $
-            makeRelative rootPath filePath
-      stripSuffix' suffix txt = fromMaybe txt $ T.stripSuffix suffix txt
-  when (T.null packageName) $
-    exitWithMsg $
-      sformat
-        ("Extracted package name is empty for " % string % " (base path = " % string % ")")
-        filePath
-        rootPath
-  pure . mkPackageName . T.unpack $ packageName
-
--- | Try to read the specified file using utf-8 encoding first,
--- and latin1 otherwise.
 readFileUtf8Latin1 :: FilePath -> IO Text
 readFileUtf8Latin1 filePath = catch @IOException (TIO.readFile filePath) $
   \e -> do
@@ -128,269 +68,115 @@ readFileUtf8Latin1 filePath = catch @IOException (TIO.readFile filePath) $
       e
     decodeLatin1 <$> ByteString.readFile filePath
 
--- | When a symbol declaration is encountered,
--- e.g. @(+) :: Num a => a -> a -> a@, update the fixity map accordingly.
-onSymbolDecl ::
-  -- | Name of the package in which the symbol declaration was found
-  PackageName ->
-  -- | Symbol name extracted from the symbol declaration in the Hoogle file
-  OpName ->
-  -- | Current state
-  State ->
-  -- | Updated state
-  State
-onSymbolDecl packageName declOpName state@State {..} =
-  let sPackageToOps' = case Map.lookup packageName sPackageToOps of
-        Nothing ->
-          Map.insert
-            packageName
-            (Map.singleton declOpName [])
-            sPackageToOps
-        Just packageFixityMap ->
-          case Map.lookup declOpName packageFixityMap of
-            Nothing ->
-              Map.insert
-                packageName
-                (Map.insert declOpName [] packageFixityMap)
-                sPackageToOps
-            Just _ -> sPackageToOps
-   in state {sPackageToOps = sPackageToOps'}
-
--- | When a fixity declaration is encountered, e.g. @infixr 5 :@, update the
--- fixity map accordingly.
-onFixityDecl ::
-  -- | Name of the package in which the symbol declaration was found
-  PackageName ->
-  -- | Tuple of operator name and fixity info
-  (OpName, FixityInfo) ->
-  -- | Current state
-  State ->
-  -- | Updated state
-  State
-onFixityDecl packageName (opName, fixDecl) state@State {..} =
-  let sPackageToOps' = case Map.lookup packageName sPackageToOps of
-        Nothing ->
-          Map.insert
-            packageName
-            (Map.singleton opName [fixDecl])
-            sPackageToOps
-        Just packageFixityMap ->
-          case fromMaybe [] $ Map.lookup opName packageFixityMap of
-            fixDecls
-              | fixDecl `elem` fixDecls ->
-                  sPackageToOps
-            fixDecls ->
-              Map.insert
-                packageName
-                ( Map.insert
-                    opName
-                    (fixDecl : fixDecls)
-                    packageFixityMap
-                )
-                sPackageToOps
-   in state {sPackageToOps = sPackageToOps'}
-
--- | Represent an operator for which we found conflicting definitions
--- originating from the same package.
-data SelfConflict = SelfConflict
-  { scPackageName :: PackageName,
-    scOperatorName :: OpName,
-    scConflictingDefs :: [FixityInfo]
-  }
-
--- | From a map allowing self conflicts, build the final map
--- packageName -map-> (operatorName -map-> fixityInfo)
--- (where conflicting definitions from self-conflicts are merged), and also
--- return the list of self-conflicts
-finalizePackageToOps ::
-  Map PackageName (Map OpName [FixityInfo]) ->
-  (Map PackageName (Map OpName FixityInfo), [SelfConflict])
-finalizePackageToOps hashmap =
-  ( Map.map (Map.map finalize) hashmap,
-    concatMap injectFst
-      . Map.toList
-      . Map.map (Map.toList . Map.filter hasConflict)
-      $ hashmap
-  )
-  where
-    finalize = \case
-      [] -> unspecifiedFixityInfo
-      fs -> sconcat . NE.fromList $ fs
-    hasConflict = (> 1) . length
-    injectFst (packageName, opFixs) =
-      uncurry (SelfConflict packageName) <$> opFixs
-
 -- | Scrap all fixity data from a Hoogle file, and update the state
 -- accordingly.
 extractFixitiesFromFile ::
-  -- | Path to the Hoogle directory containing all package directories
-  FilePath ->
   -- | Previous state
   State ->
   -- | Path of the Hoogle file to process
   FilePath ->
   -- | Updated state
   IO State
-extractFixitiesFromFile
+extractFixitiesFromFile state filePath = do
-  hoogleDatabasePath
+  fileContent <- readFileUtf8Latin1 filePath
-  state@State {sProcessedFiles}
+  case Hoogle.parsePackage filePath fileContent of
-  filePath = do
+    Left errorBundle -> do
-    fileContent <- liftIO . readFileUtf8Latin1 $ filePath
+      hPutStrLn stderr (errorBundlePretty errorBundle)
-    packageName <- liftIO $ getPackageName hoogleDatabasePath filePath
+      exitWith (ExitFailure 1)
-    let onDecl (SymbolDecl opName) = onSymbolDecl packageName opName
+    Right (Hoogle.Package packageName modules) ->
-        onDecl (FixityDecl opInfo) = onFixityDecl packageName opInfo
+      return $
-        state' = foldl' (flip onDecl) state $ parseDecls fileContent
+        let handleModule st (Hoogle.Module moduleName decls) =
-    return state' {sProcessedFiles = sProcessedFiles + 1}
+              let onDecl = \case
+                    Hoogle.Symbol opName ->
+                      registerOp packageName moduleName opName Nothing
+                    Hoogle.Fixity opName fixityInfo ->
+                      registerOp packageName moduleName opName (Just fixityInfo)
+               in foldl' (flip onDecl) st decls
+         in foldl' handleModule state modules
 
--- | The types of declarations in the Hoogle files we are interested in.
+-- | Add fixity info for an operator.
-data DeclType
+registerOp ::
-  = -- | See third argument of 'onSymbolDecl'.
+  -- | Name of the package in which the symbol declaration was found
-    SymbolDecl OpName
+  PackageName ->
-  | -- | See third argument of 'onFixityDecl'.
+  -- | Name of the module in which the symbol declaration was found
-    FixityDecl (OpName, FixityInfo)
+  ModuleName ->
+  -- | Symbol name extracted from the symbol declaration in the Hoogle file
+  OpName ->
+  -- | Fixity info, if available
+  Maybe FixityInfo ->
+  -- | Current state
+  State ->
+  -- | Updated state
+  State
+registerOp packageName moduleName opName fixityInfo state@State {..} =
+  let fixityInfoList = maybeToList fixityInfo
+      sHackageInfo' = Map.alter alterPackage packageName sHackageInfo
+      alterPackage = \case
+        Nothing ->
+          Just (Map.singleton moduleName (Map.singleton opName fixityInfoList))
+        Just pkg -> Just (Map.alter alterModule moduleName pkg)
+      alterModule = \case
+        Nothing -> Just (Map.singleton opName fixityInfoList)
+        Just mdl -> Just (Map.alter alterOp opName mdl)
+      alterOp = \case
+        Nothing -> Just fixityInfoList
+        Just finfos -> Just (fixityInfoList ++ finfos)
+   in state {sHackageInfo = sHackageInfo'}
 
--- | Parse all 'DeclType's in some file content.
+-- | Build the final operator map.
-parseDecls :: Text -> [DeclType]
+finalizePackageToOps ::
-parseDecls = either mempty id . MP.runParser pDecls ""
+  Map PackageName (Map ModuleName (Map OpName [FixityInfo])) ->
+  Map PackageName (Map ModuleName (Map OpName FixityInfo))
+finalizePackageToOps = Map.map (Map.map (Map.map finalize))
   where
-    pDecls = mconcat <$> pDecl `MP.sepEndBy` MP.newline
+    finalize = \case
-    pDecl :: MP.Parsec Void Text [DeclType]
+      [] -> defaultFixityInfo
-    pDecl =
+      -- In some very rare and exceptional cases there seem to be multiple
-      asum
+      -- conflicting fixity definitions. I think it is acceptable to be
-        [ fmap FixityDecl <$> MP.try pFixity,
+      -- somewhat arbitrary in that case.
-          pure . SymbolDecl <$> MP.try pSymbolDecl,
+      (x : _) -> x
-          [] <$ pRemainingLine
-        ]
-      where
-        pRemainingLine = MP.takeWhileP Nothing (/= '\n')
-        pSymbolDecl =
-          MP.char '(' *> pOperator <* MP.chunk ") :: " <* pRemainingLine
 
 -- | Process the whole Hoogle database and return a map associating each
 -- package name to its fixity map.
 extractHoogleInfo ::
-  -- | Path to the hoogle directory containing all package directories
+  -- | Path to the Hoogle directory containing all package directories
   FilePath ->
-  IO (Map PackageName FixityMap)
+  IO (Map PackageName (Map ModuleName (Map OpName FixityInfo)))
 extractHoogleInfo hoogleDatabasePath = do
   hoogleFiles <- walkDir hoogleDatabasePath
   State {..} <-
     foldM
-      (extractFixitiesFromFile hoogleDatabasePath)
+      extractFixitiesFromFile
-      (State {sPackageToOps = Map.empty, sProcessedFiles = 0})
+      (State Map.empty)
       hoogleFiles
-  hprintLn
+  let sHackageInfoFinalized = finalizePackageToOps sHackageInfo
-    stdout
+  displayFixityStats sHackageInfoFinalized
-    (int % " Hoogle files processed!")
+  return sHackageInfoFinalized
-    sProcessedFiles
-  let (packageToOps, selfConflicts) = finalizePackageToOps sPackageToOps
-  displayFixityStats packageToOps
-  displaySelfConflicts selfConflicts
-  return packageToOps
-
--- | Warn the user about self-conflicts.
-displaySelfConflicts :: [SelfConflict] -> IO ()
-displaySelfConflicts selfConflicts =
-  unless (null selfConflicts) $ do
-    hprintLn
-      stdout
-      ("Found " % int % " conflicting declarations within packages themselves:")
-      (length selfConflicts)
-    TIO.putStrLn $ T.intercalate "\n" selfConflictLines
-  where
-    selfConflictLines = concat $ showSc <$> sortedSelfConflicts
-    sortedSelfConflicts =
-      sortBy
-        ( \(SelfConflict p1 o1 _) (SelfConflict p2 o2 _) ->
-            compare (p1, o1) (p2, o2)
-        )
-        selfConflicts
-    showSc SelfConflict {scPackageName, scOperatorName, scConflictingDefs} =
-      sformat
-        ("(in " % string % ") " % string)
-        (unPackageName scPackageName)
-        (T.unpack $ unOpName scOperatorName)
-        : indentLines (showT <$> scConflictingDefs)
 
 -- | Display stats about the Hoogle database processing.
-displayFixityStats :: Map PackageName FixityMap -> IO ()
+displayFixityStats ::
-displayFixityStats packageToOps =
+  Map PackageName (Map ModuleName (Map OpName FixityInfo)) ->
+  IO ()
+displayFixityStats packages =
   hprintLn
     stdout
     ( "Found "
         % int
         % " operator declarations across "
         % int
-        % " packages for a total of "
+        % " packages"
-        % int
-        % " distinct operators"
     )
-    declCount
+    declarationCount
-    packagesCount
+    packageCount
-    distinctOpCount
   where
-    packagesCount = Map.size packageToOps
+    packageCount = Map.size packages
-    declCount = sum $ Map.size <$> fixityMaps
+    modulesPerPackage = Map.elems packages
-    distinctOpCount =
+    declarationsPerModule = concatMap Map.elems modulesPerPackage
-      Set.size . Set.fromList . concat $
+    declarationCount = sum (Map.size <$> declarationsPerModule)
-        Map.keys <$> fixityMaps
-    fixityMaps = Map.elems packageToOps
-
--- | Extract package download counts from the hackage HTML page.
-extractHackageInfo ::
-  -- | Path to the Hackage HTML page
-  FilePath ->
-  -- | Map packageName -> download count
-  IO (Map PackageName Int)
-extractHackageInfo filePath = do
-  content <- TIO.readFile filePath
-  let soup = filterBlankTags $ parseTags content
-      tableBody =
-        drop 7 $
-          takeWhile (not . tagCloseLit "table") $
-            dropWhile (not . tagOpenLit "table" (const True)) soup
-      processRow tags = case extractText <$> groupOn "td" tags of
-        rawName : rawDlCount : _ -> return $ Just (mkPackageName name, dlCount)
-          where
-            name = T.unpack . T.strip . head $ T.split (== ' ') rawName
-            dlCount = readT $ T.strip rawDlCount :: Int
-        _ -> do
-          hprintLn
-            stdout
-            ("Invalid line: " % stext)
-            (T.intercalate " " $ showT <$> tags)
-          return Nothing
-      extractText tags = T.intercalate "" $ extractText' <$> tags
-      extractText' = \case
-        TagText t -> t
-        _ -> ""
-      groupOn _ [] = []
-      groupOn selector (_ : ts) =
-        let (tags, remTags) = break (tagOpenLit selector (const True)) ts
-         in init tags : groupOn selector remTags
-      filterBlankTags =
-        filter
-          ( \case
-              TagText t | isBlank t -> False
-              _ -> True
-          )
-      isBlank t = null $ dropWhile (`elem` [' ', '\t', '\n']) (T.unpack t)
-  result <- Map.fromList . catMaybes <$> traverse processRow (groupOn "tr" tableBody)
-  hprintLn
-    stdout
-    ("Found popularity information for " % int % " packages")
-    (Map.size result)
-  return result
-
--- | Limit the number of items in a map.
-limitMap :: (Ord k) => Int -> Map k v -> Map k v
-limitMap n = Map.fromList . take n . Map.toList
 
 data Config = Config
   { cfgHoogleDatabasePath :: FilePath,
-    cfgHackageDatabasePath :: FilePath,
+    cfgOutputPath :: FilePath
-    cfgOutputPath :: FilePath,
-    cfgDebugLimit :: Maybe Int
   }
   deriving (Eq, Show)
 
@@ -407,35 +193,16 @@ configParserInfo = info (helper <*> configParser) fullDesc
               \curl https://hackage.haskell.org/packages/hoogle.tar.gz | \
               \tar -xz -C hoogle-database"
           ]
-        <*> (strArgument . mconcat)
-          [ metavar "HACKAGE_DATABASE_PATH",
-            help
-              "Download: curl https://hackage.haskell.org/packages/browse \
-              \ -o hackage-database.html"
-          ]
         <*> (strOption . mconcat)
           [ short 'o',
             long "output-path",
             metavar "OUTPUT_PATH",
             value defaultOutputPath
           ]
-        <*> (option (Just <$> auto) . mconcat)
-          [ short 'd',
-            long "debug-limit",
-            metavar "N",
-            value Nothing
-          ]
 
 main :: IO ()
 main = do
   Config {..} <- execParser configParserInfo
-  packageToOps <- extractHoogleInfo cfgHoogleDatabasePath
+  hackageInfo' <- extractHoogleInfo cfgHoogleDatabasePath
-  packageToPop <- extractHackageInfo cfgHackageDatabasePath
-  let (packageToOps', packageToPop') = case cfgDebugLimit of
-        Nothing -> (packageToOps, packageToPop)
-        Just n ->
-          ( limitMap n <$> limitMap n packageToOps,
-            limitMap n packageToPop
-          )
   BL.writeFile cfgOutputPath . Binary.runPut . Binary.put $
-    HackageInfo packageToOps' packageToPop'
+    HackageInfo hackageInfo'

fixity-tests/.ormolu

@@ -1,2 +1,2 @@
 infixr 8 .=
-infixr 5 #
+infixr 5 #, :>

fixity-tests/default.nix

@@ -13,15 +13,17 @@
       cp test-0-input.hs test-0-no-extra-info.hs
       ormolu --check-idempotence --mode inplace --no-cabal test-0-no-extra-info.hs
       cp test-0-input.hs test-0-with-fixity-info-manual.hs
-      ormolu --check-idempotence --mode inplace --no-cabal --fixity 'infixr 8 .=' test-0-with-fixity-info-manual.hs
+      ormolu --check-idempotence --mode inplace --no-cabal --fixity 'infixr 8 .=' --fixity 'infixr 5 :>' test-0-with-fixity-info-manual.hs
       cp test-0-input.hs test-0-with-fixity-info-dotormolu.hs
-      ormolu --check-idempotence --mode inplace test-0-with-fixity-info-dotormolu.hs
+      ormolu --check-idempotence --mode inplace -p base test-0-with-fixity-info-dotormolu.hs
       cp test-1-input.hs test-1-no-extra-info.hs
       ormolu --check-idempotence --mode inplace --no-cabal test-1-no-extra-info.hs
       cp test-1-input.hs test-1-with-fixity-info-manual.hs
       ormolu --check-idempotence --mode inplace --no-cabal --fixity 'infixr 8 .=' --fixity 'infixr 5 #' test-1-with-fixity-info-manual.hs
       cp test-1-input.hs test-1-with-fixity-info-dotormolu.hs
-      ormolu --check-idempotence --mode inplace test-1-with-fixity-info-dotormolu.hs
+      ormolu --check-idempotence --mode inplace -p base test-1-with-fixity-info-dotormolu.hs
+      cp test-1-input.hs test-1-with-fixity-info-weird-overwrite.hs
+      ormolu --check-idempotence --mode inplace -p base --fixity "infixr 5 $" test-1-with-fixity-info-weird-overwrite.hs
     '';
     checkPhase = ''
       echo test-0-no-extra-info.hs
@@ -36,6 +38,8 @@
       diff --color=always test-1-with-fixity-info-expected.hs test-1-with-fixity-info-manual.hs
       echo test-1-with-fixity-info-dotormolu.hs
       diff --color=always test-1-with-fixity-info-expected.hs test-1-with-fixity-info-dotormolu.hs
+      echo test-1-with-fixity-info-weird-overwrite.hs
+      diff --color=always test-1-with-fixity-info-weird-overwrite-expected.hs test-1-with-fixity-info-weird-overwrite.hs
     '';
     installPhase = ''
       mkdir "$out"

fixity-tests/test-0-input.hs

@@ -1,7 +1,7 @@
 instance A.ToJSON UpdateTable where
     toJSON a = A.object
         $ "TableName" .= updateTableName a
-        : "ProvisionedThroughput" .= updateProvisionedThroughput a
+        :> "ProvisionedThroughput" .= updateProvisionedThroughput a
-        : case updateGlobalSecondaryIndexUpdates a of
+        :> case updateGlobalSecondaryIndexUpdates a of
             [] -> []
             l -> [ "GlobalSecondaryIndexUpdates" .= l ]

fixity-tests/test-0-no-extra-info-expected.hs

@@ -3,8 +3,8 @@ instance A.ToJSON UpdateTable where
     A.object $
       "TableName"
         .= updateTableName a
-        : "ProvisionedThroughput"
+        :> "ProvisionedThroughput"
         .= updateProvisionedThroughput a
-        : case updateGlobalSecondaryIndexUpdates a of
+        :> case updateGlobalSecondaryIndexUpdates a of
           [] -> []
           l -> ["GlobalSecondaryIndexUpdates" .= l]

fixity-tests/test-0-with-fixity-info-expected.hs

@@ -2,7 +2,7 @@ instance A.ToJSON UpdateTable where
   toJSON a =
     A.object $
       "TableName" .= updateTableName a
-        : "ProvisionedThroughput" .= updateProvisionedThroughput a
+        :> "ProvisionedThroughput" .= updateProvisionedThroughput a
-        : case updateGlobalSecondaryIndexUpdates a of
+        :> case updateGlobalSecondaryIndexUpdates a of
           [] -> []
           l -> ["GlobalSecondaryIndexUpdates" .= l]

fixity-tests/test-1-with-fixity-info-weird-overwrite-expected.hs

@@ -0,0 +1,9 @@
+lenses =
+  Just
+    $ M.fromList
+    $ "type" .= ("user.connection" :: Text)
+    # "connection" .= uc
+    # "user" .= case name of
+      Just n -> Just $ object ["name" .= n]
+      Nothing -> Nothing
+    # []

ormolu-live/app/Main.hs

@@ -24,7 +24,6 @@ import Ormolu
 import Ormolu.Config qualified as O
 import Ormolu.Exception qualified as O
 import Ormolu.Fixity qualified as O
-import Ormolu.Fixity.Internal qualified as O
 import Ormolu.Parser qualified as O
 import Ormolu.Parser.Result as O
 import Ormolu.Terminal qualified as O
@@ -56,7 +55,7 @@ foreign export ccall evaluateFixityInfo :: IO ()
 
 evaluateFixityInfo :: IO ()
 evaluateFixityInfo =
-  void . E.evaluate $ force (O.packageToOps, O.packageToPopularity)
+  void . E.evaluate $ force O.hackageInfo
 
 -- actual logic
 
@@ -97,8 +96,9 @@ format Input {..} = do
 
 prettyAST :: Config RegionIndices -> Text -> IO Text
 prettyAST cfg src = do
+  let pfixityMap = O.packageFixityMap O.defaultDependencies
   (_, eSnippets) <-
-    O.parseModule cfgWithDeltas (O.LazyFixityMap []) "<input>" src
+    O.parseModule cfgWithDeltas pfixityMap "<input>" src
   pure case eSnippets of
     Left e -> T.pack $ show e
     Right snippets -> T.unlines $ showSnippet <$> snippets

ormolu.cabal

@@ -78,6 +78,7 @@ library
         Ormolu.Printer.Meat.Type
         Ormolu.Printer.Operators
         Ormolu.Fixity
+        Ormolu.Fixity.Imports
         Ormolu.Fixity.Internal
         Ormolu.Fixity.Parser
         Ormolu.Fixity.Printer
@@ -161,7 +162,7 @@ test-suite tests
         Ormolu.Diff.TextSpec
         Ormolu.Fixity.ParserSpec
         Ormolu.Fixity.PrinterSpec
-        Ormolu.HackageInfoSpec
+        Ormolu.FixitySpec
         Ormolu.OpTreeSpec
         Ormolu.Parser.OptionsSpec
         Ormolu.Parser.ParseFailureSpec
@@ -179,6 +180,7 @@ test-suite tests
         ghc-lib-parser >=9.6 && <9.7,
         hspec >=2.0 && <3.0,
         hspec-megaparsec >=2.2,
+        megaparsec >=9.0,
         ormolu,
         path >=0.6 && <0.10,
         path-io >=1.4.2 && <2.0,

region-tests/default.nix

@@ -13,19 +13,19 @@
       cp src.hs result-all-implicit.hs
       ormolu --check-idempotence --mode inplace result-all-implicit.hs
       cp src.hs result-all-explicit.hs
-      ormolu --check-idempotence --mode inplace --start-line 1 --end-line 18 result-all-explicit.hs
+      ormolu --check-idempotence --mode inplace --start-line 1 --end-line 23 result-all-explicit.hs
       cp src.hs result-only-start.hs
       ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs
       cp src.hs result-only-end.hs
-      ormolu --check-idempotence --mode inplace --end-line 18 result-only-end.hs
+      ormolu --check-idempotence --mode inplace --end-line 23 result-only-end.hs
-      cp src.hs result-6-7.hs
+      cp src.hs result-8-9.hs
-      ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs
+      ormolu --check-idempotence --mode inplace --start-line 8 --end-line 9 result-8-9.hs
-      cp src.hs result-6-8.hs
+      cp src.hs result-8-10.hs
-      ormolu --check-idempotence --mode inplace --start-line 6 --end-line 8 result-6-8.hs
+      ormolu --check-idempotence --mode inplace --start-line 8 --end-line 10 result-8-10.hs
-      cp src.hs result-9-12.hs
+      cp src.hs result-11-14.hs
-      ormolu --check-idempotence --mode inplace --start-line 9 --end-line 12 result-9-12.hs
+      ormolu --check-idempotence --mode inplace --start-line 11 --end-line 14 result-11-14.hs
-      cp src.hs result-17-18.hs
+      cp src.hs result-19-23.hs
-      ormolu --check-idempotence --mode inplace --start-line 17 --end-line 18 result-17-18.hs
+      ormolu --check-idempotence --mode inplace --start-line 19 --end-line 23 result-19-23.hs
     '';
     checkPhase = ''
       echo result-all-implicit.hs
@@ -36,14 +36,14 @@
       diff --color=always expected-result-all.hs result-only-start.hs
       echo result-only-end.hs
       diff --color=always expected-result-all.hs result-only-end.hs
-      echo result-6-7.hs
+      echo result-8-9.hs
-      diff --color=always expected-result-6-7.hs result-6-7.hs
+      diff --color=always expected-result-8-9.hs result-8-9.hs
-      echo result-6-8.hs
+      echo result-8-10.hs
-      diff --color=always expected-result-6-8.hs result-6-8.hs
+      diff --color=always expected-result-8-10.hs result-8-10.hs
-      echo result-9-12.hs
+      echo result-11-14.hs
-      diff --color=always expected-result-9-12.hs result-9-12.hs
+      diff --color=always expected-result-11-14.hs result-11-14.hs
-      echo result-17-18.hs
+      echo result-19-23.hs
-      diff --color=always expected-result-17-18.hs result-17-18.hs
+      diff --color=always expected-result-19-23.hs result-19-23.hs
     '';
     installPhase = ''
       mkdir "$out"

region-tests/expected-result-11-14.hs

@@ -3,6 +3,8 @@
 module Foo (
   foo, bar, baz) where
 
+import Control.Category
+
 foo :: Int
 foo  =  5
 
@@ -14,4 +16,7 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1   + 2
+    gege = 1
+       >>> zeze +
+           2
+           >>> nona

region-tests/expected-result-19-23.hs

@@ -3,6 +3,8 @@
 module Foo (
   foo, bar, baz) where
 
+import Control.Category
+
 foo :: Int
 foo  =  5
 
@@ -14,4 +16,8 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1 + 2
+    gege =
+      1
+        >>> zeze
+          + 2
+        >>> nona

region-tests/expected-result-8-10.hs

@@ -3,6 +3,8 @@
 module Foo (
   foo, bar, baz) where
 
+import Control.Category
+
 foo :: Int
 foo = 5
 
@@ -14,4 +16,7 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1   + 2
+    gege = 1
+       >>> zeze +
+           2
+           >>> nona

region-tests/expected-result-8-9.hs

@@ -3,6 +3,8 @@
 module Foo (
   foo, bar, baz) where
 
+import Control.Category
+
 foo :: Int
 foo = 5
 
@@ -14,4 +16,7 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1   + 2
+    gege = 1
+       >>> zeze +
+           2
+           >>> nona

region-tests/expected-result-all.hs

@@ -7,6 +7,8 @@ module Foo
   )
 where
 
+import Control.Category
+
 foo :: Int
 foo = 5
 
@@ -18,4 +20,8 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1 + 2
+    gege =
+      1
+        >>> zeze
+          + 2
+        >>> nona

region-tests/src.hs

@@ -3,6 +3,8 @@
 module Foo (
   foo, bar, baz) where
 
+import Control.Category
+
 foo :: Int
 foo  =  5
 
@@ -14,4 +16,7 @@ bar = \case
 baz :: Int -> Int
 baz = gege
   where
-    gege = 1   + 2
+    gege = 1
+       >>> zeze +
+           2
+           >>> nona

src/Ormolu.hs

@@ -25,7 +25,7 @@ module Ormolu
     CabalUtils.getCabalInfoForSourceFile,
 
     -- * Fixity overrides
-    FixityMap,
+    FixityOverrides,
     getFixityOverridesForSourceFile,
 
     -- * Working with exceptions
@@ -38,6 +38,7 @@ import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -85,11 +86,7 @@ ormolu cfgWithIndices path originalInput = do
   let totalLines = length (T.lines originalInput)
       cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices
       fixityMap =
-        -- It is important to keep all arguments (but last) of
+        packageFixityMap
-        -- 'buildFixityMap' constant (such as 'defaultStrategyThreshold'),
-        -- otherwise it is going to break memoization.
-        buildFixityMap
-          defaultStrategyThreshold
           (cfgDependencies cfg) -- memoized on the set of dependencies
   (warnings, result0) <-
     parseModule' cfg fixityMap OrmoluParsingFailed path originalInput
@@ -180,7 +177,7 @@ refineConfig ::
   -- | Cabal info for the file, if available
   Maybe CabalUtils.CabalInfo ->
   -- | Fixity overrides, if available
-  Maybe FixityMap ->
+  Maybe FixityOverrides ->
   -- | 'Config' to refine
   Config region ->
   -- | Refined 'Config'
@@ -189,23 +186,25 @@ refineConfig sourceType mcabalInfo mfixityOverrides rawConfig =
   rawConfig
     { cfgDynOptions = cfgDynOptions rawConfig ++ dynOptsFromCabal,
       cfgFixityOverrides =
-        Map.unionWith (<>) (cfgFixityOverrides rawConfig) fixityOverrides,
+        FixityOverrides $
+          Map.union
+            (unFixityOverrides fixityOverrides)
+            (unFixityOverrides (cfgFixityOverrides rawConfig)),
       cfgDependencies =
         Set.union (cfgDependencies rawConfig) depsFromCabal,
       cfgSourceType = sourceType
     }
   where
-    fixityOverrides =
+    fixityOverrides = fromMaybe (FixityOverrides Map.empty) mfixityOverrides
-      case mfixityOverrides of
-        Nothing -> Map.empty
-        Just x -> x
     (dynOptsFromCabal, depsFromCabal) =
       case mcabalInfo of
-        Nothing -> ([], Set.empty)
+        Nothing ->
+          -- If no cabal info is provided, assume base as a dependency by
+          -- default.
+          ([], defaultDependencies)
         Just CabalUtils.CabalInfo {..} ->
           -- It makes sense to take into account the operator info for the
-          -- package itself if we know it, as if it were its own
+          -- package itself if we know it, as if it were its own dependency.
-          -- dependency.
           (ciDynOpts, Set.insert ciPackageName ciDependencies)
 
 ----------------------------------------------------------------------------
@@ -217,7 +216,7 @@ parseModule' ::
   -- | Ormolu configuration
   Config RegionDeltas ->
   -- | Fixity Map for operators
-  LazyFixityMap ->
+  PackageFixityMap ->
   -- | How to obtain 'OrmoluException' to throw when parsing fails
   (SrcSpan -> String -> OrmoluException) ->
   -- | File name to use in errors

src/Ormolu/Config.hs

@@ -20,7 +20,7 @@ import Data.Set qualified as Set
 import Distribution.Types.PackageName (PackageName)
 import GHC.Generics (Generic)
 import GHC.Types.SrcLoc qualified as GHC
-import Ormolu.Fixity (FixityMap)
+import Ormolu.Fixity (FixityOverrides (..))
 import Ormolu.Terminal (ColorMode (..))
 
 -- | Type of sources that can be formatted by Ormolu.
@@ -36,7 +36,7 @@ data Config region = Config
   { -- | Dynamic options to pass to GHC parser
     cfgDynOptions :: ![DynOption],
     -- | Fixity overrides
-    cfgFixityOverrides :: FixityMap,
+    cfgFixityOverrides :: FixityOverrides,
     -- | Known dependencies, if any
     cfgDependencies :: !(Set PackageName),
     -- | Do formatting faster but without automatic detection of defects
@@ -78,7 +78,7 @@ defaultConfig :: Config RegionIndices
 defaultConfig =
   Config
     { cfgDynOptions = [],
-      cfgFixityOverrides = Map.empty,
+      cfgFixityOverrides = FixityOverrides Map.empty,
       cfgDependencies = Set.empty,
       cfgUnsafe = False,
       cfgDebug = False,

src/Ormolu/Fixity.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | Definitions for fixity analysis.
@@ -12,34 +12,36 @@ module Ormolu.Fixity
     occOpName,
     FixityDirection (..),
     FixityInfo (..),
-    FixityMap,
-    LazyFixityMap,
-    lookupFixity,
-    HackageInfo (..),
-    defaultStrategyThreshold,
     defaultFixityInfo,
-    buildFixityMap,
+    FixityApproximation (..),
-    buildFixityMap',
+    defaultFixityApproximation,
-    bootPackages,
+    FixityOverrides (..),
-    packageToOps,
+    PackageFixityMap (..),
-    packageToPopularity,
+    ModuleFixityMap (..),
+    inferFixity,
+    HackageInfo (..),
+    hackageInfo,
+    defaultDependencies,
+    packageFixityMap,
+    packageFixityMap',
+    moduleFixityMap,
+    applyFixityOverrides,
   )
 where
 
 import Data.Binary qualified as Binary
 import Data.Binary.Get qualified as Binary
 import Data.ByteString.Lazy qualified as BL
-import Data.Foldable (foldl')
+import Data.List.NonEmpty (NonEmpty)
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
-import Data.Maybe (fromMaybe)
 import Data.MemoTrie (memo)
-import Data.Semigroup (sconcat)
 import Data.Set (Set)
 import Data.Set qualified as Set
+import Distribution.ModuleName (ModuleName)
 import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
+import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..))
+import Ormolu.Fixity.Imports (FixityImport (..))
 import Ormolu.Fixity.Internal
 #if BUNDLE_FIXITIES
 import Data.FileEmbed (embedFile)
@@ -48,210 +50,131 @@ import qualified Data.ByteString as B
 import System.IO.Unsafe (unsafePerformIO)
 #endif
 
-packageToOps :: Map PackageName FixityMap
+-- | The built-in 'HackageInfo' used by Ormolu.
-packageToPopularity :: Map PackageName Int
+hackageInfo :: HackageInfo
 #if BUNDLE_FIXITIES
-HackageInfo packageToOps packageToPopularity =
+hackageInfo =
   Binary.runGet Binary.get $
     BL.fromStrict $(embedFile "extract-hackage-info/hackage-info.bin")
 #else
 -- The GHC WASM backend does not yet support Template Haskell, so we instead
 -- pass in the encoded fixity DB via pre-initialization with Wizer.
-HackageInfo packageToOps packageToPopularity =
+hackageInfo =
   unsafePerformIO $
     Binary.runGet Binary.get . BL.fromStrict <$> B.readFile "hackage-info.bin"
-{-# NOINLINE packageToOps #-}
+{-# NOINLINE hackageInfo #-}
-{-# NOINLINE packageToPopularity #-}
 #endif
 
--- | List of packages shipped with GHC, for which the download count from
+-- | Default set of packages to assume as dependencies e.g. when no Cabal
--- Hackage does not reflect their high popularity.
+-- file is found or taken into consideration.
--- See https://github.com/tweag/ormolu/pull/830#issuecomment-986609572.
+defaultDependencies :: Set PackageName
--- "base" is not is this list, because it is already whitelisted
+defaultDependencies = Set.singleton (mkPackageName "base")
--- by buildFixityMap'.
-bootPackages :: Set PackageName
-bootPackages =
-  Set.fromList
-    [ "array",
-      "binary",
-      "bytestring",
-      "containers",
-      "deepseq",
-      "directory",
-      "exceptions",
-      "filepath",
-      "ghc-binary",
-      "mtl",
-      "parsec",
-      "process",
-      "stm",
-      "template-haskell",
-      "terminfo",
-      "text",
-      "time",
-      "transformers",
-      "unix",
-      "Win32"
-    ]
 
--- | The default value for the popularity ratio threshold, after which a
+-- | Compute the fixity map that is specific to the package we are formatting.
--- very popular definition from packageToOps will completely rule out
+packageFixityMap ::
--- conflicting definitions instead of being merged with them.
+  -- | Set of packages to select
-defaultStrategyThreshold :: Float
+  Set PackageName ->
-defaultStrategyThreshold = 0.9
+  -- | Package fixity map
+  PackageFixityMap
+packageFixityMap = packageFixityMap' hackageInfo
 
--- | Build a fixity map using the given popularity threshold and a list of
+-- | The same as 'packageFixityMap', except this specific version of the
--- cabal dependencies. Dependencies from the list have higher priority than
+-- function allows the user to specify 'HackageInfo' used to build the final
--- other packages.
+-- fixity map.
-buildFixityMap ::
+packageFixityMap' ::
-  -- | Popularity ratio threshold, after which a very popular package will
+  -- | Hackage info
-  -- completely rule out conflicting definitions coming from other packages
+  HackageInfo ->
-  -- instead of being merged with them
+  -- | Set of packages to select
-  Float ->
-  -- | Explicitly known dependencies
   Set PackageName ->
-  -- | Resulting map
+  -- | Package fixity map
-  LazyFixityMap
+  PackageFixityMap
-buildFixityMap = buildFixityMap' packageToOps packageToPopularity bootPackages
+packageFixityMap' (HackageInfo m) = memoSet $ \dependencies ->
+  -- The core idea here is to transform:
+  --
+  -- Map PackageName (Map ModuleName (Map OpName FixityInfo))
+  --
+  -- into
+  --
+  -- Map OpName [(PackageName, ModuleName, FixityInfo)]
+  --
+  -- which we accomplish by turning 'Map's into tuples with 'Map.toList' and
+  -- then flattening them with 'flatten :: [(a, [b])] -> [(a, b)]'.
+  --
+  -- The target type results from the need to be able to quickly index by
+  -- the operator name when we do fixity resolution later.
+  PackageFixityMap
+    . Map.mapMaybe NE.nonEmpty
+    . Map.fromListWith (<>)
+    . fmap rearrange
+    . flatten
+    . Map.toList
+    . Map.map (flatten . Map.toList . Map.map Map.toList)
+    $ Map.restrictKeys m dependencies
+  where
+    rearrange (packageName, (moduleName, (opName, fixityInfo))) =
+      (opName, [(packageName, moduleName, fixityInfo)])
+    flatten xs = do
+      (k, vs) <- xs
+      v <- vs
+      return (k, v)
 
--- | Build a fixity map using the given popularity threshold and a list of
+-- | Compute the fixity map that is specific to the module we are formatting.
--- cabal dependencies. Dependencies from the list have higher priority than
+moduleFixityMap ::
--- other packages. This specific version of the function allows the user to
+  -- | Fixity information selected from dependencies of this package
--- specify the package databases used to build the final fixity map.
+  PackageFixityMap ->
-buildFixityMap' ::
+  -- | A simplified representation of the import list in this module
-  -- | Map from package to fixity map for operators defined in this package
+  [FixityImport] ->
-  Map PackageName FixityMap ->
+  -- | Fixity map specific to this module
-  -- | Map from package to popularity
+  ModuleFixityMap
-  Map PackageName Int ->
+moduleFixityMap (PackageFixityMap m) imports =
-  -- | Higher priority packages
+  ModuleFixityMap $
-  Set PackageName ->
+    Map.insert
-  -- | Popularity ratio threshold, after which a very popular package will
+      ":"
-  -- completely rule out conflicting definitions coming from other packages
+      (Given colonFixityInfo)
-  -- instead of being merged with them
+      (Map.map FromModuleImports (Map.mapMaybeWithKey select m))
-  Float ->
+  where
-  -- | Explicitly known dependencies
+    select ::
-  Set PackageName ->
+      OpName ->
-  -- | Resulting map
+      NonEmpty (PackageName, ModuleName, FixityInfo) ->
-  LazyFixityMap
+      Maybe (NonEmpty (FixityQualification, FixityInfo))
-buildFixityMap'
+    select opName =
-  operatorMap
+      let f (packageName, moduleName, fixityInfo) =
-  popularityMap
+            (,fixityInfo)
-  higherPriorityPackages
+              <$> resolveThroughImports packageName moduleName opName
-  strategyThreshold = memoSet $ \dependencies ->
+       in NE.nonEmpty . concatMap f
-    let baseFixityMap =
+    resolveThroughImports ::
-          Map.insert ":" colonFixityInfo $
+      PackageName ->
-            fromMaybe Map.empty $
+      ModuleName ->
-              Map.lookup "base" operatorMap
+      OpName ->
-        cabalFixityMap =
+      [FixityQualification]
-          mergeAll (buildPackageFixityMap <$> Set.toList dependencies)
+    resolveThroughImports packageName moduleName opName =
-        higherPriorityFixityMap =
+      let doesImportMatch FixityImport {..} =
-          mergeAll (buildPackageFixityMap <$> Set.toList higherPriorityPackages)
+            let packageMatches =
-        remainingFixityMap =
+                  case fimportPackage of
-          mergeFixityMaps
+                    Nothing -> True
-            popularityMap
+                    Just p -> p == packageName
-            strategyThreshold
+                moduleMatches =
-            (buildPackageFixityMap <$> Set.toList remainingPackages)
+                  fimportModuleName == moduleName
-        remainingPackages =
+                opMatches = case fimportList of
-          Map.keysSet operatorMap
+                  Nothing -> True
-            `Set.difference` Set.union dependencies higherPriorityPackages
+                  Just (Exactly, xs) -> opName `elem` xs
-        buildPackageFixityMap packageName =
+                  Just (EverythingBut, xs) -> opName `notElem` xs
-          ( packageName,
+             in packageMatches && moduleMatches && opMatches
-            fromMaybe Map.empty $
+       in fimportQualified <$> filter doesImportMatch imports
-              Map.lookup packageName operatorMap
+
-          )
+-- | Apply fixity overrides.
-        -- we need a threshold > 1.0 so that no dependency can reach the
+applyFixityOverrides ::
-        -- threshold
+  -- | User overrides
-        mergeAll = mergeFixityMaps Map.empty 10.0
+  FixityOverrides ->
-     in LazyFixityMap
+  -- | Module fixity map
-          [ baseFixityMap,
+  ModuleFixityMap ->
-            cabalFixityMap,
+  -- | Module fixity map with overrides applied
-            higherPriorityFixityMap,
+  ModuleFixityMap
-            remainingFixityMap
+applyFixityOverrides (FixityOverrides o) (ModuleFixityMap m) =
-          ]
+  ModuleFixityMap (Map.union (Map.map Given o) m)
 
 memoSet :: (Set PackageName -> v) -> Set PackageName -> v
-memoSet f = memo (f . Set.fromAscList . fmap mkPackageName) . fmap unPackageName . Set.toAscList
+memoSet f =
-
+  memo (f . Set.fromAscList . fmap mkPackageName)
--- | Merge a list of individual fixity maps, coming from different packages.
+    . fmap unPackageName
--- Package popularities and the given threshold are used to choose between
+    . Set.toAscList
--- the "keep best only" (>= threshold) and "merge all" (< threshold)
--- strategies when conflicting definitions are encountered for an operator.
-mergeFixityMaps ::
-  -- | Map from package name to 30-days download count
-  Map PackageName Int ->
-  -- | Popularity ratio threshold
-  Float ->
-  -- | List of (package name, package fixity map) to merge
-  [(PackageName, FixityMap)] ->
-  -- | Resulting fixity map
-  FixityMap
-mergeFixityMaps popularityMap threshold packageMaps =
-  Map.map
-    (useThreshold threshold . NE.fromList . Map.toList)
-    scoredMap
-  where
-    scoredMap = Map.map getScores opFixityMap
-    -- when we encounter a duplicate key (op1) in the unionsWith operation,
-    -- we have
-    --   op1 -map-> {definitions1 -map-> originPackages}
-    --   op1 -map-> {definitions2 -map-> originPackages}
-    -- so we merge the keys (which have the type:
-    -- Map FixityInfo (NonEmpty PackageName))
-    -- using 'Map.unionWith (<>)', to "concatenate" the list of
-    -- definitions for this operator, and to also "concatenate" origin
-    -- packages if a same definition is found in both maps
-    opFixityMap =
-      Map.unionsWith
-        (Map.unionWith (<>))
-        (opFixityMapFrom <$> packageMaps)
-    useThreshold ::
-      -- Threshold
-      Float ->
-      -- List of conflicting (definition, score) for a given operator
-      NonEmpty (FixityInfo, Int) ->
-      -- Resulting fixity, using the specified threshold to choose between
-      -- strategy "keep best only" and "merge all"
-      FixityInfo
-    useThreshold t fixScores =
-      if toFloat maxScore / toFloat sumScores >= t
-        then sconcat . fmap fst $ maxs -- merge potential ex-aequo winners
-        else sconcat . fmap fst $ fixScores
-      where
-        toFloat x = fromIntegral x :: Float
-        maxs = maxWith snd fixScores
-        maxScore = snd $ NE.head maxs
-        sumScores = foldl' (+) 0 (snd <$> fixScores)
-    getScores ::
-      -- Map for a given operator associating each of its conflicting
-      -- definitions with the packages that define it
-      Map FixityInfo (NonEmpty PackageName) ->
-      -- Map for a given operator associating each of its conflicting
-      -- definitions with their score (= sum of the popularity of the
-      -- packages that define it)
-      Map FixityInfo Int
-    getScores =
-      Map.map
-        (sum . fmap (fromMaybe 0 . flip Map.lookup popularityMap))
-    opFixityMapFrom ::
-      -- (packageName, package fixity map)
-      (PackageName, FixityMap) ->
-      -- Map associating each operator of the package with a
-      -- {map for a given operator associating each of its definitions with
-      -- the list of packages that define it}
-      -- (this list can only be == [packageName] in the context of this
-      -- function)
-      Map OpName (Map FixityInfo (NonEmpty PackageName))
-    opFixityMapFrom (packageName, opsMap) =
-      Map.map
-        (flip Map.singleton (packageName :| []))
-        opsMap
-    maxWith :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty a
-    maxWith f xs = snd $ foldl' comp (f h, h :| []) t
-      where
-        h :| t = xs
-        comp (fMax, maxs) x =
-          let fX = f x
-           in if
-                | fMax < fX -> (fX, x :| [])
-                | fMax == fX -> (fMax, NE.cons x maxs)
-                | otherwise -> (fMax, maxs)

src/Ormolu/Fixity/Imports.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Simplified representation of the import list for the purposes of fixity
+-- inference.
+module Ormolu.Fixity.Imports
+  ( FixityImport (..),
+    extractFixityImports,
+  )
+where
+
+import Data.Bifunctor (second)
+import Distribution.ModuleName (ModuleName)
+import Distribution.Types.PackageName
+import GHC.Data.FastString qualified as GHC
+import GHC.Hs hiding (ModuleName)
+import GHC.Types.Name.Occurrence
+import GHC.Types.PkgQual (RawPkgQual (..))
+import GHC.Types.SourceText (StringLiteral (..))
+import GHC.Types.SrcLoc
+import Ormolu.Fixity.Internal
+import Ormolu.Utils (ghcModuleNameToCabal)
+
+-- | Simplified info about an import.
+data FixityImport = FixityImport
+  { fimportPackage :: !(Maybe PackageName),
+    fimportModuleName :: !ModuleName,
+    fimportQualified :: !FixityQualification,
+    fimportList :: !(Maybe (ImportListInterpretation, [OpName]))
+  }
+
+-- | Extract 'FixityImport's from the AST.
+extractFixityImports ::
+  [LImportDecl GhcPs] ->
+  [FixityImport]
+extractFixityImports = fmap (extractFixityImport . unLoc)
+
+-- | Extract an individual 'FixityImport'.
+extractFixityImport :: ImportDecl GhcPs -> FixityImport
+extractFixityImport ImportDecl {..} =
+  FixityImport
+    { fimportPackage = case ideclPkgQual of
+        NoRawPkgQual -> Nothing
+        RawPkgQual strLiteral ->
+          Just . mkPackageName . GHC.unpackFS . sl_fs $ strLiteral,
+      fimportModuleName = ideclName',
+      fimportQualified = case (ideclQualified, ideclAs') of
+        (QualifiedPre, Nothing) ->
+          OnlyQualified ideclName'
+        (QualifiedPost, Nothing) ->
+          OnlyQualified ideclName'
+        (QualifiedPre, Just m) -> OnlyQualified m
+        (QualifiedPost, Just m) -> OnlyQualified m
+        (NotQualified, Nothing) ->
+          UnqualifiedAndQualified ideclName'
+        (NotQualified, Just m) ->
+          UnqualifiedAndQualified m,
+      fimportList =
+        fmap
+          (second (concatMap (fmap occOpName . ieToOccNames . unLoc) . unLoc))
+          ideclImportList
+    }
+  where
+    ideclName' = ghcModuleNameToCabal (unLoc ideclName)
+    ideclAs' = ghcModuleNameToCabal . unLoc <$> ideclAs
+
+ieToOccNames :: IE GhcPs -> [OccName]
+ieToOccNames = \case
+  IEVar _ (L _ x) -> [occName x]
+  IEThingAbs _ (L _ x) -> [occName x]
+  IEThingAll _ (L _ x) -> [occName x] -- TODO not quite correct, but how to do better?
+  IEThingWith _ (L _ x) _ xs -> occName x : fmap (occName . unLoc) xs
+  _ -> []

src/Ormolu/Fixity/Internal.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Ormolu.Fixity.Internal
@@ -10,12 +11,17 @@ module Ormolu.Fixity.Internal
     occOpName,
     FixityDirection (..),
     FixityInfo (..),
-    defaultFixityInfo,
     colonFixityInfo,
+    defaultFixityInfo,
+    FixityApproximation (..),
+    defaultFixityApproximation,
     HackageInfo (..),
-    FixityMap,
+    FixityOverrides (..),
-    LazyFixityMap (..),
+    PackageFixityMap (..),
-    lookupFixity,
+    ModuleFixityMap (..),
+    FixityProvenance (..),
+    FixityQualification (..),
+    inferFixity,
   )
 where
 
@@ -23,73 +29,22 @@ import Control.DeepSeq (NFData)
 import Data.Binary (Binary)
 import Data.ByteString.Short (ShortByteString)
 import Data.ByteString.Short qualified as SBS
-import Data.Foldable (asum)
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.String (IsString (..))
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
-import Distribution.Types.PackageName (PackageName)
+import Distribution.ModuleName (ModuleName)
+import Distribution.Types.PackageName
 import GHC.Data.FastString (fs_sbs)
 import GHC.Generics (Generic)
 import GHC.Types.Name (OccName (occNameFS))
-
+import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)
--- | Fixity direction.
+import Ormolu.Utils (ghcModuleNameToCabal)
-data FixityDirection
-  = InfixL
-  | InfixR
-  | InfixN
-  deriving stock (Eq, Ord, Show, Generic)
-  deriving anyclass (Binary, NFData)
-
--- | Fixity information about an infix operator that takes the uncertainty
--- that can arise from conflicting definitions into account.
-data FixityInfo = FixityInfo
-  { -- | Fixity direction if it is known
-    fiDirection :: Maybe FixityDirection,
-    -- | Minimum precedence level found in the (maybe conflicting)
-    -- definitions for the operator (inclusive)
-    fiMinPrecedence :: Int,
-    -- | Maximum precedence level found in the (maybe conflicting)
-    -- definitions for the operator (inclusive)
-    fiMaxPrecedence :: Int
-  }
-  deriving stock (Eq, Ord, Show, Generic)
-  deriving anyclass (Binary, NFData)
-
--- | The lowest level of information we can have about an operator.
-defaultFixityInfo :: FixityInfo
-defaultFixityInfo =
-  FixityInfo
-    { fiDirection = Just InfixL,
-      fiMinPrecedence = 9,
-      fiMaxPrecedence = 9
-    }
-
--- | Fixity info of the built-in colon data constructor.
-colonFixityInfo :: FixityInfo
-colonFixityInfo =
-  FixityInfo
-    { fiDirection = Just InfixR,
-      fiMinPrecedence = 5,
-      fiMaxPrecedence = 5
-    }
-
--- | Gives the ability to merge two (maybe conflicting) definitions for an
--- operator, keeping the higher level of compatible information from both.
-instance Semigroup FixityInfo where
-  FixityInfo {fiDirection = dir1, fiMinPrecedence = min1, fiMaxPrecedence = max1}
-    <> FixityInfo {fiDirection = dir2, fiMinPrecedence = min2, fiMaxPrecedence = max2} =
-      FixityInfo
-        { fiDirection = dir',
-          fiMinPrecedence = min min1 min2,
-          fiMaxPrecedence = max max1 max2
-        }
-      where
-        dir' = case (dir1, dir2) of
-          (Just a, Just b) | a == b -> Just a
-          _ -> Nothing
 
 -- | An operator name.
 newtype OpName = MkOpName
@@ -119,26 +74,134 @@ instance Show OpName where
 instance IsString OpName where
   fromString = OpName . T.pack
 
--- | Map from the operator name to its 'FixityInfo'.
+-- | Fixity direction.
-type FixityMap = Map OpName FixityInfo
+data FixityDirection
+  = InfixL
+  | InfixR
+  | InfixN
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (Binary, NFData)
 
--- | A variant of 'FixityMap', represented as a lazy union of several
+-- | Fixity information about an infix operator. This type provides precise
--- 'FixityMap's.
+-- information as opposed to 'FixityApproximation'.
-newtype LazyFixityMap = LazyFixityMap [FixityMap]
+data FixityInfo = FixityInfo
-  deriving (Show)
+  { -- | Fixity direction
+    fiDirection :: FixityDirection,
+    -- | Precedence
+    fiPrecedence :: Int
+  }
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (Binary, NFData)
 
--- | Lookup a 'FixityInfo' of an operator. This might have drastically
+-- | Fixity info of the built-in colon data constructor.
--- different performance depending on whether this is an "unusual" operator.
+colonFixityInfo :: FixityInfo
-lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
+colonFixityInfo = FixityInfo InfixR 5
-lookupFixity op (LazyFixityMap maps) = asum (Map.lookup op <$> maps)
 
--- | The map of operators declared by each package and the popularity of
+-- | Fixity that is implicitly assumed if no fixity declaration is present.
--- each package, if available.
+defaultFixityInfo :: FixityInfo
-data HackageInfo
+defaultFixityInfo = FixityInfo InfixL 9
-  = HackageInfo
+
-      -- | Map from package name to a map from operator name to its fixity
+-- | Approximation of fixity information that takes the uncertainty that can
-      (Map PackageName FixityMap)
+-- arise from conflicting definitions into account.
-      -- | Map from package name to its 30-days download count from Hackage
+data FixityApproximation = FixityApproximation
-      (Map PackageName Int)
+  { -- | Fixity direction if it is known
+    faDirection :: Maybe FixityDirection,
+    -- | Minimum precedence level found in the (maybe conflicting)
+    -- definitions for the operator (inclusive)
+    faMinPrecedence :: Int,
+    -- | Maximum precedence level found in the (maybe conflicting)
+    -- definitions for the operator (inclusive)
+    faMaxPrecedence :: Int
+  }
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving anyclass (Binary, NFData)
+
+-- | Gives the ability to merge two (maybe conflicting) definitions for an
+-- operator, keeping the higher level of compatible information from both.
+instance Semigroup FixityApproximation where
+  FixityApproximation {faDirection = dir1, faMinPrecedence = min1, faMaxPrecedence = max1}
+    <> FixityApproximation {faDirection = dir2, faMinPrecedence = min2, faMaxPrecedence = max2} =
+      FixityApproximation
+        { faDirection = dir',
+          faMinPrecedence = min min1 min2,
+          faMaxPrecedence = max max1 max2
+        }
+      where
+        dir' = case (dir1, dir2) of
+          (Just a, Just b) | a == b -> Just a
+          _ -> Nothing
+
+-- | The lowest level of information we can have about an operator.
+defaultFixityApproximation :: FixityApproximation
+defaultFixityApproximation = fixityInfoToApproximation defaultFixityInfo
+
+-- | Convert from 'FixityInfo' to 'FixityApproximation'.
+fixityInfoToApproximation :: FixityInfo -> FixityApproximation
+fixityInfoToApproximation FixityInfo {..} =
+  FixityApproximation
+    { faDirection = Just fiDirection,
+      faMinPrecedence = fiPrecedence,
+      faMaxPrecedence = fiPrecedence
+    }
+
+-- | The map of operators declared by each package grouped by module name.
+newtype HackageInfo
+  = HackageInfo (Map PackageName (Map ModuleName (Map OpName FixityInfo)))
   deriving stock (Generic)
-  deriving anyclass (Binary)
+  deriving anyclass (Binary, NFData)
+
+-- | Map from the operator name to its 'FixityInfo'.
+newtype FixityOverrides = FixityOverrides
+  { unFixityOverrides :: Map OpName FixityInfo
+  }
+  deriving stock (Eq, Show)
+
+-- | Fixity information that is specific to a package being formatted. It
+-- requires module-specific imports in order to be usable.
+newtype PackageFixityMap
+  = PackageFixityMap (Map OpName (NonEmpty (PackageName, ModuleName, FixityInfo)))
+  deriving stock (Eq, Show)
+
+-- | Fixity map that takes into account imports in a particular module.
+newtype ModuleFixityMap
+  = ModuleFixityMap (Map OpName FixityProvenance)
+  deriving stock (Eq, Show)
+
+-- | Provenance of fixity info.
+data FixityProvenance
+  = -- | 'FixityInfo' of a built-in operator or provided by a user override.
+    Given FixityInfo
+  | -- | 'FixityInfo' to be inferred from module imports.
+    FromModuleImports (NonEmpty (FixityQualification, FixityInfo))
+  deriving stock (Eq, Show)
+
+-- | Fixity qualification that determines how 'FixityInfo' matches a
+-- particular use of an operator, given whether it is qualified or
+-- unqualified and the module name used.
+data FixityQualification
+  = UnqualifiedAndQualified ModuleName
+  | OnlyQualified ModuleName
+  deriving stock (Eq, Show)
+
+-- | Get a 'FixityApproximation' of an operator.
+inferFixity :: RdrName -> ModuleFixityMap -> FixityApproximation
+inferFixity rdrName (ModuleFixityMap m) =
+  case Map.lookup opName m of
+    Nothing -> defaultFixityApproximation
+    Just (Given fixityInfo) ->
+      fixityInfoToApproximation fixityInfo
+    Just (FromModuleImports xs) ->
+      let isMatching (provenance, _fixityInfo) =
+            case provenance of
+              UnqualifiedAndQualified mn ->
+                maybe True (== mn) moduleName
+              OnlyQualified mn ->
+                maybe False (== mn) moduleName
+       in fromMaybe defaultFixityApproximation
+            . foldMap (Just . fixityInfoToApproximation . snd)
+            $ NE.filter isMatching xs
+  where
+    opName = occOpName (rdrNameOcc rdrName)
+    moduleName = case rdrName of
+      Qual x _ -> Just (ghcModuleNameToCabal x)
+      _ -> Nothing

src/Ormolu/Fixity/Parser.hs

@@ -3,7 +3,7 @@
 
 -- | Parser for fixity maps.
 module Ormolu.Fixity.Parser
-  ( parseFixityMap,
+  ( parseFixityOverrides,
     parseFixityDeclaration,
 
     -- * Raw parsers
@@ -12,6 +12,7 @@ module Ormolu.Fixity.Parser
   )
 where
 
+import Control.Monad (when)
 import Data.Char qualified as Char
 import Data.Map.Strict qualified as Map
 import Data.Text (Text)
@@ -24,15 +25,15 @@ import Text.Megaparsec.Char.Lexer qualified as L
 
 type Parser = Parsec Void Text
 
--- | Parse textual representation of a 'FixityMap'.
+-- | Parse textual representation of 'FixityOverrides'.
-parseFixityMap ::
+parseFixityOverrides ::
   -- | Location of the file we are parsing (only for parse errors)
   FilePath ->
   -- | File contents to parse
   Text ->
   -- | Parse result
-  Either (ParseErrorBundle Text Void) FixityMap
+  Either (ParseErrorBundle Text Void) FixityOverrides
-parseFixityMap = runParser pFixityMap
+parseFixityOverrides = runParser pFixityOverrides
 
 -- | Parse a single self-contained fixity declaration.
 parseFixityDeclaration ::
@@ -42,9 +43,9 @@ parseFixityDeclaration ::
   Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
 parseFixityDeclaration = runParser (pFixity <* eof) ""
 
-pFixityMap :: Parser FixityMap
+pFixityOverrides :: Parser FixityOverrides
-pFixityMap =
+pFixityOverrides =
-  Map.fromListWith (<>) . mconcat
+  FixityOverrides . Map.fromList . mconcat
     <$> many (pFixity <* eol <* hidden space)
     <* eof
 
@@ -53,10 +54,14 @@ pFixityMap =
 -- > infixr 4 +++, >>>
 pFixity :: Parser [(OpName, FixityInfo)]
 pFixity = do
-  fiDirection <- Just <$> pFixityDirection
+  fiDirection <- pFixityDirection
   hidden hspace1
-  fiMinPrecedence <- L.decimal
+  offsetAtPrecedence <- getOffset
-  let fiMaxPrecedence = fiMinPrecedence
+  fiPrecedence <- L.decimal
+  when (fiPrecedence > 9) $
+    region
+      (setErrorOffset offsetAtPrecedence)
+      (fail "precedence should not be greater than 9")
   hidden hspace1
   ops <- sepBy1 pOperator (char ',' >> hidden hspace)
   hidden hspace

src/Ormolu/Fixity/Printer.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
--- | Printer for fixity maps.
+-- | Printer for fixity overrides.
 module Ormolu.Fixity.Printer
-  ( printFixityMap,
+  ( printFixityOverrides,
   )
 where
 
@@ -17,35 +17,24 @@ import Data.Text.Lazy.Builder qualified as B
 import Data.Text.Lazy.Builder.Int qualified as B
 import Ormolu.Fixity
 
--- | Print out a textual representation of a 'FixityMap'.
+-- | Print out a textual representation of 'FixityOverrides'.
-printFixityMap :: FixityMap -> Text
+printFixityOverrides :: FixityOverrides -> Text
-printFixityMap =
+printFixityOverrides (FixityOverrides m) =
   TL.toStrict
     . B.toLazyText
     . mconcat
     . fmap renderOne
-    . concatMap decompose
+    $ Map.toList m
-    . Map.toList
   where
-    decompose :: (OpName, FixityInfo) -> [(FixityDirection, Int, OpName)]
+    renderOne :: (OpName, FixityInfo) -> Builder
-    decompose (operator, FixityInfo {..}) =
+    renderOne (OpName operator, FixityInfo {..}) =
-      let forDirection dir =
-            (dir, fiMinPrecedence, operator)
-              : [ (dir, fiMaxPrecedence, operator)
-                  | fiMinPrecedence /= fiMaxPrecedence
-                ]
-       in case fiDirection of
-            Nothing -> concatMap forDirection [InfixL, InfixR]
-            Just dir -> forDirection dir
-    renderOne :: (FixityDirection, Int, OpName) -> Builder
-    renderOne (fixityDirection, n, OpName operator) =
       mconcat
-        [ case fixityDirection of
+        [ case fiDirection of
             InfixL -> "infixl"
             InfixR -> "infixr"
             InfixN -> "infix",
           " ",
-          B.decimal n,
+          B.decimal fiPrecedence,
           " ",
           if isTickedOperator operator
             then "`" <> B.fromText operator <> "`"

src/Ormolu/Parser.hs

@@ -18,31 +18,38 @@ import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.IO.Class
 import Data.Char (isSpace)
 import Data.Functor
-import Data.Generics
+import Data.Generics hiding (orElse)
 import Data.List qualified as L
 import Data.List.NonEmpty qualified as NE
 import Data.Text (Text)
+import GHC.Builtin.Names (mAIN_NAME)
 import GHC.Data.Bag (bagToList)
 import GHC.Data.EnumSet qualified as EnumSet
 import GHC.Data.FastString qualified as GHC
+import GHC.Data.Maybe (orElse)
+import GHC.Data.StringBuffer (StringBuffer)
 import GHC.Driver.CmdLine qualified as GHC
 import GHC.Driver.Config.Parser (initParserOpts)
+import GHC.Driver.Errors.Types qualified as GHC
 import GHC.Driver.Session as GHC
 import GHC.DynFlags (baseDynFlags)
 import GHC.Hs hiding (UnicodeSyntax)
 import GHC.LanguageExtensions.Type (Extension (..))
 import GHC.Parser qualified as GHC
+import GHC.Parser.Annotation qualified as GHC
 import GHC.Parser.Header qualified as GHC
 import GHC.Parser.Lexer qualified as GHC
-import GHC.Types.Error (NoDiagnosticOpts (..), getMessages)
+import GHC.Types.Error qualified as GHC
-import GHC.Types.SourceError qualified as GHC (handleSourceError)
+import GHC.Types.SourceError qualified as GHC
 import GHC.Types.SrcLoc
 import GHC.Utils.Error
+import GHC.Utils.Exception (ExceptionMonad)
 import GHC.Utils.Outputable (defaultSDocContext)
 import GHC.Utils.Panic qualified as GHC
 import Ormolu.Config
 import Ormolu.Exception
-import Ormolu.Fixity (LazyFixityMap)
+import Ormolu.Fixity hiding (packageFixityMap)
+import Ormolu.Fixity.Imports (extractFixityImports)
 import Ormolu.Imports (normalizeImports)
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
@@ -50,13 +57,13 @@ import Ormolu.Processing.Common
 import Ormolu.Processing.Preprocess
 import Ormolu.Utils (incSpanLine, showOutputable, textToStringBuffer)
 
--- | Parse a complete module from string.
+-- | Parse a complete module from 'Text'.
 parseModule ::
   (MonadIO m) =>
   -- | Ormolu configuration
   Config RegionDeltas ->
-  -- | Fixity map to include in the resulting 'ParseResult's
+  -- | Package fixity map
-  LazyFixityMap ->
+  PackageFixityMap ->
   -- | File name (only for source location annotations)
   FilePath ->
   -- | Input for parser
@@ -65,7 +72,7 @@ parseModule ::
     ( [GHC.Warn],
       Either (SrcSpan, String) [SourceSnippet]
     )
-parseModule config@Config {..} fixityMap path rawInput = liftIO $ do
+parseModule config@Config {..} packageFixityMap path rawInput = liftIO $ do
   -- It's important that 'setDefaultExts' is done before
   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an
   -- extension that was explicitly disabled in the file.
@@ -74,35 +81,44 @@ parseModule config@Config {..} fixityMap path rawInput = liftIO $ do
           GHC.Opt_Haddock
           (setDefaultExts baseDynFlags)
       extraOpts = dynOptionToLocatedStr <$> cfgDynOptions
-  (warnings, dynFlags) <-
+      rawInputStringBuffer = textToStringBuffer rawInput
-    parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case
+      beginningLoc =
-      Right res -> pure res
-      Left err ->
-        let loc =
         mkSrcSpan
           (mkSrcLoc (GHC.mkFastString path) 1 1)
           (mkSrcLoc (GHC.mkFastString path) 1 1)
-         in throwIO (OrmoluParsingFailed loc err)
+  (warnings, dynFlags) <-
+    parsePragmasIntoDynFlags baseFlags extraOpts path rawInputStringBuffer >>= \case
+      Right res -> pure res
+      Left err -> throwIO (OrmoluParsingFailed beginningLoc err)
   let cppEnabled = EnumSet.member Cpp (GHC.extensionFlags dynFlags)
+      implicitPrelude = EnumSet.member ImplicitPrelude (GHC.extensionFlags dynFlags)
+  fixityImports <-
+    parseImports dynFlags implicitPrelude path rawInputStringBuffer >>= \case
+      Right res -> pure (extractFixityImports res)
+      Left err -> throwIO (OrmoluParsingFailed beginningLoc err)
+  let modFixityMap =
+        applyFixityOverrides
+          cfgFixityOverrides
+          (moduleFixityMap packageFixityMap fixityImports)
   snippets <- runExceptT . forM (preprocess cppEnabled cfgRegion rawInput) $ \case
     Right region ->
       fmap ParsedSnippet . ExceptT $
-        parseModuleSnippet (config $> region) fixityMap dynFlags path rawInput
+        parseModuleSnippet (config $> region) modFixityMap dynFlags path rawInput
     Left raw -> pure $ RawSnippet raw
   pure (warnings, snippets)
 
 parseModuleSnippet ::
   (MonadIO m) =>
   Config RegionDeltas ->
-  LazyFixityMap ->
+  ModuleFixityMap ->
   DynFlags ->
   FilePath ->
   Text ->
   m (Either (SrcSpan, String) ParseResult)
-parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do
+parseModuleSnippet Config {..} modFixityMap dynFlags path rawInput = liftIO $ do
   let (input, indent) = removeIndentation . linesInRegion cfgRegion $ rawInput
   let pStateErrors pstate =
-        let errs = bagToList . getMessages $ GHC.getPsErrorMessages pstate
+        let errs = bagToList . GHC.getMessages $ GHC.getPsErrorMessages pstate
             fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)
             rateSeverity = \case
               SevError -> 1 :: Int
@@ -116,7 +132,7 @@ parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do
                 msg =
                   showOutputable
                     . formatBulleted defaultSDocContext
-                    . diagnosticMessage NoDiagnosticOpts
+                    . diagnosticMessage GHC.NoDiagnosticOpts
                     $ err
          in case L.sortOn (rateSeverity . errMsgSeverity) errs of
               [] -> Nothing
@@ -148,8 +164,7 @@ parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do
                         prPragmas = pragmas,
                         prCommentStream = comments,
                         prExtensions = GHC.extensionFlags dynFlags,
-                        prFixityOverrides = cfgFixityOverrides,
+                        prModuleFixityMap = modFixityMap,
-                        prFixityMap = fixityMap,
                         prIndent = indent
                       }
   return r
@@ -253,6 +268,8 @@ runParser parser flags filename input = GHC.unP parser parseState
 ----------------------------------------------------------------------------
 -- Helpers taken from HLint
 
+-- | Detect pragmas in the given input and return them as a collection of
+-- 'DynFlags'.
 parsePragmasIntoDynFlags ::
   -- | Pre-set 'DynFlags'
   DynFlags ->
@@ -261,14 +278,14 @@ parsePragmasIntoDynFlags ::
   -- | File name (only for source location annotations)
   FilePath ->
   -- | Input for parser
-  Text ->
+  StringBuffer ->
   IO (Either String ([GHC.Warn], DynFlags))
-parsePragmasIntoDynFlags flags extraOpts filepath str =
+parsePragmasIntoDynFlags flags extraOpts filepath input =
-  catchErrors $ do
+  catchGhcErrors $ do
     let (_warnings, fileOpts) =
           GHC.getOptions
             (initParserOpts flags)
-            (textToStringBuffer str)
+            input
             filepath
     (flags', leftovers, warnings) <-
       parseDynamicFilePragma flags (extraOpts <> fileOpts)
@@ -278,9 +295,45 @@ parsePragmasIntoDynFlags flags extraOpts filepath str =
         throwIO (OrmoluUnrecognizedOpts (unLoc <$> unrecognizedOpts))
     let flags'' = flags' `gopt_set` Opt_KeepRawTokenStream
     return $ Right (warnings, flags'')
+
+-- | Detect the collection of imports used in the given input.
+parseImports ::
+  -- | Pre-set 'DynFlags'
+  DynFlags ->
+  -- | Implicit Prelude?
+  Bool ->
+  -- | File name (only for source location annotations)
+  FilePath ->
+  -- | Input for the parser
+  StringBuffer ->
+  IO (Either String [LImportDecl GhcPs])
+parseImports flags implicitPrelude filepath input =
+  case GHC.unP GHC.parseHeader (GHC.initParserState popts input loc) of
+    GHC.PFailed pst ->
+      return $ Left (showOutputable (GHC.getPsErrorMessages pst))
+    GHC.POk pst rdr_module ->
+      return $
+        let (_warnings, errors) = GHC.getPsMessages pst
+         in if not (isEmptyMessages errors)
+              then Left (showOutputable (GHC.GhcPsMessage <$> errors))
+              else
+                let hsmod = unLoc rdr_module
+                    mmoduleName = hsmodName hsmod
+                    main_loc = srcLocSpan (mkSrcLoc (GHC.mkFastString filepath) 1 1)
+                    mod' = mmoduleName `orElse` L (GHC.noAnnSrcSpan main_loc) mAIN_NAME
+                    explicitImports = hsmodImports hsmod
+                    implicitImports =
+                      GHC.mkPrelImports (unLoc mod') main_loc implicitPrelude explicitImports
+                 in Right (explicitImports ++ implicitImports)
   where
-    catchErrors act =
+    popts = initParserOpts flags
+    loc = mkRealSrcLoc (GHC.mkFastString filepath) 1 1
+
+-- | Catch and report GHC errors.
+catchGhcErrors :: (ExceptionMonad m) => m (Either String a) -> m (Either String a)
+catchGhcErrors m =
   GHC.handleGhcException
     reportErr
-        (GHC.handleSourceError reportErr act)
+    (GHC.handleSourceError reportErr m)
+  where
     reportErr e = return $ Left (show e)

src/Ormolu/Parser/Result.hs

@@ -11,7 +11,7 @@ import GHC.Hs
 import GHC.LanguageExtensions.Type
 import GHC.Types.SrcLoc
 import Ormolu.Config (SourceType)
-import Ormolu.Fixity (FixityMap, LazyFixityMap)
+import Ormolu.Fixity (ModuleFixityMap)
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Pragma (Pragma)
 
@@ -32,10 +32,8 @@ data ParseResult = ParseResult
     prCommentStream :: CommentStream,
     -- | Enabled extensions
     prExtensions :: EnumSet Extension,
-    -- | Fixity overrides
-    prFixityOverrides :: FixityMap,
     -- | Fixity map for operators
-    prFixityMap :: LazyFixityMap,
+    prModuleFixityMap :: ModuleFixityMap,
     -- | Indentation level, can be non-zero in case of region formatting
     prIndent :: Int
   }

src/Ormolu/Printer.hs

@@ -36,6 +36,5 @@ printSnippets = T.concat . fmap printSnippet
             prCommentStream
             prSourceType
             prExtensions
-            prFixityOverrides
+            prModuleFixityMap
-            prFixityMap
       RawSnippet r -> r

src/Ormolu/Printer/Combinators.hs

@@ -22,10 +22,9 @@ module Ormolu.Printer.Combinators
     inci,
     inciIf,
     askSourceType,
-    askFixityOverrides,
+    askModuleFixityMap,
-    encloseLocated,
-    askFixityMap,
     located,
+    encloseLocated,
     located',
     switchLayout,
     Layout (..),

src/Ormolu/Printer/Internal.hs

@@ -17,8 +17,7 @@ module Ormolu.Printer.Internal
     space,
     newline,
     askSourceType,
-    askFixityOverrides,
+    askModuleFixityMap,
-    askFixityMap,
     inci,
     sitcc,
     Layout (..),
@@ -58,6 +57,7 @@ import Control.Monad.Reader
 import Control.Monad.State.Strict
 import Data.Bool (bool)
 import Data.Coerce
+import Data.List (find)
 import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -69,7 +69,7 @@ import GHC.LanguageExtensions.Type
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable (Outputable)
 import Ormolu.Config (SourceType (..))
-import Ormolu.Fixity (FixityMap, LazyFixityMap)
+import Ormolu.Fixity (ModuleFixityMap)
 import Ormolu.Parser.CommentStream
 import Ormolu.Printer.SpanStream
 import Ormolu.Utils (showOutputable)
@@ -98,12 +98,8 @@ data RC = RC
     rcExtensions :: EnumSet Extension,
     -- | Whether the source is a signature or a regular module
     rcSourceType :: SourceType,
-    -- | Fixity map overrides, kept separately because if we parametrized
+    -- | Module fixity map
-    -- 'Ormolu.Fixity.buildFixityMap' by fixity overrides it would break
+    rcModuleFixityMap :: ModuleFixityMap
-    -- memoization
-    rcFixityOverrides :: FixityMap,
-    -- | Fixity map for operators
-    rcFixityMap :: LazyFixityMap
   }
 
 -- | State context of 'R'.
@@ -171,13 +167,11 @@ runR ::
   SourceType ->
   -- | Enabled extensions
   EnumSet Extension ->
-  -- | Fixity overrides
+  -- | Module fixity map
-  FixityMap ->
+  ModuleFixityMap ->
-  -- | Fixity map
-  LazyFixityMap ->
   -- | Resulting rendition
   Text
-runR (R m) sstream cstream sourceType extensions fixityOverrides fixityMap =
+runR (R m) sstream cstream sourceType extensions moduleFixityMap =
   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
   where
     rc =
@@ -188,8 +182,7 @@ runR (R m) sstream cstream sourceType extensions fixityOverrides fixityMap =
           rcCanUseBraces = False,
           rcExtensions = extensions,
           rcSourceType = sourceType,
-          rcFixityOverrides = fixityOverrides,
+          rcModuleFixityMap = moduleFixityMap
-          rcFixityMap = fixityMap
         }
     sc =
       SC
@@ -386,13 +379,9 @@ newlineRaw = R . modify $ \sc ->
 askSourceType :: R SourceType
 askSourceType = R (asks rcSourceType)
 
--- | Retrieve fixity overrides map.
+-- | Retrieve the module fixity map.
-askFixityOverrides :: R FixityMap
+askModuleFixityMap :: R ModuleFixityMap
-askFixityOverrides = R (asks rcFixityOverrides)
+askModuleFixityMap = R (asks rcModuleFixityMap)
-
--- | Retrieve the lazy fixity map.
-askFixityMap :: R LazyFixityMap
-askFixityMap = R (asks rcFixityMap)
 
 inciBy :: Int -> R () -> R ()
 inciBy step (R m) = R (local modRC m)
@@ -514,7 +503,7 @@ getEnclosingSpan ::
   (RealSrcSpan -> Bool) ->
   R (Maybe RealSrcSpan)
 getEnclosingSpan f =
-  listToMaybe . filter f <$> R (asks rcEnclosingSpans)
+  find f <$> R (asks rcEnclosingSpans)
 
 -- | Set 'RealSrcSpan' of enclosing span for the given computation.
 withEnclosingSpan :: RealSrcSpan -> R () -> R ()

src/Ormolu/Printer/Meat/Declaration/OpTree.hs

@@ -115,7 +115,7 @@ p_exprOpTree s t@(OpBranches exprs ops) = do
       couldBeTrailing (prevExpr, opi) =
         -- An operator with fixity InfixR 0, like seq, $, and $ variants,
         -- is required
-        isHardSplitterOp (opiFix opi)
+        isHardSplitterOp (opiFixityApproximation opi)
           -- the LHS must be single-line
           && isOneLineSpan (opTreeLoc prevExpr)
           -- can only happen when a breakpoint would have been added anyway

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -340,12 +340,11 @@ p_hsCmd' isApp s = \case
       breakpoint
       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))
   HsCmdArrForm _ form Infix _ [left, right] -> do
-    fixityOverrides <- askFixityOverrides
+    modFixityMap <- askModuleFixityMap
-    fixityMap <- askFixityMap
     let opTree = OpBranches [cmdOpTree left, cmdOpTree right] [form]
     p_cmdOpTree
       s
-      (reassociateOpTree (getOpName . unLoc) fixityOverrides fixityMap opTree)
+      (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)
   HsCmdArrForm _ _ Infix _ _ -> notImplemented "HsCmdArrForm"
   HsCmdApp _ cmd expr -> do
     located cmd (p_hsCmd' Applicand s)
@@ -663,12 +662,11 @@ p_hsExpr' isApp s = \case
         _ -> return ()
       located (hswc_body a) p_hsType
   OpApp _ x op y -> do
-    fixityOverrides <- askFixityOverrides
+    modFixityMap <- askModuleFixityMap
-    fixityMap <- askFixityMap
     let opTree = OpBranches [exprOpTree x, exprOpTree y] [op]
     p_exprOpTree
       s
-      (reassociateOpTree (getOpName . unLoc) fixityOverrides fixityMap opTree)
+      (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)
   NegApp _ e _ -> do
     negativeLiterals <- isExtensionEnabled NegativeLiterals
     let isLiteral = case unLoc e of

src/Ormolu/Printer/Meat/Type.hs

@@ -110,11 +110,10 @@ p_hsType' multilineArgs = \case
     parensHash N $
       sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs
   HsOpTy _ _ x op y -> do
-    fixityOverrides <- askFixityOverrides
+    modFixityMap <- askModuleFixityMap
-    fixityMap <- askFixityMap
     let opTree = OpBranches [tyOpTree x, tyOpTree y] [op]
     p_tyOpTree
-      (reassociateOpTree (Just . unLoc) fixityOverrides fixityMap opTree)
+      (reassociateOpTree (Just . unLoc) modFixityMap opTree)
   HsParTy _ t ->
     parens N (located t p_hsType)
   HsIParamTy _ n t -> sitcc $ do

src/Ormolu/Printer/Operators.hs

@@ -11,10 +11,7 @@ module Ormolu.Printer.Operators
   )
 where
 
-import Control.Applicative ((<|>))
 import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict qualified as Map
-import Data.Maybe (fromMaybe)
 import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
 import Ormolu.Fixity
@@ -42,13 +39,13 @@ data OpTree ty op
 data OpInfo op = OpInfo
   { -- | The actual operator
     opiOp :: op,
-    -- | Its name, if available. We use 'Maybe OpName' here instead of 'OpName'
+    -- | Its name, if available. We use 'Maybe RdrName' here instead of
-    -- because the name-fetching function received by 'reassociateOpTree'
+    -- 'RdrName' because the name-fetching function received by
-    -- returns a 'Maybe'
+    -- 'reassociateOpTree' returns a 'Maybe'
-    opiName :: Maybe OpName,
+    opiName :: Maybe RdrName,
     -- | Information about the fixity direction and precedence level of the
     -- operator
-    opiFix :: FixityInfo
+    opiFixityApproximation :: FixityApproximation
   }
   deriving (Eq)
 
@@ -57,8 +54,8 @@ data OpInfo op = OpInfo
 -- of equality.
 compareOp :: OpInfo op -> OpInfo op -> Maybe Ordering
 compareOp
-  (OpInfo _ mName1 FixityInfo {fiMinPrecedence = min1, fiMaxPrecedence = max1})
+  (OpInfo _ mName1 FixityApproximation {faMinPrecedence = min1, faMaxPrecedence = max1})
-  (OpInfo _ mName2 FixityInfo {fiMinPrecedence = min2, fiMaxPrecedence = max2}) =
+  (OpInfo _ mName2 FixityApproximation {faMinPrecedence = min2, faMaxPrecedence = max2}) =
     if
       -- Only declare two precedence levels as equal when
       --  * either both precedence levels are precise
@@ -89,48 +86,40 @@ opTreeLoc (OpBranches exprs _) =
 reassociateOpTree ::
   -- | How to get name of an operator
   (op -> Maybe RdrName) ->
-  -- | Fixity overrides
-  FixityMap ->
   -- | Fixity Map
-  LazyFixityMap ->
+  ModuleFixityMap ->
   -- | Original 'OpTree'
   OpTree ty op ->
   -- | Re-associated 'OpTree', with added context and info around operators
   OpTree ty (OpInfo op)
-reassociateOpTree getOpName fixityOverrides fixityMap =
+reassociateOpTree getOpName modFixityMap =
   reassociateFlatOpTree
     . makeFlatOpTree
-    . addFixityInfo fixityOverrides fixityMap getOpName
+    . addFixityInfo modFixityMap getOpName
 
 -- | Wrap every operator of the tree with 'OpInfo' to carry the information
 -- about its fixity (extracted from the specified fixity map).
 addFixityInfo ::
-  -- | Fixity overrides
-  FixityMap ->
   -- | Fixity map for operators
-  LazyFixityMap ->
+  ModuleFixityMap ->
   -- | How to get the name of an operator
   (op -> Maybe RdrName) ->
   -- | 'OpTree'
   OpTree ty op ->
   -- | 'OpTree', with fixity info wrapped around each operator
   OpTree ty (OpInfo op)
-addFixityInfo _ _ _ (OpNode n) = OpNode n
+addFixityInfo _ _ (OpNode n) = OpNode n
-addFixityInfo fixityOverrides fixityMap getOpName (OpBranches exprs ops) =
+addFixityInfo modFixityMap getOpName (OpBranches exprs ops) =
   OpBranches
-    (addFixityInfo fixityOverrides fixityMap getOpName <$> exprs)
+    (addFixityInfo modFixityMap getOpName <$> exprs)
     (toOpInfo <$> ops)
   where
-    toOpInfo o = OpInfo o mName fixityInfo
+    toOpInfo o = OpInfo o mrdrName fixityApproximation
       where
-        mName = occOpName . rdrNameOcc <$> getOpName o
+        mrdrName = getOpName o
-        fixityInfo =
+        fixityApproximation = case mrdrName of
-          fromMaybe
+          Nothing -> defaultFixityApproximation
-            defaultFixityInfo
+          Just rdrName -> inferFixity rdrName modFixityMap
-            ( do
-                name <- mName
-                Map.lookup name fixityOverrides <|> lookupFixity name fixityMap
-            )
 
 -- | Given a 'OpTree' of any shape, produce a flat 'OpTree', where every
 -- node and operator is directly connected to the root.
@@ -202,7 +191,7 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) =
   where
     indicesOfHardSplitter =
       fmap fst $
-        filter (isHardSplitterOp . opiFix . snd) $
+        filter (isHardSplitterOp . opiFixityApproximation . snd) $
           zip [0 ..] noptOps
     indexOfMinMaxPrecOps [] = (Nothing, Nothing)
     indexOfMinMaxPrecOps (oo : oos) = go oos 1 oo (Just [0]) oo (Just [0])
@@ -367,5 +356,5 @@ reassociateFlatOpTree tree@(OpBranches noptExprs noptOps) =
 -- class of operators because they often have, like ('$'), a specific
 -- “separator” use-case, and we sometimes format them differently than other
 -- operators.
-isHardSplitterOp :: FixityInfo -> Bool
+isHardSplitterOp :: FixityApproximation -> Bool
-isHardSplitterOp = (== FixityInfo (Just InfixR) 0 0)
+isHardSplitterOp = (== FixityApproximation (Just InfixR) 0 0)

src/Ormolu/Utils.hs

@@ -17,6 +17,7 @@ module Ormolu.Utils
     getLoc',
     matchAddEpAnn,
     textToStringBuffer,
+    ghcModuleNameToCabal,
   )
 where
 
@@ -27,16 +28,19 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Foreign qualified as TFFI
+import Distribution.ModuleName (ModuleName)
+import Distribution.ModuleName qualified as ModuleName
 import Foreign (pokeElemOff, withForeignPtr)
 import GHC.Data.Strict qualified as Strict
 import GHC.Data.StringBuffer (StringBuffer (..))
 import GHC.Driver.Ppr
 import GHC.DynFlags (baseDynFlags)
 import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
-import GHC.Hs
+import GHC.Hs hiding (ModuleName)
 import GHC.IO.Unsafe (unsafePerformIO)
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable (Outputable (..))
+import Language.Haskell.Syntax.Module.Name qualified as GHC
 
 -- | Relative positions in a list.
 data RelativePos
@@ -169,3 +173,7 @@ textToStringBuffer txt = unsafePerformIO $ do
   pure StringBuffer {buf, len, cur = 0}
   where
     len = TFFI.lengthWord8 txt
+
+-- | Convert GHC's 'ModuleName' into the one used by Cabal.
+ghcModuleNameToCabal :: GHC.ModuleName -> ModuleName
+ghcModuleNameToCabal = ModuleName.fromString . GHC.moduleNameString

src/Ormolu/Utils/Fixity.hs

@@ -24,7 +24,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import Text.Megaparsec (errorBundlePretty)
 
 -- | Cache ref that stores fixity overrides per cabal file.
-cacheRef :: IORef (Map FilePath FixityMap)
+cacheRef :: IORef (Map FilePath FixityOverrides)
 cacheRef = unsafePerformIO (newIORef Map.empty)
 {-# NOINLINE cacheRef #-}
 
@@ -35,7 +35,7 @@ getFixityOverridesForSourceFile ::
   (MonadIO m) =>
   -- | 'CabalInfo' already obtained for this source file
   CabalInfo ->
-  m FixityMap
+  m FixityOverrides
 getFixityOverridesForSourceFile CabalInfo {..} = liftIO $ do
   cache <- readIORef cacheRef
   case Map.lookup ciCabalFilePath cache of
@@ -46,13 +46,13 @@ getFixityOverridesForSourceFile CabalInfo {..} = liftIO $ do
         then do
           dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmolu
           contents <- readFileUtf8 dotOrmolu
-          case parseFixityMap dotOrmoluRelative contents of
+          case parseFixityOverrides dotOrmoluRelative contents of
             Left errorBundle ->
               throwIO (OrmoluFixityOverridesParseError errorBundle)
             Right x -> do
               modifyIORef' cacheRef (Map.insert ciCabalFilePath x)
               return x
-        else return Map.empty
+        else return (FixityOverrides Map.empty)
     Just x -> return x
 
 -- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity

tests/Ormolu/CabalInfoSpec.hs

@@ -44,7 +44,7 @@ spec = do
       mentioned `shouldBe` True
       unPackageName ciPackageName `shouldBe` "ormolu"
       ciDynOpts `shouldBe` [DynOption "-XGHC2021"]
-      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "ormolu", "path", "path-io", "temporary", "text"]
+      Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"]
       ciCabalFilePath `shouldSatisfy` isAbsolute
       makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "ormolu.cabal"
     it "handles correctly files that are not mentioned in ormolu.cabal" $ do

tests/Ormolu/Fixity/ParserSpec.hs

@@ -9,35 +9,36 @@ import Ormolu.Fixity
 import Ormolu.Fixity.Parser
 import Test.Hspec
 import Test.Hspec.Megaparsec
+import Text.Megaparsec.Error (ErrorFancy (..))
 
 spec :: Spec
 spec = do
   describe "parseFixtiyDeclaration" $ do
     it "parses a simple infixr declaration" $
       parseFixityDeclaration "infixr 5 $"
-        `shouldParse` [("$", FixityInfo (Just InfixR) 5 5)]
+        `shouldParse` [("$", FixityInfo InfixR 5)]
     it "parses a simple infixl declaration" $
       parseFixityDeclaration "infixl 5 $"
-        `shouldParse` [("$", FixityInfo (Just InfixL) 5 5)]
+        `shouldParse` [("$", FixityInfo InfixL 5)]
     it "parses a simple infix declaration" $
       parseFixityDeclaration "infix 5 $"
-        `shouldParse` [("$", FixityInfo (Just InfixN) 5 5)]
+        `shouldParse` [("$", FixityInfo InfixN 5)]
     it "parses a declaration for a ticked identifier" $
       parseFixityDeclaration "infixl 5 `foo`"
-        `shouldParse` [("foo", FixityInfo (Just InfixL) 5 5)]
+        `shouldParse` [("foo", FixityInfo InfixL 5)]
     it "parses a declaration for a ticked identifier (constructor case)" $
       parseFixityDeclaration "infixl 5 `Foo`"
-        `shouldParse` [("Foo", FixityInfo (Just InfixL) 5 5)]
+        `shouldParse` [("Foo", FixityInfo InfixL 5)]
     it "parses a multi-operator declaration" $
       parseFixityDeclaration "infixl 5 $, ., `Foo`, `bar`"
-        `shouldParse` [ ("$", FixityInfo (Just InfixL) 5 5),
+        `shouldParse` [ ("$", FixityInfo InfixL 5),
-                        (".", FixityInfo (Just InfixL) 5 5),
+                        (".", FixityInfo InfixL 5),
-                        ("Foo", FixityInfo (Just InfixL) 5 5),
+                        ("Foo", FixityInfo InfixL 5),
-                        ("bar", FixityInfo (Just InfixL) 5 5)
+                        ("bar", FixityInfo InfixL 5)
                       ]
     it "parses a declaration with a unicode operator" $
       parseFixityDeclaration "infixr 5 ×"
-        `shouldParse` [("×", FixityInfo (Just InfixR) 5 5)]
+        `shouldParse` [("×", FixityInfo InfixR 5)]
     it "fails with correct parse error (keyword wrong)" $
       parseFixityDeclaration "foobar 5 $"
         `shouldFailWith` err
@@ -69,13 +70,18 @@ spec = do
                 elabel "operator character"
               ]
           )
-  describe "parseFixityMap" $ do
+    it "fails with correct parse error (precedence greater than 9)" $
+      parseFixityDeclaration "infixl 10 $"
+        `shouldFailWith` errFancy
+          7
+          (fancy (ErrorFail "precedence should not be greater than 9"))
+  describe "parseFixityOverrides" $ do
     it "parses the empty input without choking" $
-      parseFixityMap "" ""
+      parseFixityOverrides "" ""
-        `shouldParse` Map.empty
+        `shouldParse` FixityOverrides Map.empty
     it "parses a collection of declarations" $
       -- The example is taken from base.
-      parseFixityMap
+      parseFixityOverrides
         ""
         ( T.unlines
             [ "infixr 9  .",
@@ -87,22 +93,24 @@ spec = do
               "infixl 4 <*>, <*, *>, <**>"
             ]
         )
-        `shouldParse` Map.fromList
+        `shouldParse` FixityOverrides
-          [ ("$", FixityInfo (Just InfixR) 0 0),
+          ( Map.fromList
-            ("$!", FixityInfo (Just InfixR) 0 0),
+              [ ("$", FixityInfo InfixR 0),
-            ("*>", FixityInfo (Just InfixL) 4 4),
+                ("$!", FixityInfo InfixR 0),
-            ("++", FixityInfo (Just InfixR) 5 5),
+                ("*>", FixityInfo InfixL 4),
-            (".", FixityInfo (Just InfixR) 9 9),
+                ("++", FixityInfo InfixR 5),
-            ("<$", FixityInfo (Just InfixL) 4 4),
+                (".", FixityInfo InfixR 9),
-            ("<*", FixityInfo (Just InfixL) 4 4),
+                ("<$", FixityInfo InfixL 4),
-            ("<**>", FixityInfo (Just InfixL) 4 4),
+                ("<*", FixityInfo InfixL 4),
-            ("<*>", FixityInfo (Just InfixL) 4 4),
+                ("<**>", FixityInfo InfixL 4),
-            ("=<<", FixityInfo (Just InfixR) 1 1),
+                ("<*>", FixityInfo InfixL 4),
-            (">>", FixityInfo (Just InfixL) 1 1),
+                ("=<<", FixityInfo InfixR 1),
-            (">>=", FixityInfo (Just InfixL) 1 1)
+                (">>", FixityInfo InfixL 1),
+                (">>=", FixityInfo InfixL 1)
               ]
+          )
     it "combines conflicting declarations correctly" $
-      parseFixityMap
+      parseFixityOverrides
         ""
         ( T.unlines
             [ "infixr 9 ., ^",
@@ -111,20 +119,21 @@ spec = do
               "infixl 7 $"
             ]
         )
-        `shouldParse` Map.fromList
+        `shouldParse` FixityOverrides
-          [ ("$", FixityInfo Nothing 7 7),
+          ( Map.fromList
-            (".", FixityInfo (Just InfixR) 7 9),
+              [ ("$", FixityInfo InfixL 7),
-            ("^", FixityInfo (Just InfixR) 9 9)
+                (".", FixityInfo InfixR 7),
+                ("^", FixityInfo InfixR 9)
               ]
+          )
     it "handles CRLF line endings correctly" $
-      parseFixityMap ""
+      parseFixityOverrides ""
-        `shouldSucceedOn` ( unlinesCrlf
+        `shouldSucceedOn` unlinesCrlf
           [ "infixr 9  .",
             "infixr 5  ++"
           ]
-                          )
     it "fails with correct parse error (keyword wrong second line)" $
-      parseFixityMap "" "infixr 5 .\nfoobar 5 $"
+      parseFixityOverrides "" "infixr 5 .\nfoobar 5 $"
         `shouldFailWith` err
           11
           ( mconcat

tests/Ormolu/Fixity/PrinterSpec.hs

@@ -12,12 +12,12 @@ import Test.Hspec
 import Test.Hspec.Megaparsec
 import Test.QuickCheck
 
-newtype FixityMapWrapper = FixityMapWrapper FixityMap
+newtype FixityMapWrapper = FixityMapWrapper FixityOverrides
   deriving (Show)
 
 instance Arbitrary FixityMapWrapper where
   arbitrary =
-    FixityMapWrapper . Map.fromListWith (<>)
+    FixityMapWrapper . FixityOverrides . Map.fromList
       <$> listOf ((,) <$> genOperator <*> genFixityInfo)
     where
       scaleDown = scale (`div` 4)
@@ -35,18 +35,16 @@ instance Arbitrary FixityMapWrapper where
       genFixityInfo = do
         fiDirection <-
           elements
-            [ Nothing,
+            [ InfixL,
-              Just InfixL,
+              InfixR,
-              Just InfixR,
+              InfixN
-              Just InfixN
             ]
-        fiMinPrecedence <- chooseInt (0, 9)
+        fiPrecedence <- chooseInt (0, 9)
-        fiMaxPrecedence <- chooseInt (0, 9) `suchThat` (>= fiMinPrecedence)
         return FixityInfo {..}
 
 spec :: Spec
 spec = do
-  describe "parseFixityMap & printFixityMap" $
+  describe "parseFixityOverrides & printFixityOverrides" $
     it "arbitrary fixity maps are printed and parsed back correctly" $
       property $ \(FixityMapWrapper fixityMap) ->
-        parseFixityMap "" (printFixityMap fixityMap) `shouldParse` fixityMap
+        parseFixityOverrides "" (printFixityOverrides fixityMap) `shouldParse` fixityMap

tests/Ormolu/FixitySpec.hs

@@ -0,0 +1,279 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Ormolu.FixitySpec (spec) where
+
+import Data.Function ((&))
+import Data.Set qualified as Set
+import Data.Text qualified as T
+import Distribution.ModuleName (ModuleName)
+import Distribution.Types.PackageName (PackageName)
+import GHC.Types.Name (OccName)
+import GHC.Types.Name.Occurrence (mkVarOcc)
+import GHC.Types.Name.Reader
+import Language.Haskell.Syntax.ImpExp (ImportListInterpretation (..))
+import Language.Haskell.Syntax.Module.Name (mkModuleName)
+import Ormolu.Fixity
+import Ormolu.Fixity.Imports
+import Ormolu.Fixity.Internal
+import Ormolu.Utils (showOutputable)
+import Test.Hspec
+
+instance Show RdrName where
+  show = showOutputable
+
+spec :: Spec
+spec = do
+  it "gives the correct fixity info for (:) (built-in)" $
+    checkFixities
+      []
+      []
+      [(unqual ":", FixityApproximation (Just InfixR) 5 5)]
+  it "does not know operators from base if base is not a dependency" $
+    checkFixities
+      []
+      []
+      [ (unqual "$", defaultFixityApproximation),
+        (unqual "+", defaultFixityApproximation),
+        (unqual "++", defaultFixityApproximation)
+      ]
+  it "does not know operators from base if Prelude is not imported" $
+    checkFixities
+      []
+      []
+      [ (unqual "$", defaultFixityApproximation),
+        (unqual "+", defaultFixityApproximation),
+        (unqual "++", defaultFixityApproximation)
+      ]
+  it "infers fixities of operators from base correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude"]
+      [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", FixityApproximation (Just InfixL) 6 6),
+        (unqual "++", FixityApproximation (Just InfixR) 5 5)
+      ]
+  it "does not know (>>>) when Control.Category is not imported" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude"]
+      [ (unqual ">>>", defaultFixityApproximation)
+      ]
+  it "infer correct fixity for (>>>) when Control.Category is imported" $
+    checkFixities
+      ["base"]
+      [ import_ "Prelude",
+        import_ "Control.Category"
+      ]
+      [ (unqual ">>>", FixityApproximation (Just InfixR) 1 1)
+      ]
+  it "handles 'as' imports correctly" $
+    checkFixities
+      ["base"]
+      [ import_ "Control.Category" & as_ "Foo"
+      ]
+      [ (unqual ">>>", FixityApproximation (Just InfixR) 1 1),
+        (qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1),
+        (qual "Bar" ">>>", defaultFixityApproximation)
+      ]
+  it "handles 'qualified' imports correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Control.Category" & qualified_]
+      [ (unqual ">>>", defaultFixityApproximation),
+        (qual "Control.Category" ">>>", FixityApproximation (Just InfixR) 1 1)
+      ]
+  it "handles 'qualified as' imports correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Control.Category" & qualified_ & as_ "Foo"]
+      [ (unqual ">>>", defaultFixityApproximation),
+        (qual "Control.Category" ">>>", defaultFixityApproximation),
+        (qual "Foo" ">>>", FixityApproximation (Just InfixR) 1 1)
+      ]
+  it "handles explicit import lists correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude" & exactly_ ["$"]]
+      [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", defaultFixityApproximation)
+      ]
+  it "handles hiding import lists correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude" & hiding_ ["$"]]
+      [ (unqual "$", defaultFixityApproximation),
+        (unqual "+", FixityApproximation (Just InfixL) 6 6),
+        (unqual "++", FixityApproximation (Just InfixR) 5 5)
+      ]
+  it "handles qualified imports with explicit import lists correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude" & qualified_ & exactly_ ["$"]]
+      [ (unqual "$", defaultFixityApproximation),
+        (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", defaultFixityApproximation),
+        (qual "Prelude" "+", defaultFixityApproximation)
+      ]
+  it "handles qualified import with hiding correctly" $
+    checkFixities
+      ["base"]
+      [import_ "Prelude" & qualified_ & hiding_ ["$"]]
+      [ (unqual "$", defaultFixityApproximation),
+        (qual "Prelude" "$", defaultFixityApproximation),
+        (unqual "+", defaultFixityApproximation),
+        (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
+      ]
+  it "handles qualified import and explicit import lists correctly (1)" $
+    checkFixities
+      ["base"]
+      [ import_ "Prelude" & qualified_,
+        import_ "Prelude" & exactly_ ["$"]
+      ]
+      [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
+        (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", defaultFixityApproximation),
+        (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
+      ]
+  it "handles qualified import and explicit import lists correctly (2)" $
+    checkFixities
+      ["base"]
+      [ import_ "Prelude" & exactly_ ["$"],
+        import_ "Prelude" & qualified_
+      ]
+      [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
+        (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", defaultFixityApproximation),
+        (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
+      ]
+  it "handles qualified import and hiding import correctly (1)" $
+    checkFixities
+      ["base"]
+      [ import_ "Prelude" & qualified_,
+        import_ "Prelude" & hiding_ ["$"]
+      ]
+      [ (unqual "$", defaultFixityApproximation),
+        (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", FixityApproximation (Just InfixL) 6 6),
+        (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
+      ]
+  it "handles qualified import and hiding import correctly (2)" $
+    checkFixities
+      ["base"]
+      [ import_ "Prelude" & hiding_ ["$"],
+        import_ "Prelude" & qualified_
+      ]
+      [ (unqual "$", defaultFixityApproximation),
+        (qual "Prelude" "$", FixityApproximation (Just InfixR) 0 0),
+        (unqual "+", FixityApproximation (Just InfixL) 6 6),
+        (qual "Prelude" "+", FixityApproximation (Just InfixL) 6 6)
+      ]
+  it "works for several imports from different packages" $
+    checkFixities
+      ["base", "esqueleto"]
+      [ import_ "Prelude",
+        import_ "Database.Esqueleto.Experimental" & qualified_ & as_ "E"
+      ]
+      [ (unqual "$", FixityApproximation (Just InfixR) 0 0),
+        (qual "E" "++.", FixityApproximation (Just InfixR) 5 5),
+        (qual "E" "on", FixityApproximation (Just InfixN) 9 9)
+      ]
+  it "merges approximations in case of a conflict" $
+    checkFixities
+      ["fclabels", "persistent"]
+      [ import_ "Data.Label.Monadic",
+        import_ "Database.Persist"
+      ]
+      [ (unqual "=.", FixityApproximation (Just InfixR) 2 3)
+      ]
+  it "correctly handles package-qualified imports (1)" $
+    checkFixities
+      ["esqueleto"]
+      [package_ "esqueleto" $ import_ "Database.Esqueleto.Experimental"]
+      [(unqual "++.", FixityApproximation (Just InfixR) 5 5)]
+  it "correctly handles package-qualified imports (2)" $
+    checkFixities
+      ["esqueleto"]
+      [package_ "bob" $ import_ "Database.Esqueleto.Experimental"]
+      [(unqual "++.", defaultFixityApproximation)]
+
+-- | Build a fixity map using the Hoogle database and then check the fixity
+-- of the specified subset of operators.
+checkFixities ::
+  -- | List of dependencies
+  [PackageName] ->
+  -- | Imports
+  [FixityImport] ->
+  -- | Associative list representing a subset of the resulting fixity map
+  -- that should be checked.
+  [(RdrName, FixityApproximation)] ->
+  Expectation
+checkFixities dependencies fixityImports expectedResult =
+  actualResult `shouldBe` expectedResult
+  where
+    actualResult =
+      fmap
+        (\(k, _) -> (k, inferFixity k resultMap))
+        expectedResult
+    resultMap =
+      moduleFixityMap
+        (packageFixityMap (Set.fromList dependencies))
+        fixityImports
+
+qual :: String -> OpName -> RdrName
+qual moduleName opName = mkRdrQual (mkModuleName moduleName) (opNameToOccName opName)
+
+unqual :: OpName -> RdrName
+unqual = mkRdrUnqual . opNameToOccName
+
+opNameToOccName :: OpName -> OccName
+opNameToOccName = mkVarOcc . T.unpack . unOpName
+
+-- | Explicitly specify the package.
+package_ :: PackageName -> FixityImport -> FixityImport
+package_ packageName fixityImport =
+  fixityImport
+    { fimportPackage = Just packageName
+    }
+
+-- | Construct a simple 'FixityImport'.
+import_ :: ModuleName -> FixityImport
+import_ moduleName =
+  FixityImport
+    { fimportPackage = Nothing,
+      fimportModuleName = moduleName,
+      fimportQualified = UnqualifiedAndQualified moduleName,
+      fimportList = Nothing
+    }
+
+-- | Adds an alias for an import.
+as_ :: ModuleName -> FixityImport -> FixityImport
+as_ moduleName fixityImport =
+  fixityImport
+    { fimportQualified = case fimportQualified fixityImport of
+        UnqualifiedAndQualified _ -> UnqualifiedAndQualified moduleName
+        OnlyQualified _ -> OnlyQualified moduleName
+    }
+
+-- | Qualified imports.
+qualified_ :: FixityImport -> FixityImport
+qualified_ fixityImport =
+  fixityImport
+    { fimportQualified = case fimportQualified fixityImport of
+        UnqualifiedAndQualified m -> OnlyQualified m
+        OnlyQualified m -> OnlyQualified m
+    }
+
+-- | Exact import lists.
+exactly_ :: [OpName] -> FixityImport -> FixityImport
+exactly_ opNames fixityImports =
+  fixityImports
+    { fimportList = Just (Exactly, opNames)
+    }
+
+-- | Hiding.
+hiding_ :: [OpName] -> FixityImport -> FixityImport
+hiding_ opNames fixityImports =
+  fixityImports
+    { fimportList = Just (EverythingBut, opNames)
+    }

tests/Ormolu/HackageInfoSpec.hs

@@ -1,507 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Ormolu.HackageInfoSpec (spec) where
-
-import Data.Map.Strict qualified as Map
-import Data.Maybe (mapMaybe)
-import Data.Set qualified as Set
-import Distribution.Types.PackageName (PackageName)
-import Ormolu.Fixity
-import Test.Hspec
-
--- | Build a fixity map using the Hackage/Hoogle database, and the boot
--- package list, and then check the fixity of the specified subset of
--- operators.
-checkFixityMap ::
-  -- | List of dependencies
-  [PackageName] ->
-  -- | Threshold to choose the conflict resolution strategy
-  Float ->
-  -- | Associative list representing a subset of the resulting fixity map
-  -- that should be checked.
-  [(OpName, FixityInfo)] ->
-  Expectation
-checkFixityMap
-  dependencies
-  threshold
-  expectedResult =
-    actualResult `shouldBe` expectedResult
-    where
-      actualResult =
-        mapMaybe
-          (\(k, _) -> (k,) <$> lookupFixity k resultMap)
-          expectedResult
-      resultMap =
-        buildFixityMap'
-          packageToOps
-          packageToPopularity
-          bootPackages
-          threshold
-          (Set.fromList dependencies)
-
--- | Build a fixity map from a custom package database, and then check the
--- fixity of the specified subset of operators.
-checkFixityMap' ::
-  -- | Associative list for packageToOps:
-  -- package name -map-> (operator -map-> fixity)
-  [(PackageName, [(OpName, FixityInfo)])] ->
-  -- | Associative list for packageToPopularity:
-  -- package name -map-> download count
-  [(PackageName, Int)] ->
-  -- | List of packages that should have a higher priority than
-  -- unspecified packages (boot packages)
-  [PackageName] ->
-  -- | List of dependencies
-  [PackageName] ->
-  -- | Threshold to choose the conflict resolution strategy
-  Float ->
-  -- | Associative list representing a subset of the resulting fixity map
-  -- that should be checked.
-  [(OpName, FixityInfo)] ->
-  Expectation
-checkFixityMap'
-  lPackageToOps
-  lPackageToPopularity
-  highPrioPackages
-  dependencies
-  threshold
-  expectedResult =
-    actualResult `shouldBe` expectedResult
-    where
-      actualResult =
-        mapMaybe
-          (\(k, _) -> (k,) <$> lookupFixity k resultMap)
-          expectedResult
-      resultMap =
-        buildFixityMap'
-          lPackageToOps'
-          lPackageToPopularity'
-          (Set.fromList highPrioPackages)
-          threshold
-          (Set.fromList dependencies)
-      lPackageToOps' =
-        Map.map Map.fromList $
-          Map.fromList lPackageToOps
-      lPackageToPopularity' = Map.fromList lPackageToPopularity
-
-spec :: Spec
-spec = do
-  it
-    "correctly merges fixities when a conflict appears in unspecified \
-    \packages, with max(pop) < threshold"
-    $ do
-      let operators =
-            [ ("A", [("+", FixityInfo (Just InfixL) 4 4)]),
-              ("B", [("+", FixityInfo (Just InfixR) 6 6)])
-            ]
-          popularity =
-            [ ("A", 3),
-              ("B", 5)
-            ]
-          dependencies = []
-          higherPriorityPackages = []
-          threshold = 0.9
-          result =
-            [ ("+", FixityInfo Nothing 4 6)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "keeps only the most popular declaration when a conflict appears in \
-    \unspecified packages, with max(pop) >= threshold"
-    $ do
-      let operators =
-            [ ("A", [("+", FixityInfo (Just InfixL) 4 4)]),
-              ("B", [("+", FixityInfo (Just InfixR) 6 6)])
-            ]
-          popularity =
-            [ ("A", 5),
-              ("B", 103)
-            ]
-          dependencies = []
-          higherPriorityPackages = []
-          threshold = 0.9
-          result =
-            [ ("+", FixityInfo (Just InfixR) 6 6)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "merges the ex-aequo most popular declaration when a conflict appears \
-    \in unspecified packages, with max(pop) >= threshold"
-    $ do
-      let operators =
-            [ ("A", [("+", FixityInfo (Just InfixL) 4 4)]),
-              ("B", [("+", FixityInfo (Just InfixR) 6 6)]),
-              ("C", [("+", FixityInfo (Just InfixR) 8 8)])
-            ]
-          popularity =
-            [ ("A", 5),
-              ("B", 103),
-              ("C", 103)
-            ]
-          dependencies = []
-          higherPriorityPackages = []
-          threshold = 0.4
-          result =
-            [ ("+", FixityInfo (Just InfixR) 6 8)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "keeps only the most popular declaration when a conflict appears in \
-    \unspecified packages, threshold == 0"
-    $ do
-      let operators =
-            [ ("A", [("+", FixityInfo (Just InfixL) 4 4)]),
-              ("B", [("+", FixityInfo (Just InfixR) 6 6)])
-            ]
-          popularity =
-            [ ("A", 5),
-              ("B", 103)
-            ]
-          dependencies = []
-          higherPriorityPackages = []
-          threshold = 0.0
-          result =
-            [ ("+", FixityInfo (Just InfixR) 6 6)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "merges all declarations when a conflict appears in unspecified \
-    \packages, threshold > 1"
-    $ do
-      let operators =
-            [ ("A", [("+", FixityInfo (Just InfixN) 4 4)]),
-              ("B", [("+", FixityInfo (Just InfixN) 6 6)]),
-              ("C", [("+", FixityInfo (Just InfixN) 8 8)])
-            ]
-          popularity =
-            [ ("A", 0),
-              ("B", 0),
-              ("C", 11103)
-            ]
-          dependencies = []
-          higherPriorityPackages = []
-          threshold = 10.0
-          result =
-            [ ("+", FixityInfo (Just InfixN) 4 8)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "merges all declarations when a conflict appears in cabal \
-    \dependencies"
-    $ do
-      let operators =
-            [ ( "A",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("-", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ("C", [("+", FixityInfo (Just InfixN) 8 8)])
-            ]
-          popularity =
-            [ ("A", 0),
-              ("B", 0),
-              ("C", 11103)
-            ]
-          dependencies = ["B", "C"]
-          higherPriorityPackages = []
-          threshold = 0.4
-          result =
-            [ ("+", FixityInfo (Just InfixN) 6 8),
-              ("-", FixityInfo (Just InfixL) 4 4)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "merges all declarations when a conflict appears in higher-priority \
-    \packages"
-    $ do
-      let operators =
-            [ ( "A",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("-", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ("C", [("+", FixityInfo (Just InfixN) 8 8)])
-            ]
-          popularity =
-            [ ("A", 0),
-              ("B", 0),
-              ("C", 11103)
-            ]
-          dependencies = []
-          higherPriorityPackages = ["B", "C"]
-          threshold = 0.4
-          result =
-            [ ("+", FixityInfo (Just InfixN) 6 8),
-              ("-", FixityInfo (Just InfixL) 4 4)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "whitelists declarations from base even when it is not listed in \
-    \cabal dependencies"
-    $ do
-      let operators =
-            [ ( "base",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("-", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ( "C",
-                [ ("+", FixityInfo (Just InfixN) 8 8),
-                  ("|>", FixityInfo (Just InfixN) 1 1)
-                ]
-              )
-            ]
-          popularity =
-            [ ("base", 0),
-              ("B", 2),
-              ("C", 11103)
-            ]
-          dependencies = ["B", "C"]
-          higherPriorityPackages = []
-          threshold = 0.4
-          result =
-            [ ("+", FixityInfo (Just InfixR) 4 4),
-              ("-", FixityInfo (Just InfixR) 2 2),
-              ("|>", FixityInfo (Just InfixN) 1 1)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "whitelists declarations from base when base is also listed in cabal \
-    \dependencies"
-    $ do
-      let operators =
-            [ ( "base",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("?=", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ( "C",
-                [ ("<|>", FixityInfo (Just InfixN) 8 8),
-                  ("?=", FixityInfo (Just InfixN) 1 1)
-                ]
-              )
-            ]
-          popularity =
-            [ ("base", 0),
-              ("B", 2),
-              ("C", 11103)
-            ]
-          dependencies = ["base", "B"]
-          higherPriorityPackages = []
-          threshold = 0.6
-          result =
-            [ ("+", FixityInfo (Just InfixR) 4 4),
-              ("-", FixityInfo (Just InfixR) 2 2),
-              ("?=", FixityInfo (Just InfixL) 4 4)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "gives higher priority to declarations from cabal dependencies than \
-    \declarations from both higher-priority & unspecified packages"
-    $ do
-      let operators =
-            [ ( "base",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("?=", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ( "C",
-                [ ("<|>", FixityInfo (Just InfixN) 8 8),
-                  ("?=", FixityInfo (Just InfixN) 1 1)
-                ]
-              ),
-              ("D", [("+", FixityInfo (Just InfixR) 2 2)])
-            ]
-          popularity =
-            [ ("base", 0),
-              ("B", 2),
-              ("C", 11103)
-            ]
-          dependencies = ["base", "B"]
-          higherPriorityPackages = ["D"]
-          threshold = 0.6
-          result =
-            [ ("?=", FixityInfo (Just InfixL) 4 4),
-              ("<|>", FixityInfo (Just InfixN) 8 8)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it
-    "gives higher priority to declarations from higher-priority packages \
-    \than declarations from unspecified packages"
-    $ do
-      let operators =
-            [ ( "base",
-                [ ("+", FixityInfo (Just InfixR) 4 4),
-                  ("-", FixityInfo (Just InfixR) 2 2)
-                ]
-              ),
-              ( "B",
-                [ ("+", FixityInfo (Just InfixN) 6 6),
-                  ("?=", FixityInfo (Just InfixL) 4 4)
-                ]
-              ),
-              ( "C",
-                [ ("<|>", FixityInfo (Just InfixN) 8 8),
-                  ("?=", FixityInfo (Just InfixN) 1 1)
-                ]
-              ),
-              ("D", [("+", FixityInfo (Just InfixR) 2 2)])
-            ]
-          popularity =
-            [ ("base", 0),
-              ("B", 2),
-              ("C", 11103)
-            ]
-          dependencies = []
-          higherPriorityPackages = ["B"]
-          threshold = 0.6
-          result =
-            [ ("+", FixityInfo (Just InfixR) 4 4),
-              ("?=", FixityInfo (Just InfixL) 4 4),
-              ("<|>", FixityInfo (Just InfixN) 8 8)
-            ]
-      checkFixityMap'
-        operators
-        popularity
-        higherPriorityPackages
-        dependencies
-        threshold
-        result
-
-  it "gives the correct fixity info for ':' (from base)" $ do
-    let dependencies = []
-        threshold = 0.6
-        result =
-          [ (":", FixityInfo (Just InfixR) 5 5)
-          ]
-    checkFixityMap dependencies threshold result
-
-  it
-    "gives the base's fixity info for '<|>', even when a dependency has a \
-    \conflicting declaration for it"
-    $ do
-      let dependencies = ["pandoc"]
-          threshold = 0.9
-          result =
-            [ ("<|>", FixityInfo (Just InfixL) 3 3)
-            ]
-      checkFixityMap dependencies threshold result
-
-  it
-    "gives the containers's fixity info for ':>' (because 'containers' is \
-    \a higher-priority package), even though max(pop) < threshold for \
-    \this operator)"
-    $ do
-      let dependencies = []
-          threshold = 0.9
-          result =
-            [ (":>", FixityInfo (Just InfixL) 5 5)
-            ]
-      checkFixityMap dependencies threshold result
-
-  it
-    "gives the servant's fixity info for ':>' once servant is added as a \
-    \dependency (although ':>' is also defined in 'containers', a \
-    \higher-priority package)"
-    $ do
-      let dependencies = ["servant"]
-          threshold = 0.9
-          result =
-            [ (":>", FixityInfo (Just InfixR) 4 4)
-            ]
-      checkFixityMap dependencies threshold result

tests/Ormolu/OpTreeSpec.hs

@@ -3,13 +3,12 @@
 module Ormolu.OpTreeSpec (spec) where
 
 import Data.Map.Strict qualified as Map
-import Data.Maybe (fromJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Types.Name (mkOccName, varName)
 import GHC.Types.Name.Reader (mkRdrUnqual)
 import Ormolu.Fixity
-import Ormolu.Fixity.Internal (LazyFixityMap (..))
+import Ormolu.Fixity.Internal
 import Ormolu.Printer.Operators
 import Test.Hspec
 
@@ -25,20 +24,16 @@ checkReassociate ::
   -- | Expected output tree
   OpTree Text OpName ->
   Expectation
-checkReassociate lFixities inputTree expectedOutputTree =
+checkReassociate fixities inputTree expectedOutputTree =
   removeOpInfo actualOutputTree `shouldBe` expectedOutputTree
   where
     removeOpInfo (OpNode x) = OpNode x
     removeOpInfo (OpBranches exprs ops) =
       OpBranches (removeOpInfo <$> exprs) (opiOp <$> ops)
-    actualOutputTree = reassociateOpTree convertName Map.empty fixityMap inputTree
+    actualOutputTree = reassociateOpTree convertName modFixityMap inputTree
-    fixityMap = LazyFixityMap [Map.fromList lFixities]
+    modFixityMap = ModuleFixityMap (Map.map Given (Map.fromList fixities))
     convertName = Just . mkRdrUnqual . mkOccName varName . T.unpack . unOpName
 
--- | Associative list of fixities for operators from "base"
-baseFixities :: [(OpName, FixityInfo)]
-baseFixities = Map.toList . fromJust $ Map.lookup "base" packageToOps
-
 spec :: Spec
 spec = do
   it "flattens a tree correctly" $ do
@@ -52,7 +47,7 @@ spec = do
             ["+"]
         outputTree =
           OpBranches [n "a", n "b", n "c", n "d"] ["+", "+", "+"]
-        fixities = [("+", FixityInfo (Just InfixL) 5 5)]
+        fixities = [("+", FixityInfo InfixL 5)]
     checkReassociate fixities inputTree outputTree
 
   it "uses 'minOps' strategy by default" $ do
@@ -68,9 +63,9 @@ spec = do
             ]
             ["+", "-"]
         fixities =
-          [ ("+", FixityInfo (Just InfixL) 5 5),
+          [ ("+", FixityInfo InfixL 5),
-            ("*", FixityInfo (Just InfixL) 7 7),
+            ("*", FixityInfo InfixL 7),
-            ("-", FixityInfo (Just InfixL) 5 5)
+            ("-", FixityInfo InfixL 5)
           ]
     checkReassociate fixities inputTree outputTree
 
@@ -87,9 +82,9 @@ spec = do
             ]
             ["+", "-"]
         fixities =
-          [ ("+", FixityInfo (Just InfixL) 5 7),
+          [ ("+", FixityInfo InfixL 5),
-            ("*", FixityInfo (Just InfixL) 8 8),
+            ("*", FixityInfo InfixL 8),
-            ("-", FixityInfo (Just InfixL) 4 6)
+            ("-", FixityInfo InfixL 5)
           ]
     checkReassociate fixities inputTree outputTree
 
@@ -110,9 +105,9 @@ spec = do
               ]
               ["$"]
           fixities =
-            [ ("@", FixityInfo (Just InfixL) 0 5),
+            [ ("@", FixityInfo InfixL 4),
-              ("|", FixityInfo (Just InfixL) 4 8),
+              ("|", FixityInfo InfixL 4),
-              ("$", FixityInfo (Just InfixR) 0 0)
+              ("$", FixityInfo InfixR 0)
             ]
       checkReassociate fixities inputTree outputTree
 
@@ -132,4 +127,9 @@ spec = do
                 ["+"]
             ]
             ["$", "$"]
-    checkReassociate baseFixities inputTree outputTree
+        fixities =
+          [ ("$", FixityInfo InfixR 0),
+            ("+", FixityInfo InfixL 6),
+            ("*", FixityInfo InfixL 7)
+          ]
+    checkReassociate fixities inputTree outputTree

tests/Ormolu/PrinterSpec.hs

@@ -8,6 +8,7 @@ import Control.Monad
 import Data.List (isSuffixOf)
 import Data.Map qualified as Map
 import Data.Maybe (isJust)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
@@ -25,13 +26,15 @@ spec = do
   es <- runIO locateExamples
   forM_ es checkExample
 
--- | Fixities that are to be used with the test examples.
+-- | Fixity overrides that are to be used with the test examples.
-testsuiteFixities :: FixityMap
+testsuiteOverrides :: FixityOverrides
-testsuiteFixities =
+testsuiteOverrides =
-  Map.fromList
+  FixityOverrides
-    [ (".=", FixityInfo (Just InfixR) 8 8),
+    ( Map.fromList
-      ("#", FixityInfo (Just InfixR) 5 5)
+        [ (".=", FixityInfo InfixR 8),
+          ("#", FixityInfo InfixR 5)
         ]
+    )
 
 -- | Check a single given example.
 checkExample :: Path Rel File -> Spec
@@ -41,7 +44,14 @@ checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptio
       config =
         defaultConfig
           { cfgSourceType = detectSourceType inputPath,
-            cfgFixityOverrides = testsuiteFixities
+            cfgFixityOverrides = testsuiteOverrides,
+            cfgDependencies =
+              Set.fromList
+                [ "base",
+                  "esqueleto",
+                  "lens",
+                  "servant"
+                ]
           }
   expectedOutputPath <- deriveOutput srcPath
   -- 1. Given input snippet of source code parse it and pretty print it.