diff --git a/CHANGELOG.md b/CHANGELOG.md index c3d11ec1..bc45fba3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,9 @@ * Format multiple files in parallel. [Issue 1128](https://github.com/tweag/ormolu/issues/1128). +* Fractional precedences are now allowed in `.ormolu` files for more precise + control over formatting of complex operator chains. [Issue + 1106](https://github.com/tweag/ormolu/issues/1106). * Correctly format type applications of `QuasiQuotes`. [Issue 1134](https://github.com/tweag/ormolu/issues/1134). diff --git a/README.md b/README.md index 4a7be510..d9cabe7e 100644 --- a/README.md +++ b/README.md @@ -184,10 +184,16 @@ infixl 1 >>, >>= infixr 1 =<< infixr 0 $, $! infixl 4 <*>, <*, *>, <**> + +infixr 3 >~< +infixr 3.3 |~| +infixr 3.7 <~> ``` It uses exactly the same syntax as usual Haskell fixity declarations to make -it easier for Haskellers to edit and maintain. +it easier for Haskellers to edit and maintain. Since Ormolu 0.7.8.0 +fractional precedences are supported for more precise control over +formatting of complex operator chains. As of Ormolu 0.7.0.0, `.ormolu` files can also contain instructions about module re-exports that Ormolu should be aware of. This might be desirable diff --git a/data/examples/declaration/value/function/infix/fractional-precedence-out.hs b/data/examples/declaration/value/function/infix/fractional-precedence-out.hs new file mode 100644 index 00000000..0dd82860 --- /dev/null +++ b/data/examples/declaration/value/function/infix/fractional-precedence-out.hs @@ -0,0 +1,3 @@ +startFormTok |~| messageTag + >~< startMessageTok |~| name + >~< p' |~| endMessageTok |~| endFormTok diff --git a/data/examples/declaration/value/function/infix/fractional-precedence.hs b/data/examples/declaration/value/function/infix/fractional-precedence.hs new file mode 100644 index 00000000..0dd82860 --- /dev/null +++ b/data/examples/declaration/value/function/infix/fractional-precedence.hs @@ -0,0 +1,3 @@ +startFormTok |~| messageTag + >~< startMessageTok |~| name + >~< p' |~| endMessageTok |~| endFormTok diff --git a/extract-hackage-info/hackage-info.bin b/extract-hackage-info/hackage-info.bin index b3a3d5cd..724e67a6 100644 Binary files a/extract-hackage-info/hackage-info.bin and b/extract-hackage-info/hackage-info.bin differ diff --git a/src/Ormolu/Fixity/Internal.hs b/src/Ormolu/Fixity/Internal.hs index 29b348ce..4c846022 100644 --- a/src/Ormolu/Fixity/Internal.hs +++ b/src/Ormolu/Fixity/Internal.hs @@ -32,6 +32,9 @@ where import Control.DeepSeq (NFData) import Data.Binary (Binary) +import Data.Binary qualified as Binary +import Data.Binary.Get qualified as Binary +import Data.Binary.Put qualified as Binary import Data.ByteString.Short (ShortByteString) import Data.ByteString.Short qualified as SBS import Data.Choice (Choice) @@ -96,10 +99,20 @@ data FixityInfo = FixityInfo { -- | Fixity direction fiDirection :: FixityDirection, -- | Precedence - fiPrecedence :: Int + fiPrecedence :: Double } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Binary, NFData) + deriving anyclass (NFData) + +instance Binary FixityInfo where + put FixityInfo {..} = do + Binary.put fiDirection + Binary.putDoublele fiPrecedence + + get = do + fiDirection <- Binary.get + fiPrecedence <- Binary.getDoublele + pure FixityInfo {..} -- | Fixity info of the built-in colon data constructor. colonFixityInfo :: FixityInfo @@ -116,13 +129,25 @@ data FixityApproximation = FixityApproximation faDirection :: Maybe FixityDirection, -- | Minimum precedence level found in the (maybe conflicting) -- definitions for the operator (inclusive) - faMinPrecedence :: Int, + faMinPrecedence :: Double, -- | Maximum precedence level found in the (maybe conflicting) -- definitions for the operator (inclusive) - faMaxPrecedence :: Int + faMaxPrecedence :: Double } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Binary, NFData) + deriving anyclass (NFData) + +instance Binary FixityApproximation where + put FixityApproximation {..} = do + Binary.put faDirection + Binary.putDoublele faMinPrecedence + Binary.putDoublele faMaxPrecedence + + get = do + faDirection <- Binary.get + faMinPrecedence <- Binary.getDoublele + faMaxPrecedence <- Binary.getDoublele + pure FixityApproximation {..} -- | Gives the ability to merge two (maybe conflicting) definitions for an -- operator, keeping the higher level of compatible information from both. diff --git a/src/Ormolu/Fixity/Parser.hs b/src/Ormolu/Fixity/Parser.hs index fa1c7f3e..cc291c0d 100644 --- a/src/Ormolu/Fixity/Parser.hs +++ b/src/Ormolu/Fixity/Parser.hs @@ -103,7 +103,9 @@ pFixity = do fiDirection <- pFixityDirection hidden hspace1 offsetAtPrecedence <- getOffset - fiPrecedence <- L.decimal + fiPrecedence <- + try L.float + <|> (fromIntegral <$> (L.decimal :: Parser Integer)) when (fiPrecedence > 9) $ region (setErrorOffset offsetAtPrecedence) diff --git a/src/Ormolu/Fixity/Printer.hs b/src/Ormolu/Fixity/Printer.hs index da1c72c9..ba6c6568 100644 --- a/src/Ormolu/Fixity/Printer.hs +++ b/src/Ormolu/Fixity/Printer.hs @@ -19,6 +19,7 @@ import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Builder (Builder) import Data.Text.Lazy.Builder qualified as B import Data.Text.Lazy.Builder.Int qualified as B +import Data.Text.Lazy.Builder.RealFloat qualified as B import Distribution.ModuleName (ModuleName) import Distribution.ModuleName qualified as ModuleName import Distribution.Types.PackageName @@ -44,7 +45,7 @@ renderSingleFixityOverride (OpName operator, FixityInfo {..}) = InfixR -> "infixr" InfixN -> "infix", " ", - B.decimal fiPrecedence, + renderPrecedence fiPrecedence, " ", if isTickedOperator operator then "`" <> B.fromText operator <> "`" @@ -75,3 +76,12 @@ renderSingleModuleReexport (exportingModule, exports) = renderModuleName :: ModuleName -> Builder renderModuleName = B.fromString . intercalate "." . ModuleName.components + +-- | Render precedence using integer representation for whole numbers. +renderPrecedence :: Double -> Builder +renderPrecedence x = + let (n :: Int, fraction :: Double) = properFraction x + isWholeEnough = fraction < 0.0001 + in if isWholeEnough + then B.decimal n + else B.realFloat x diff --git a/tests/Ormolu/Fixity/ParserSpec.hs b/tests/Ormolu/Fixity/ParserSpec.hs index 54dd5503..d6aa4904 100644 --- a/tests/Ormolu/Fixity/ParserSpec.hs +++ b/tests/Ormolu/Fixity/ParserSpec.hs @@ -35,6 +35,18 @@ spec = do `shouldParse` ( exampleFixityOverrides, ModuleReexports Map.empty ) + it "accepts fractional operator precedences" $ + parseDotOrmolu + "" + ( T.unlines + [ "infixr 3 >~<", + "infixr 3.3 |~|", + "infixr 3.7 <~>" + ] + ) + `shouldParse` ( fractionalFixityOverrides, + ModuleReexports Map.empty + ) it "combines conflicting fixity declarations correctly" $ parseDotOrmolu "" @@ -231,6 +243,16 @@ exampleFixityOverrides = ] ) +fractionalFixityOverrides :: FixityOverrides +fractionalFixityOverrides = + FixityOverrides + ( Map.fromList + [ (">~<", FixityInfo InfixR 3), + ("|~|", FixityInfo InfixR 3.3), + ("<~>", FixityInfo InfixR 3.7) + ] + ) + exampleModuleReexports :: ModuleReexports exampleModuleReexports = ModuleReexports . Map.fromList $ diff --git a/tests/Ormolu/Fixity/PrinterSpec.hs b/tests/Ormolu/Fixity/PrinterSpec.hs index 4eb1867a..75802f2e 100644 --- a/tests/Ormolu/Fixity/PrinterSpec.hs +++ b/tests/Ormolu/Fixity/PrinterSpec.hs @@ -37,7 +37,12 @@ instance Arbitrary FixityOverrides where InfixR, InfixN ] - fiPrecedence <- chooseInt (0, 9) + precedenceWholePart <- fromIntegral <$> chooseInt (0, 9) + precedenceFractionalPart <- + if precedenceWholePart < 9.0 + then (* 0.1) . fromIntegral <$> chooseInt (0, 1) + else return 0 + let fiPrecedence = precedenceWholePart + precedenceFractionalPart return FixityInfo {..} instance Arbitrary ModuleReexports where diff --git a/tests/Ormolu/PrinterSpec.hs b/tests/Ormolu/PrinterSpec.hs index 42c81285..ab0d2666 100644 --- a/tests/Ormolu/PrinterSpec.hs +++ b/tests/Ormolu/PrinterSpec.hs @@ -31,7 +31,10 @@ testsuiteOverrides = FixityOverrides ( Map.fromList [ (".=", FixityInfo InfixR 8), - ("#", FixityInfo InfixR 5) + ("#", FixityInfo InfixR 5), + (">~<", FixityInfo InfixR 3), + ("|~|", FixityInfo InfixR 3.3), + ("<~>", FixityInfo InfixR 3.7) ] )