Introduce operator fixity configuration

Co-authored-by: amesgen <alexander.esgen@tweag.io>

CHANGELOG.md

@@ -1,14 +1,5 @@
 ## Unreleased
 
-* Invalid haddock comments are formatted in a more consistent way. Leading
-  haddock triggers (`|`, `^`) in an invalid haddock comment block are now
-  escaped with a backslash `\`. [Issue
-  816](https://github.com/tweag/ormolu/issues/816).
-
-* Type synonyms and families are now formatted correctly when the equals sign
-  is preceded by a comment. [Issue 829](
-  https://github.com/tweag/ormolu/issues/829).
-
 * Changed the way operator fixities and precedences are inferred.
   * Ormolu now tries to locate `.cabal` files of source files by default and
     in addition to default extensions it also infers the list of
@@ -23,12 +14,28 @@
     option (can be repeated many times).
   * The default heuristic algorithm will still try to guess the right
     fixities and precedence.
-  This resolves the following issues: [Issue
+  * Fixity overrides can be provided by the user in the familiar Haskell
+    notation (e.g. `infixr 9 .`, one declaration per line). They are loaded
+    by default from the `.ormolu` file that is expected to be in the same
+    directory as the `.cabal` file of a given source file. However, if
+    `--no-cabal` is supplied, the `.ormolu` file will not be looked for either.
+    Fixity declarations can be also provided by using the `-f / --fixity`
+    command line option, which see.
+  * This resolves the following issues: [Issue
     826](https://github.com/tweag/ormolu/issues/826), [Issue
     785](https://github.com/tweag/ormolu/issues/785), [Issue
     690](https://github.com/tweag/ormolu/issues/690), [Issue
     825](https://github.com/tweag/ormolu/issues/825).
 
+* Invalid haddock comments are formatted in a more consistent way. Leading
+  haddock triggers (`|`, `^`) in an invalid haddock comment block are now
+  escaped with a backslash `\`. [Issue
+  816](https://github.com/tweag/ormolu/issues/816).
+
+* Type synonyms and families are now formatted correctly when the equals sign
+  is preceded by a comment. [Issue 829](
+  https://github.com/tweag/ormolu/issues/829).
+
 * Bidirectional pattern synonyms are formatted nicer in certain cases.
   [Issue 843](https://github.com/tweag/ormolu/issues/843).
 

CONTRIBUTING.md

@@ -40,7 +40,7 @@ To regenerate outputs that have changed, you can set the
 
 ## Formatting
 
-Use `format.sh` script to format Ormolu with current version of Ormolu. If
-Ormolu is not formatted like this, the CI will fail.
+Use `format.sh` script to format Ormolu with the current version of Ormolu.
+If Ormolu is not formatted like this, the CI will fail.
 
 [issues]: https://github.com/tweag/ormolu/issues

README.md

@@ -13,8 +13,9 @@
     * [Editor integration](#editor-integration)
     * [Haskell Language Server](#haskell-language-server)
     * [GitHub actions](#github-actions)
+    * [Language extensions, dependencies, and fixities](#language-extensions-dependencies-and-fixities)
     * [Magic comments](#magic-comments)
-    * [Account for .cabal files](#account-for-cabal-files)
+    * [Regions](#regions)
     * [Exit codes](#exit-codes)
 * [Limitations](#limitations)
 * [Running on Hackage](#running-on-hackage)
@@ -162,6 +163,44 @@ has built-in support for using Ormolu as a formatter.
 [`ormolu-action`][ormolu-action] is the recommended way to ensure that a
 project is formatted with Ormolu.
 
+### Language extensions, dependencies, and fixities
+
+Ormolu automatically locates the Cabal file that corresponds to a given
+source code file. When input comes from stdin, one can pass
+`--stdin-input-file` which will give Ormolu the location of the Haskell
+source file that should be used as the starting point for searching for a
+suitable Cabal file. Cabal files are used to extract both default extensions
+and dependencies. Default extensions directly affect behavior of the GHC
+parser, while dependencies are used to figure out fixities of operators that
+appear in the source code. Fixities can also be overridden if `.ormolu` file
+is found next to the corresponding Cabal file, i.e. they should be siblings
+in the same directory.
+
+Here is an example of `.ormolu` file:
+
+```haskell
+infixr 9  .
+infixr 5  ++
+infixl 4  <$
+infixl 1  >>, >>=
+infixr 1  =<<
+infixr 0  $, $!
+infixl 4 <*>, <*, *>, <**>
+```
+
+It uses exactly the same syntax as usual Haskell fixity declarations to make
+it easier for Haskellers to edit and maintain.
+
+Besides, all of the above-mentioned parameters can be controlled from the
+command line:
+
+* Language extensions can be specified with the `-o` or `--ghc-opt` flag.
+* Dependencies can be specified with the `-p` or `--package` flag.
+* Fixities can be specified with the `-f` or `--fixity` flag.
+
+Searching for both `.cabal` and `.ormolu` files can be disabled by passing
+`--no-cabal`.
+
 ### Magic comments
 
 Ormolu understands two magic comments:
@@ -183,16 +222,12 @@ fragments where Ormolu is enabled must be parseable on their own. Because of
 that the magic comments cannot be placed arbitrarily, but rather must
 enclose independent top-level definitions.
 
-### Account for .cabal files
+### Regions
 
-Many cabal and stack projects use `default-extensions` to enable GHC
-language extensions in all source files. With the
-`--cabal-default-extensions` flag, Ormolu will take them into consideration
-during formatting.
-
-When you format input from stdin, you can pass `--stdin-input-file` which
-will give Ormolu the location of the Haskell source file that should be used
-as the starting point for searching for a suitable .cabal file.
+One can ask Ormolu to format a region of input and leave the rest
+unformatted. This is accomplished by passing the `--start-line` and
+`--end-line` command line options. `--start-line` defaults to the beginning
+of the file, while `--end-line` defaults to the end.
 
 ### Exit codes
 
@@ -208,6 +243,7 @@ Exit code | Meaning
 7         | Unrecognized GHC options
 8         | Cabal file parsing failed
 9         | Missing input file path when using stdin input and accounting for .cabal files
+10        | Parse error while parsing fixity overrides
 100       | In checking mode: unformatted files
 101       | Inplace mode does not work with stdin
 102       | Other issue (with multiple input files)

app/Main.hs

@@ -14,6 +14,7 @@ import Control.Exception (throwIO)
 import Control.Monad
 import Data.Bool (bool)
 import Data.List (intercalate, sort)
+import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Set as Set
 import qualified Data.Text as T
@@ -23,10 +24,15 @@ import Development.GitRev
 import Options.Applicative
 import Ormolu
 import Ormolu.Diff.Text (diffText, printTextDiff)
+import Ormolu.Fixity (FixityInfo)
 import Ormolu.Parser (manualExts)
 import Ormolu.Terminal
 import Ormolu.Utils (showOutputable)
 import Ormolu.Utils.Cabal
+import Ormolu.Utils.Fixity
+  ( getFixityOverridesForSourceFile,
+    parseFixityDeclarationStr,
+  )
 import Ormolu.Utils.IO
 import Paths_ormolu (version)
 import System.Exit (ExitCode (..), exitWith)
@@ -82,13 +88,14 @@ formatOne CabalOpts {..} mode reqSourceType rawConfig mpath =
       -- input source = STDIN
       Nothing -> do
         resultConfig <-
-          patchConfig Nothing
-            <$> if optDoNotUseCabal
+          ( if optDoNotUseCabal
               then pure defaultCabalInfo
               else case optStdinInputFile of
                 Just stdinInputFile ->
                   getCabalInfoForSourceFile stdinInputFile
                 Nothing -> throwIO OrmoluMissingStdinInputFile
+            )
+            >>= patchConfig Nothing
         case mode of
           Stdout -> do
             ormoluStdin resultConfig >>= TIO.putStr
@@ -109,10 +116,11 @@ formatOne CabalOpts {..} mode reqSourceType rawConfig mpath =
       -- input source = a file
       Just inputFile -> do
         resultConfig <-
-          patchConfig (Just (detectSourceType inputFile))
-            <$> if optDoNotUseCabal
+          ( if optDoNotUseCabal
               then pure defaultCabalInfo
               else getCabalInfoForSourceFile inputFile
+            )
+            >>= patchConfig (Just (detectSourceType inputFile))
         case mode of
           Stdout -> do
             ormoluFile resultConfig inputFile >>= TIO.putStr
@@ -132,7 +140,7 @@ formatOne CabalOpts {..} mode reqSourceType rawConfig mpath =
               ormolu resultConfig inputFile (T.unpack originalInput)
             handleDiff originalInput formattedInput inputFile
   where
-    patchConfig mdetectedSourceType CabalInfo {..} =
+    patchConfig mdetectedSourceType cabalInfo@CabalInfo {..} = do
       let depsFromCabal =
             -- It makes sense to take into account the operator info for the
             -- package itself if we know it, as if it were its own
@@ -140,15 +148,19 @@ formatOne CabalOpts {..} mode reqSourceType rawConfig mpath =
             case ciPackageName of
               Nothing -> ciDependencies
               Just p -> Set.insert p ciDependencies
-       in rawConfig
-            { cfgDynOptions = cfgDynOptions rawConfig ++ ciDynOpts,
-              cfgDependencies =
-                Set.union (cfgDependencies rawConfig) depsFromCabal,
-              cfgSourceType =
-                fromMaybe
-                  ModuleSource
-                  (reqSourceType <|> mdetectedSourceType)
-            }
+      fixityOverrides <- getFixityOverridesForSourceFile cabalInfo
+      return
+        rawConfig
+          { cfgDynOptions = cfgDynOptions rawConfig ++ ciDynOpts,
+            cfgFixityOverrides =
+              Map.unionWith (<>) (cfgFixityOverrides rawConfig) fixityOverrides,
+            cfgDependencies =
+              Set.union (cfgDependencies rawConfig) depsFromCabal,
+            cfgSourceType =
+              fromMaybe
+                ModuleSource
+                (reqSourceType <|> mdetectedSourceType)
+          }
     handleDiff originalInput formattedInput fileRepr =
       case diffText originalInput formattedInput fileRepr of
         Nothing -> return ExitSuccess
@@ -256,7 +268,9 @@ cabalOptsParser =
   CabalOpts
     <$> (switch . mconcat)
       [ long "no-cabal",
-        help "Do not extract default-extensions and dependencies from .cabal files"
+        help $
+          "Do not extract default-extensions and dependencies from .cabal files"
+            ++ ", do not look for .ormolu files"
       ]
     <*> (optional . strOption . mconcat)
       [ long "stdin-input-file",
@@ -272,6 +286,16 @@ configParser =
         metavar "OPT",
         help "GHC options to enable (e.g. language extensions)"
       ]
+    <*> ( fmap (Map.fromListWith (<>) . mconcat)
+            . many
+            . option parseFixityDeclaration
+            . mconcat
+        )
+      [ long "fixity",
+        short 'f',
+        metavar "FIXITY",
+        help "Fixity declaration to use (an override)"
+      ]
     <*> (fmap Set.fromList . many . strOption . mconcat)
       [ long "package",
         short 'p',
@@ -337,6 +361,10 @@ parseMode = eitherReader $ \case
   "check" -> Right Check
   s -> Left $ "unknown mode: " ++ s
 
+-- | Parse a fixity declaration.
+parseFixityDeclaration :: ReadM [(String, FixityInfo)]
+parseFixityDeclaration = eitherReader parseFixityDeclarationStr
+
 -- | Parse 'ColorMode'.
 parseColorMode :: ReadM ColorMode
 parseColorMode = eitherReader $ \case

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

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

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

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

default.nix

@@ -210,6 +210,47 @@ in {
       find . -name '*.hs' -exec cp --parents {} $out \;
     '';
   };
+  fixityTests = pkgs.stdenv.mkDerivation {
+    name = "ormolu-fixity-tests";
+    src = ./fixity-tests;
+    buildInputs = [
+      ormoluExe
+      pkgs.diffutils
+    ];
+    doCheck = true;
+    buildPhase = ''
+      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
+      cp test-0-input.hs test-0-with-fixity-info-dotormolu.hs
+      ormolu --check-idempotence --mode inplace 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
+    '';
+    checkPhase = ''
+      echo test-0-no-extra-info.hs
+      diff --color=always test-0-no-extra-info-expected.hs test-0-no-extra-info.hs
+      echo test-0-with-fixity-info-manual.hs
+      diff --color=always test-0-with-fixity-info-expected.hs test-0-with-fixity-info-manual.hs
+      echo test-0-with-fixity-info-dotormolu.hs
+      diff --color=always test-0-with-fixity-info-expected.hs test-0-with-fixity-info-dotormolu.hs
+      echo test-1-no-extra-info.hs
+      diff --color=always test-1-no-extra-info-expected.hs test-1-no-extra-info.hs
+      echo test-1-with-fixity-info-manual.hs
+      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
+    '';
+    installPhase = ''
+      mkdir "$out"
+      find . -name '*.hs' -exec cp --parents {} $out \;
+    '';
+  };
   binaries = {
     Linux = hsPkgs.projectCross.musl64.hsPkgs.ormolu.components.exes.ormolu;
     macOS = pkgs.runCommand "ormolu-macOS" {

fixity-tests/.ormolu

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

fixity-tests/dummy.cabal

@@ -0,0 +1,4 @@
+cabal-version:      2.4
+name:               dummy
+version:            0.0.0.0
+license:            BSD-3-Clause

fixity-tests/test-0-input.hs

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

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

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

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

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

fixity-tests/test-1-input.hs

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

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

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

fixity-tests/test-1-with-fixity-info-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.cabal

@@ -75,6 +75,8 @@ library
         Ormolu.Printer.Operators
         Ormolu.Fixity
         Ormolu.Fixity.Internal
+        Ormolu.Fixity.Parser
+        Ormolu.Fixity.Printer
         Ormolu.Printer.SpanStream
         Ormolu.Processing.Common
         Ormolu.Processing.Cpp
@@ -82,6 +84,7 @@ library
         Ormolu.Terminal
         Ormolu.Utils
         Ormolu.Utils.Cabal
+        Ormolu.Utils.Fixity
         Ormolu.Utils.IO
 
     hs-source-dirs:   src
@@ -102,6 +105,7 @@ library
         exceptions >=0.6 && <0.11,
         filepath >=1.2 && <1.5,
         ghc-lib-parser >=9.2 && <9.3,
+        megaparsec >=9.0,
         mtl >=2.0 && <3.0,
         syb >=0.7 && <0.8,
         template-haskell,
@@ -157,9 +161,11 @@ test-suite tests
     hs-source-dirs:     tests
     other-modules:
         Ormolu.CabalInfoSpec
+        Ormolu.Diff.TextSpec
+        Ormolu.Fixity.ParserSpec
+        Ormolu.Fixity.PrinterSpec
         Ormolu.HackageInfoSpec
         Ormolu.OpTreeSpec
-        Ormolu.Diff.TextSpec
         Ormolu.Parser.OptionsSpec
         Ormolu.Parser.ParseFailureSpec
         Ormolu.Parser.PragmaSpec
@@ -167,12 +173,15 @@ test-suite tests
 
     default-language:   Haskell2010
     build-depends:
+        QuickCheck >=2.14,
         base >=4.14 && <5.0,
         containers >=0.5 && <0.7,
         directory ^>=1.3,
         filepath >=1.2 && <1.5,
         ghc-lib-parser >=9.2 && <9.3,
         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,

src/Ormolu.hs

@@ -65,7 +65,13 @@ ormolu ::
 ormolu cfgWithIndices path originalInput = do
   let totalLines = length (lines originalInput)
       cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices
-      fixityMap = buildFixityMap defaultStrategyThreshold (cfgDependencies cfg)
+      fixityMap =
+        -- It is important to keep all arguments (but last) of
+        -- '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
   when (cfgDebug cfg) $ do

src/Ormolu/Config.hs

@@ -16,10 +16,12 @@ module Ormolu.Config
   )
 where
 
+import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Generics (Generic)
 import qualified GHC.Types.SrcLoc as GHC
+import Ormolu.Fixity (FixityMap)
 import Ormolu.Terminal (ColorMode (..))
 
 -- | Type of sources that can be formatted by Ormolu.
@@ -34,6 +36,8 @@ data SourceType
 data Config region = Config
   { -- | Dynamic options to pass to GHC parser
     cfgDynOptions :: ![DynOption],
+    -- | Fixity overrides
+    cfgFixityOverrides :: FixityMap,
     -- | Known dependencies, if any
     cfgDependencies :: !(Set String),
     -- | Do formatting faster but without automatic detection of defects
@@ -75,6 +79,7 @@ defaultConfig :: Config RegionIndices
 defaultConfig =
   Config
     { cfgDynOptions = [],
+      cfgFixityOverrides = Map.empty,
       cfgDependencies = Set.empty,
       cfgUnsafe = False,
       cfgDebug = False,

src/Ormolu/Exception.hs

@@ -12,12 +12,15 @@ import Control.Exception
 import Control.Monad (forM_)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
+import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Void (Void)
 import GHC.Types.SrcLoc
 import Ormolu.Diff.Text (TextDiff, printTextDiff)
 import Ormolu.Terminal
 import System.Exit (ExitCode (..))
 import System.IO
+import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)
 
 -- | Ormolu exception representing all cases when Ormolu can fail.
 data OrmoluException
@@ -36,6 +39,8 @@ data OrmoluException
   | -- | Missing input file path when using stdin input and
     -- accounting for .cabal files
     OrmoluMissingStdinInputFile
+  | -- | A parse error in a fixity overrides file
+    OrmoluFixityOverridesParseError (ParseErrorBundle Text Void)
   deriving (Eq, Show)
 
 instance Exception OrmoluException
@@ -96,6 +101,9 @@ printOrmoluException = \case
     newline
     put "from stdin and accounting for .cabal files"
     newline
+  OrmoluFixityOverridesParseError errorBundle -> do
+    putS (errorBundlePretty errorBundle)
+    newline
 
 -- | Inside this wrapper 'OrmoluException' will be caught and displayed
 -- nicely.
@@ -120,3 +128,4 @@ withPrettyOrmoluExceptions colorMode m = m `catch` h
           OrmoluUnrecognizedOpts {} -> 7
           OrmoluCabalFileParsingFailed {} -> 8
           OrmoluMissingStdinInputFile {} -> 9
+          OrmoluFixityOverridesParseError {} -> 10

src/Ormolu/Fixity.hs

@@ -99,7 +99,7 @@ buildFixityMap ::
   -- completely rule out conflicting definitions coming from other packages
   -- instead of being merged with them
   Float ->
-  -- | Explicitely known dependencies
+  -- | Explicitly known dependencies
   Set String ->
   -- | Resulting map
   LazyFixityMap
@@ -120,7 +120,7 @@ buildFixityMap' ::
   -- completely rule out conflicting definitions coming from other packages
   -- instead of being merged with them
   Float ->
-  -- | Explicitely known dependencies
+  -- | Explicitly known dependencies
   Set String ->
   -- | Resulting map
   LazyFixityMap

src/Ormolu/Fixity/Internal.hs

@@ -15,9 +15,9 @@ module Ormolu.Fixity.Internal
   )
 where
 
-import Control.Applicative ((<|>))
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
 import qualified Data.Aeson as A
+import Data.Foldable (asum)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Text (Text)
@@ -120,7 +120,7 @@ newtype LazyFixityMap = LazyFixityMap [FixityMap]
 -- different performance depending on whether this is an "unusal"
 -- operator.
 lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
-lookupFixity op (LazyFixityMap maps) = foldr (<|>) Nothing $ Map.lookup op <$> maps
+lookupFixity op (LazyFixityMap maps) = asum (Map.lookup op <$> maps)
 
 -- | The map of operators declared by each package and the popularity of
 -- each package, if available.

src/Ormolu/Fixity/Parser.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+-- | Parser for fixity maps.
+module Ormolu.Fixity.Parser
+  ( parseFixityMap,
+    parseFixityDeclaration,
+  )
+where
+
+import qualified Data.Char as Char
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import Data.Void (Void)
+import Ormolu.Fixity.Internal
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+
+type Parser = Parsec Void Text
+
+-- | Parse textual representation of a 'FixityMap'.
+parseFixityMap ::
+  -- | Location of the file we are parsing (only for parse errors)
+  FilePath ->
+  -- | File contents to parse
+  Text ->
+  -- | Parse result
+  Either (ParseErrorBundle Text Void) FixityMap
+parseFixityMap = runParser pFixityMap
+
+-- | Parse a single self-contained fixity declaration.
+parseFixityDeclaration ::
+  -- | Expression to parse
+  Text ->
+  -- | Parse result
+  Either (ParseErrorBundle Text Void) [(String, FixityInfo)]
+parseFixityDeclaration = runParser (pFixity <* eof) ""
+
+pFixityMap :: Parser FixityMap
+pFixityMap =
+  Map.fromListWith (<>) . mconcat
+    <$> many (pFixity <* newline <* hidden space)
+    <* eof
+
+pFixity :: Parser [(String, FixityInfo)]
+pFixity = do
+  fiDirection <- Just <$> pFixityDirection
+  hidden hspace1
+  fiMinPrecedence <- L.decimal
+  let fiMaxPrecedence = fiMinPrecedence
+  hidden hspace1
+  ops <- sepBy1 pOperator (char ',' >> hidden hspace)
+  hidden hspace
+  let fixityInfo = FixityInfo {..}
+  return ((,fixityInfo) <$> ops)
+
+pFixityDirection :: Parser FixityDirection
+pFixityDirection =
+  choice
+    [ InfixL <$ string "infixl",
+      InfixR <$ string "infixr",
+      InfixN <$ string "infix"
+    ]
+
+-- | See <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html>
+pOperator :: Parser String
+pOperator = tickedOperator <|> normalOperator
+  where
+    tickedOperator = between tick tick haskellIdentifier
+    tick = char '`'
+    haskellIdentifier = do
+      x <- letterChar
+      xs <- many (alphaNumChar <|> char '_' <|> char '\'')
+      return (x : xs)
+    normalOperator = some operatorChar
+    operatorChar =
+      satisfy
+        (\x -> (Char.isSymbol x || Char.isPunctuation x) && x /= ',' && x /= '`')
+        <?> "operator character"

src/Ormolu/Fixity/Printer.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Printer for fixity maps.
+module Ormolu.Fixity.Printer
+  ( printFixityMap,
+  )
+where
+
+import qualified Data.Char as Char
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import Data.Text.Lazy.Builder (Builder)
+import qualified Data.Text.Lazy.Builder as B
+import qualified Data.Text.Lazy.Builder.Int as B
+import Ormolu.Fixity.Internal
+
+-- | Print out a textual representation of a 'FixityMap'.
+printFixityMap :: FixityMap -> Text
+printFixityMap =
+  TL.toStrict
+    . B.toLazyText
+    . mconcat
+    . fmap renderOne
+    . concatMap decompose
+    . Map.toList
+  where
+    decompose :: (String, FixityInfo) -> [(FixityDirection, Int, String)]
+    decompose (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, String) -> Builder
+    renderOne (fixityDirection, n, operator) =
+      mconcat
+        [ case fixityDirection of
+            InfixL -> "infixl"
+            InfixR -> "infixr"
+            InfixN -> "infix",
+          " ",
+          B.decimal n,
+          " ",
+          if isTickedOperator operator
+            then "`" <> B.fromString operator <> "`"
+            else B.fromString operator,
+          "\n"
+        ]
+    isTickedOperator [] = True
+    isTickedOperator (x : _) = Char.isLetter x

src/Ormolu/Parser.hs

@@ -132,6 +132,7 @@ parseModuleSnippet Config {..} fixityMap dynFlags path rawInput = liftIO $ do
                         prPragmas = pragmas,
                         prCommentStream = comments,
                         prExtensions = GHC.extensionFlags dynFlags,
+                        prFixityOverrides = cfgFixityOverrides,
                         prFixityMap = fixityMap,
                         prIndent = indent
                       }

src/Ormolu/Parser/Result.hs

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

src/Ormolu/Printer.hs

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

src/Ormolu/Printer/Combinators.hs

@@ -24,6 +24,7 @@ module Ormolu.Printer.Combinators
     inciIf,
     inciHalf,
     askSourceType,
+    askFixityOverrides,
     askFixityMap,
     located,
     located',

src/Ormolu/Printer/Internal.hs

@@ -19,6 +19,7 @@ module Ormolu.Printer.Internal
     space,
     newline,
     askSourceType,
+    askFixityOverrides,
     askFixityMap,
     inci,
     inciHalf,
@@ -70,7 +71,7 @@ import GHC.LanguageExtensions.Type
 import GHC.Types.SrcLoc
 import GHC.Utils.Outputable (Outputable)
 import Ormolu.Config (SourceType (..))
-import Ormolu.Fixity (LazyFixityMap)
+import Ormolu.Fixity (FixityMap, LazyFixityMap)
 import Ormolu.Parser.CommentStream
 import Ormolu.Printer.SpanStream
 import Ormolu.Utils (showOutputable)
@@ -99,6 +100,10 @@ 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
+    -- 'Ormolu.Fixity.buildFixityMap' by fixity overrides it would break
+    -- memoization
+    rcFixityOverrides :: FixityMap,
     -- | Fixity map for operators
     rcFixityMap :: LazyFixityMap
   }
@@ -168,11 +173,13 @@ runR ::
   SourceType ->
   -- | Enabled extensions
   EnumSet Extension ->
+  -- | Fixity overrides
+  FixityMap ->
   -- | Fixity map
   LazyFixityMap ->
   -- | Resulting rendition
   Text
-runR (R m) sstream cstream sourceType extensions fixityMap =
+runR (R m) sstream cstream sourceType extensions fixityOverrides fixityMap =
   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc
   where
     rc =
@@ -183,6 +190,7 @@ runR (R m) sstream cstream sourceType extensions fixityMap =
           rcCanUseBraces = False,
           rcExtensions = extensions,
           rcSourceType = sourceType,
+          rcFixityOverrides = fixityOverrides,
           rcFixityMap = fixityMap
         }
     sc =
@@ -380,6 +388,11 @@ newlineRaw = R . modify $ \sc ->
 askSourceType :: R SourceType
 askSourceType = R (asks rcSourceType)
 
+-- | Retrieve fixity overrides map.
+askFixityOverrides :: R FixityMap
+askFixityOverrides = R (asks rcFixityOverrides)
+
+-- | Retrieve the lazy fixity map.
 askFixityMap :: R LazyFixityMap
 askFixityMap = R (asks rcFixityMap)
 

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

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

src/Ormolu/Printer/Meat/Type.hs

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

src/Ormolu/Printer/Operators.hs

@@ -12,7 +12,9 @@ module Ormolu.Printer.Operators
   )
 where
 
+import Control.Applicative ((<|>))
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import GHC.Types.Name.Occurrence (occNameString)
 import GHC.Types.Name.Reader
@@ -89,20 +91,24 @@ opTreeLoc (OpBranches exprs _) =
 reassociateOpTree ::
   -- | How to get name of an operator
   (op -> Maybe RdrName) ->
+  -- | Fixity overrides
+  FixityMap ->
   -- | Fixity Map
   LazyFixityMap ->
   -- | Original 'OpTree'
   OpTree ty op ->
   -- | Re-associated 'OpTree', with added context and info around operators
   OpTree ty (OpInfo op)
-reassociateOpTree getOpName fixityMap =
+reassociateOpTree getOpName fixityOverrides fixityMap =
   reassociateFlatOpTree
     . makeFlatOpTree
-    . addFixityInfo fixityMap getOpName
+    . addFixityInfo fixityOverrides fixityMap 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 ->
   -- | How to get the name of an operator
@@ -111,10 +117,10 @@ addFixityInfo ::
   OpTree ty op ->
   -- | 'OpTree', with fixity info wrapped around each operator
   OpTree ty (OpInfo op)
-addFixityInfo _ _ (OpNode n) = OpNode n
-addFixityInfo fixityMap getOpName (OpBranches exprs ops) =
+addFixityInfo _ _ _ (OpNode n) = OpNode n
+addFixityInfo fixityOverrides fixityMap getOpName (OpBranches exprs ops) =
   OpBranches
-    (addFixityInfo fixityMap getOpName <$> exprs)
+    (addFixityInfo fixityOverrides fixityMap getOpName <$> exprs)
     (toOpInfo <$> ops)
   where
     toOpInfo o = OpInfo o mName fixityInfo
@@ -123,7 +129,10 @@ addFixityInfo fixityMap getOpName (OpBranches exprs ops) =
         fixityInfo =
           fromMaybe
             defaultFixityInfo
-            (mName >>= flip lookupFixity fixityMap)
+            ( 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.

src/Ormolu/Utils/Cabal.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -40,11 +39,13 @@ import System.IO.Error (isDoesNotExistError)
 -- | Cabal information of interest to Ormolu.
 data CabalInfo = CabalInfo
   { -- | Package name
-    ciPackageName :: Maybe String,
+    ciPackageName :: !(Maybe String),
     -- | Extension and language settings in the form of 'DynOption's
-    ciDynOpts :: [DynOption],
+    ciDynOpts :: ![DynOption],
     -- | Direct dependencies
-    ciDependencies :: Set String
+    ciDependencies :: !(Set String),
+    -- | Absolute path to the cabal file, if it was found
+    ciCabalFilePath :: !(Maybe FilePath)
   }
   deriving (Eq, Show)
 
@@ -54,7 +55,8 @@ defaultCabalInfo =
   CabalInfo
     { ciPackageName = Nothing,
       ciDynOpts = [],
-      ciDependencies = Set.empty
+      ciDependencies = Set.empty,
+      ciCabalFilePath = Nothing
     }
 
 -- | Locate .cabal file corresponding to the given Haskell source file and
@@ -136,7 +138,8 @@ parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do
     CabalInfo
       { ciPackageName = Just packageName,
         ciDynOpts = dynOpts,
-        ciDependencies = Set.fromList dependencies
+        ciDependencies = Set.fromList dependencies,
+        ciCabalFilePath = Just cabalFile
       }
 
 -- | Get a map from Haskell source file paths (without any extensions) to

src/Ormolu/Utils/Fixity.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Ormolu.Utils.Fixity
+  ( getFixityOverridesForSourceFile,
+    parseFixityDeclarationStr,
+  )
+where
+
+import Control.Exception (throwIO)
+import Control.Monad.IO.Class
+import Data.Bifunctor (first)
+import Data.IORef
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Ormolu.Exception
+import Ormolu.Fixity
+import Ormolu.Fixity.Parser
+import Ormolu.Utils.Cabal
+import Ormolu.Utils.IO (readFileUtf8)
+import System.Directory
+import System.FilePath
+import System.IO.Unsafe (unsafePerformIO)
+import Text.Megaparsec (errorBundlePretty)
+
+-- | Cache ref that stores fixity overrides per cabal file.
+cacheRef :: IORef (Map FilePath FixityMap)
+cacheRef = unsafePerformIO (newIORef Map.empty)
+{-# NOINLINE cacheRef #-}
+
+-- | Attempt to locate and parse a @.ormolu@ file. If it does not exist,
+-- empty fixity map is returned. This function maintains a cache of fixity
+-- overrides where cabal file paths act as keys.
+getFixityOverridesForSourceFile ::
+  MonadIO m =>
+  -- | 'CabalInfo' already obtained for this source file
+  CabalInfo ->
+  m FixityMap
+getFixityOverridesForSourceFile CabalInfo {..} = liftIO $ do
+  case ciCabalFilePath of
+    Nothing -> return Map.empty
+    Just cabalPath -> do
+      cache <- readIORef cacheRef
+      case Map.lookup cabalPath cache of
+        Nothing -> do
+          let dotOrmolu = replaceFileName cabalPath ".ormolu"
+          exists <- doesFileExist dotOrmolu
+          if exists
+            then do
+              dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmolu
+              contents <- readFileUtf8 dotOrmolu
+              case parseFixityMap dotOrmoluRelative contents of
+                Left errorBundle ->
+                  throwIO (OrmoluFixityOverridesParseError errorBundle)
+                Right x -> do
+                  modifyIORef' cacheRef (Map.insert cabalPath x)
+                  return x
+            else return Map.empty
+        Just x -> return x
+
+-- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity
+-- definitions.
+parseFixityDeclarationStr ::
+  -- | Input to parse
+  String ->
+  -- | Parse result
+  Either String [(String, FixityInfo)]
+parseFixityDeclarationStr =
+  first errorBundlePretty . parseFixityDeclaration . T.pack

tests/Ormolu/CabalInfoSpec.hs

@@ -38,7 +38,7 @@ spec = do
       ciDynOpts `shouldBe` [DynOption "-XHaskell2010"]
     it "extracts correct dependencies from ormolu.cabal (src/Ormolu/Config.hs)" $ do
       CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs"
-      ciDependencies `shouldBe` Set.fromList ["Cabal", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "bytestring", "containers", "directory", "dlist", "exceptions", "file-embed", "filepath", "ghc-lib-parser", "mtl", "syb", "template-haskell", "text", "th-lift-instances"]
+      ciDependencies `shouldBe` Set.fromList ["Cabal", "Diff", "MemoTrie", "aeson", "ansi-terminal", "array", "base", "bytestring", "containers", "directory", "dlist", "exceptions", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "template-haskell", "text", "th-lift-instances"]
     it "extracts correct dependencies from ormolu.cabal (tests/Ormolu/PrinterSpec.hs)" $ do
       CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "tests/Ormolu/PrinterSpec.hs"
-      ciDependencies `shouldBe` Set.fromList ["base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "ormolu", "path", "path-io", "temporary", "text"]
+      ciDependencies `shouldBe` Set.fromList ["QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"]

tests/Ormolu/Fixity/ParserSpec.hs

@@ -0,0 +1,129 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Ormolu.Fixity.ParserSpec (spec) where
+
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Ormolu.Fixity
+import Ormolu.Fixity.Parser
+import Test.Hspec
+import Test.Hspec.Megaparsec
+
+spec :: Spec
+spec = do
+  describe "parseFixtiyDeclaration" $ do
+    it "parses a simple infixr declaration" $
+      parseFixityDeclaration "infixr 5 $"
+        `shouldParse` [("$", FixityInfo (Just InfixR) 5 5)]
+    it "parses a simple infixl declaration" $
+      parseFixityDeclaration "infixl 5 $"
+        `shouldParse` [("$", FixityInfo (Just InfixL) 5 5)]
+    it "parses a simple infix declaration" $
+      parseFixityDeclaration "infix 5 $"
+        `shouldParse` [("$", FixityInfo (Just InfixN) 5 5)]
+    it "parses a declaration for a ticked identifier" $
+      parseFixityDeclaration "infixl 5 `foo`"
+        `shouldParse` [("foo", FixityInfo (Just InfixL) 5 5)]
+    it "parses a declaration for a ticked identifier (constructor case)" $
+      parseFixityDeclaration "infixl 5 `Foo`"
+        `shouldParse` [("Foo", FixityInfo (Just InfixL) 5 5)]
+    it "parses a multi-operator declaration" $
+      parseFixityDeclaration "infixl 5 $, ., `Foo`, `bar`"
+        `shouldParse` [ ("$", FixityInfo (Just InfixL) 5 5),
+                        (".", FixityInfo (Just InfixL) 5 5),
+                        ("Foo", FixityInfo (Just InfixL) 5 5),
+                        ("bar", FixityInfo (Just InfixL) 5 5)
+                      ]
+    it "parses a declaration with a unicode operator" $
+      parseFixityDeclaration "infixr 5 ×"
+        `shouldParse` [("×", FixityInfo (Just InfixR) 5 5)]
+    it "fails with correct parse error (keyword wrong)" $
+      parseFixityDeclaration "foobar 5 $"
+        `shouldFailWith` err
+          0
+          ( mconcat
+              [ utoks "foobar",
+                etoks "infix",
+                etoks "infixl",
+                etoks "infixr"
+              ]
+          )
+    it "fails with correct parse error (missing operator)" $
+      parseFixityDeclaration "infixr 5 "
+        `shouldFailWith` err
+          9
+          ( mconcat
+              [ ueof,
+                etok '`',
+                elabel "operator character"
+              ]
+          )
+    it "fails with correct parse error (trailing comma)" $
+      parseFixityDeclaration "infixr 5 ., "
+        `shouldFailWith` err
+          12
+          ( mconcat
+              [ ueof,
+                etok '`',
+                elabel "operator character"
+              ]
+          )
+  describe "parseFixityMap" $ do
+    it "parses the empty input without choking" $
+      parseFixityMap "" ""
+        `shouldParse` Map.empty
+    it "parses a collection of declarations" $
+      -- The example is taken from base.
+      parseFixityMap
+        ""
+        ( T.unlines
+            [ "infixr 9  .",
+              "infixr 5  ++",
+              "infixl 4  <$",
+              "infixl 1  >>, >>=",
+              "infixr 1  =<<",
+              "infixr 0  $, $!",
+              "infixl 4 <*>, <*, *>, <**>"
+            ]
+        )
+        `shouldParse` Map.fromList
+          [ ("$", FixityInfo (Just InfixR) 0 0),
+            ("$!", FixityInfo (Just InfixR) 0 0),
+            ("*>", FixityInfo (Just InfixL) 4 4),
+            ("++", FixityInfo (Just InfixR) 5 5),
+            (".", FixityInfo (Just InfixR) 9 9),
+            ("<$", FixityInfo (Just InfixL) 4 4),
+            ("<*", FixityInfo (Just InfixL) 4 4),
+            ("<**>", FixityInfo (Just InfixL) 4 4),
+            ("<*>", FixityInfo (Just InfixL) 4 4),
+            ("=<<", FixityInfo (Just InfixR) 1 1),
+            (">>", FixityInfo (Just InfixL) 1 1),
+            (">>=", FixityInfo (Just InfixL) 1 1)
+          ]
+    it "combines conflicting declarations correctly" $
+      parseFixityMap
+        ""
+        ( T.unlines
+            [ "infixr 9 ., ^",
+              "infixr 7 ., $",
+              "infixr 9 ^ ",
+              "infixl 7 $"
+            ]
+        )
+        `shouldParse` Map.fromList
+          [ ("$", FixityInfo Nothing 7 7),
+            (".", FixityInfo (Just InfixR) 7 9),
+            ("^", FixityInfo (Just InfixR) 9 9)
+          ]
+    it "fails with correct parse error (keyword wrong second line)" $
+      parseFixityMap "" "infixr 5 .\nfoobar 5 $"
+        `shouldFailWith` err
+          11
+          ( mconcat
+              [ utok 'f',
+                etoks "infix",
+                etoks "infixl",
+                etoks "infixr",
+                eeof
+              ]
+          )

tests/Ormolu/Fixity/PrinterSpec.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Ormolu.Fixity.PrinterSpec (spec) where
+
+import qualified Data.Char as Char
+import qualified Data.Map.Strict as Map
+import Ormolu.Fixity
+import Ormolu.Fixity.Parser
+import Ormolu.Fixity.Printer
+import Test.Hspec
+import Test.Hspec.Megaparsec
+import Test.QuickCheck
+
+newtype FixityMapWrapper = FixityMapWrapper FixityMap
+  deriving (Show)
+
+instance Arbitrary FixityMapWrapper where
+  arbitrary =
+    FixityMapWrapper . Map.fromListWith (<>)
+      <$> listOf ((,) <$> genOperator <*> genFixityInfo)
+    where
+      scaleDown = scale (`div` 4)
+      genOperator = oneof [genNormalOperator, genIdentifier]
+      genNormalOperator =
+        listOf1 (scaleDown arbitrary `suchThat` isOperatorConstituent)
+      isOperatorConstituent x =
+        (Char.isSymbol x || Char.isPunctuation x) && x /= ',' && x /= '`'
+      genIdentifier = do
+        x <- arbitrary `suchThat` Char.isLetter
+        xs <- listOf1 (scaleDown arbitrary `suchThat` isIdentifierConstituent)
+        return (x : xs)
+      isIdentifierConstituent x = Char.isAlphaNum x || x == '_' || x == '\''
+      genFixityInfo = do
+        fiDirection <-
+          elements
+            [ Nothing,
+              Just InfixL,
+              Just InfixR,
+              Just InfixN
+            ]
+        fiMinPrecedence <- chooseInt (0, 9)
+        fiMaxPrecedence <- chooseInt (0, 9) `suchThat` (>= fiMinPrecedence)
+        return FixityInfo {..}
+
+spec :: Spec
+spec = do
+  describe "parseFixityMap & printFixityMap" $
+    it "arbitrary fixity maps are printed and parsed back correctly" $
+      property $ \(FixityMapWrapper fixityMap) ->
+        parseFixityMap "" (printFixityMap fixityMap) `shouldParse` fixityMap

tests/Ormolu/OpTreeSpec.hs

@@ -27,7 +27,7 @@ checkReassociate lFixities inputTree expectedOutputTree =
     removeOpInfo (OpNode x) = OpNode x
     removeOpInfo (OpBranches exprs ops) =
       OpBranches (removeOpInfo <$> exprs) (opiOp <$> ops)
-    actualOutputTree = reassociateOpTree convertName fixityMap inputTree
+    actualOutputTree = reassociateOpTree convertName Map.empty fixityMap inputTree
     fixityMap = LazyFixityMap [Map.fromList lFixities]
     convertName = Just . mkRdrUnqual . mkOccName varName
 

tests/Ormolu/PrinterSpec.hs

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