Use Choice for askDebug

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,

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)

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)

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

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

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

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