diff --git a/ormolu.cabal b/ormolu.cabal index af51919e..dec88ddf 100644 --- a/ormolu.cabal +++ b/ormolu.cabal @@ -176,6 +176,7 @@ test-suite tests Cabal-syntax >=3.12 && <3.13, QuickCheck >=2.14, base >=4.14 && <5, + choice >= 0.1 && < 0.3, containers >=0.5 && <0.8, directory ^>=1.3, filepath >=1.2 && <1.6, diff --git a/src/Ormolu/Fixity/Internal.hs b/src/Ormolu/Fixity/Internal.hs index 0bd7a319..3633a828 100644 --- a/src/Ormolu/Fixity/Internal.hs +++ b/src/Ormolu/Fixity/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} @@ -33,6 +34,8 @@ import Control.DeepSeq (NFData) import Data.Binary (Binary) import Data.ByteString.Short (ShortByteString) import Data.ByteString.Short qualified as SBS +import Data.Choice (Choice) +import Data.Choice qualified as Choice import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) @@ -259,7 +262,7 @@ data FixityQualification -- | Get a 'FixityApproximation' of an operator. inferFixity :: -- | Whether to print debug info regarding fixity inference - Bool -> + Choice "debug" -> -- | Operator name RdrName -> -- | Module fixity map @@ -267,7 +270,7 @@ inferFixity :: -- | The resulting fixity approximation FixityApproximation inferFixity debug rdrName (ModuleFixityMap m) = - if debug + if Choice.toBool debug then trace (renderFixityJustification opName moduleName m result) diff --git a/src/Ormolu/Printer/Internal.hs b/src/Ormolu/Printer/Internal.hs index 2fc2c217..d1913f1e 100644 --- a/src/Ormolu/Printer/Internal.hs +++ b/src/Ormolu/Printer/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -59,6 +60,8 @@ import Control.Monad import Control.Monad.Reader import Control.Monad.State.Strict import Data.Bool (bool) +import Data.Choice (Choice) +import Data.Choice qualified as Choice import Data.Coerce import Data.Functor ((<&>)) import Data.List (find) @@ -393,8 +396,8 @@ askModuleFixityMap = R (asks rcModuleFixityMap) -- | Retrieve whether we should print out certain debug information while -- printing. -askDebug :: R Bool -askDebug = R (asks rcDebug) +askDebug :: R (Choice "debug") +askDebug = R (asks (Choice.fromBool . rcDebug)) inciBy :: Int -> R () -> R () inciBy step (R m) = R (local modRC m) diff --git a/src/Ormolu/Printer/Operators.hs b/src/Ormolu/Printer/Operators.hs index 35daaf6a..bf511a07 100644 --- a/src/Ormolu/Printer/Operators.hs +++ b/src/Ormolu/Printer/Operators.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PatternSynonyms #-} @@ -13,6 +14,7 @@ module Ormolu.Printer.Operators ) where +import Data.Choice (Choice) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import GHC.Parser.Annotation @@ -92,7 +94,7 @@ opTreeLoc (OpBranches exprs _) = -- re-associate it using this function before printing. reassociateOpTree :: -- | Whether to print debug info regarding fixity inference - Bool -> + Choice "debug" -> -- | How to get name of an operator (op -> Maybe RdrName) -> -- | Fixity Map @@ -110,7 +112,7 @@ reassociateOpTree debug getOpName modFixityMap = -- about its fixity (extracted from the specified fixity map). addFixityInfo :: -- | Whether to print debug info regarding fixity inference - Bool -> + Choice "debug" -> -- | Fixity map for operators ModuleFixityMap -> -- | How to get the name of an operator diff --git a/tests/Ormolu/CabalInfoSpec.hs b/tests/Ormolu/CabalInfoSpec.hs index b5e69d30..8bf070ee 100644 --- a/tests/Ormolu/CabalInfoSpec.hs +++ b/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", "megaparsec", "ormolu", "path", "path-io", "temporary", "text"] + Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "choice", "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 diff --git a/tests/Ormolu/FixitySpec.hs b/tests/Ormolu/FixitySpec.hs index 217f7e91..2860c9a5 100644 --- a/tests/Ormolu/FixitySpec.hs +++ b/tests/Ormolu/FixitySpec.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Ormolu.FixitySpec (spec) where +import Data.Choice (pattern Without) import Data.Function ((&)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict qualified as Map @@ -261,7 +264,7 @@ checkFixities dependencies fixityImports expectedResult = where actualResult = fmap - (\(k, _) -> (k, inferFixity False k resultMap)) + (\(k, _) -> (k, inferFixity (Without #debug) k resultMap)) expectedResult resultMap = moduleFixityMap diff --git a/tests/Ormolu/OpTreeSpec.hs b/tests/Ormolu/OpTreeSpec.hs index a4c7f6ac..0c383c35 100644 --- a/tests/Ormolu/OpTreeSpec.hs +++ b/tests/Ormolu/OpTreeSpec.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} module Ormolu.OpTreeSpec (spec) where +import Data.Choice (pattern Without) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T @@ -31,7 +34,7 @@ checkReassociate fixities inputTree expectedOutputTree = removeOpInfo (OpNode x) = OpNode x removeOpInfo (OpBranches exprs ops) = OpBranches (removeOpInfo <$> exprs) (opiOp <$> ops) - actualOutputTree = reassociateOpTree False convertName modFixityMap inputTree + actualOutputTree = reassociateOpTree (Without #debug) convertName modFixityMap inputTree modFixityMap = ModuleFixityMap (Map.map Given (Map.fromList fixities)) convertName = Just . mkRdrUnqual . mkOccName varName . T.unpack . unOpName