ormolu 0.7.2.0 → 0.7.3.0

raw patch · 32 files changed

+218/−139 lines, 32 filesdep ~Diffdep ~basedep ~containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Diff, base, containers, ghc-lib-parser, hspec, megaparsec, mtl, path-io, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• Setup.hs +0/−6
• data/examples/declaration/data/invisible-binders-out.hs +2/−0
• data/examples/declaration/data/invisible-binders.hs +2/−0
• data/examples/declaration/signature/fixity/infix-out.hs +2/−0
• data/examples/declaration/signature/fixity/infix.hs +2/−0
• data/examples/declaration/value/function/primitive-literals-out.hs +10/−0
• data/examples/declaration/value/function/primitive-literals.hs +9/−0
• data/examples/declaration/warning/warning-single-line-out.hs +3/−0
• data/examples/declaration/warning/warning-single-line.hs +3/−0
• data/examples/import/deprecated-export-multi-line-out.hs +7/−0
• data/examples/import/deprecated-export-multi-line.hs +5/−0
• data/examples/import/deprecated-export-single-line-out.hs +3/−0
• data/examples/import/deprecated-export-single-line.hs +1/−0
• ormolu.cabal +19/−19
• src/Ormolu.hs +7/−4
• src/Ormolu/Fixity/Imports.hs +1/−1
• src/Ormolu/Imports.hs +9/−9
• src/Ormolu/Parser.hs +5/−6
• src/Ormolu/Printer/Meat/Common.hs +4/−1
• src/Ormolu/Printer/Meat/Declaration.hs +3/−1
• src/Ormolu/Printer/Meat/Declaration/Data.hs +10/−6
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +8/−1
• src/Ormolu/Printer/Meat/Declaration/OpTree.hs +13/−17
• src/Ormolu/Printer/Meat/Declaration/Value.hs +11/−14
• src/Ormolu/Printer/Meat/Declaration/Value.hs-boot +2/−1
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +12/−4
• src/Ormolu/Printer/Meat/ImportExport.hs +6/−1
• src/Ormolu/Printer/Meat/Module.hs +1/−1
• src/Ormolu/Printer/Meat/Type.hs +24/−29
• src/Ormolu/Printer/Operators.hs +23/−18
• tests/Ormolu/OpTreeSpec.hs +1/−0

@@ -1,3 +1,13 @@+## Ormolu 0.7.3.0++* Switched to `ghc-lib-parser-9.8`, with the following new syntactic features:+  * `ExtendedLiterals`: `123#Int8` is a literal of type `Int8#`. (disabled by+    default)+  * `TypeAbstractions`: `@k`-binders in data type declarations (enabled by+    default)+  * GHC proposal [#134](https://github.com/ghc-proposals/ghc-proposals/blob/0b652bd70258e354dfe4a05940182007596f8bf7/proposals/0134-deprecating-exports-proposal.rst): deprecating/warning about exports+  * GHC proposal [#541](https://github.com/ghc-proposals/ghc-proposals/blob/0b652bd70258e354dfe4a05940182007596f8bf7/proposals/0541-warning-pragmas-with-categories.rst): warning categories+ ## Ormolu 0.7.2.0  * Preserve necessary braces for final function arguments. [Issue

@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain

@@ -0,0 +1,2 @@+type T :: forall k. k -> forall j. j -> Type+data T @k (a :: k) @(j :: Type) (b :: j)

@@ -0,0 +1,2 @@+type T :: forall k. k -> forall j. j -> Type+data T @k (a :: k) @(j :: Type) (b :: j)

@@ -1,3 +1,5 @@ infix 0 <?>  infix 9 <^-^>++infix 2 ->

@@ -1,2 +1,4 @@ infix 0 <?> infix 9 <^-^>++infix 2 ->

@@ -0,0 +1,10 @@+{-# LANGUAGE ExtendedLiterals #-}+{-# LANGUAGE MagicHash #-}++foo = 1#++bar = 2##++baz = 3#Word32++baz = 0b1010#Int64

@@ -0,0 +1,9 @@+{-# LANGUAGE ExtendedLiterals, MagicHash #-}++foo = 1#++bar = 2##++baz = 3#Word32++baz =  0b1010#Int64

@@ -11,3 +11,6 @@  data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-}++head (a : _) = a+{-# WARNING in "x-partial" head "This function is partial..." #-}

@@ -13,3 +13,6 @@  data Number = Number Dobule {-# DEPRECATED Number "Use Scientific instead." #-}++head (a:_) = a+{-# WARNING in "x-partial" head "This function is partial..." #-}

@@ -0,0 +1,7 @@+module X+  ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-}+    D (D1, D2),+  )+where++data D = D1 | D2

@@ -0,0 +1,5 @@+module X+    ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-}+      D(D1, D2)+    ) where+data D = D1 | D2

@@ -0,0 +1,3 @@+module A ({-# DEPRECATED "blah" #-} x) where++x = True

@@ -0,0 +1,1 @@+module A ( {-# DEPRECATED "blah" #-} x ) where { x = True }

@@ -1,10 +1,10 @@ cabal-version:      2.4 name:               ormolu-version:            0.7.2.0+version:            0.7.3.0 license:            BSD-3-Clause license-file:       LICENSE.md maintainer:         Mark Karpov <mark.karpov@tweag.io>-tested-with:        ghc ==9.2.8 ghc ==9.4.5 ghc ==9.6.2+tested-with:        ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1 homepage:           https://github.com/tweag/ormolu bug-reports:        https://github.com/tweag/ormolu/issues synopsis:           A formatter for Haskell source code@@ -98,23 +98,23 @@     default-language: GHC2021     build-depends:         Cabal-syntax >=3.10 && <3.11,-        Diff >=0.4 && <1.0,+        Diff >=0.4 && <1,         MemoTrie >=0.6 && <0.7,         ansi-terminal >=0.10 && <1.1,         array >=0.5 && <0.6,-        base >=4.14 && <5.0,+        base >=4.14 && <5,         binary >=0.8 && <0.9,         bytestring >=0.2 && <0.13,-        containers >=0.5 && <0.7,+        containers >=0.5 && <0.8,         deepseq >=1.4 && <1.6,         directory ^>=1.3,         file-embed >=0.0.15 && <0.1,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,-        megaparsec >=9.0,-        mtl >=2.0 && <3.0,+        ghc-lib-parser >=9.8 && <9.9,+        megaparsec >=9,+        mtl >=2 && <3,         syb >=0.7 && <0.8,-        text >=2.0 && <3.0+        text >=2 && <3      if flag(dev)         ghc-options:@@ -135,14 +135,14 @@     default-language: GHC2021     build-depends:         Cabal-syntax >=3.10 && <3.11,-        base >=4.12 && <5.0,+        base >=4.12 && <5,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,+        ghc-lib-parser >=9.8 && <9.9,         optparse-applicative >=0.14 && <0.19,         ormolu,-        text >=2.0 && <3.0,+        text >=2 && <3,         th-env >=0.1.1 && <0.2      if flag(dev)@@ -156,7 +156,7 @@ test-suite tests     type:               exitcode-stdio-1.0     main-is:            Spec.hs-    build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0+    build-tool-depends: hspec-discover:hspec-discover >=2 && <3     hs-source-dirs:     tests     other-modules:         Ormolu.CabalInfoSpec@@ -174,19 +174,19 @@     build-depends:         Cabal-syntax >=3.10 && <3.11,         QuickCheck >=2.14,-        base >=4.14 && <5.0,+        base >=4.14 && <5,         containers >=0.5 && <0.7,         directory ^>=1.3,         filepath >=1.2 && <1.5,-        ghc-lib-parser >=9.6 && <9.7,-        hspec >=2.0 && <3.0,+        ghc-lib-parser >=9.8 && <9.9,+        hspec >=2 && <3,         hspec-megaparsec >=2.2,-        megaparsec >=9.0,+        megaparsec >=9,         ormolu,         path >=0.6 && <0.10,-        path-io >=1.4.2 && <2.0,+        path-io >=1.4.2 && <2,         temporary ^>=1.3,-        text >=2.0 && <3.0+        text >=2 && <3      if flag(dev)         ghc-options:

@@ -46,8 +46,10 @@ import Data.Text (Text) import Data.Text qualified as T import Debug.Trace-import GHC.Driver.CmdLine qualified as GHC+import GHC.Driver.Errors.Types+import GHC.Types.Error import GHC.Types.SrcLoc+import GHC.Utils.Error import Ormolu.Config import Ormolu.Diff.ParseResult import Ormolu.Diff.Text@@ -96,8 +98,9 @@   (warnings, result0) <-     parseModule' cfg fixityMap OrmoluParsingFailed path originalInput   when (cfgDebug cfg) $ do-    forM_ warnings $ \(GHC.Warn reason (L loc msg)) ->-      traceM $ unwords ["*** WARNING ***", showOutputable loc, msg, showOutputable reason]+    forM_ warnings $ \driverMsg -> do+      let driverMsgSDoc = formatBulleted $ diagnosticMessage defaultOpts driverMsg+      traceM $ unwords ["*** WARNING ***", showOutputable driverMsgSDoc]     forM_ result0 $ \case       ParsedSnippet r -> do         let CommentStream comments = prCommentStream r@@ -244,7 +247,7 @@   FilePath ->   -- | Actual input for the parser   Text ->-  m ([GHC.Warn], [SourceSnippet])+  m (DriverMessages, [SourceSnippet]) parseModule' cfg fixityMap mkException path str = do   (warnings, r) <- parseModule cfg fixityMap path str   case r of

@@ -16,7 +16,7 @@ import Distribution.ModuleName (ModuleName) import Distribution.Types.PackageName import GHC.Data.FastString qualified as GHC-import GHC.Hs hiding (ModuleName)+import GHC.Hs hiding (ModuleName, OpName) import GHC.Types.Name.Occurrence import GHC.Types.PkgQual (RawPkgQual (..)) import GHC.Types.SourceText (StringLiteral (..))

@@ -123,7 +123,7 @@     isPrelude = moduleNameString moduleName == "Prelude"     moduleName = unLoc ideclName --- | Normalize a collection of import\/export items.+-- | Normalize a collection of import items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs] normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty   where@@ -139,21 +139,21 @@             Nothing -> Just . L new_l $               case new of                 IEThingWith _ n wildcard g ->-                  IEThingWith EpAnnNotUsed n wildcard (normalizeWNames g)+                  IEThingWith (Nothing, EpAnnNotUsed) n wildcard (normalizeWNames g)                 other -> other             Just old ->               let f = \case-                    IEVar _ n -> IEVar NoExtField n+                    IEVar _ n -> IEVar Nothing n                     IEThingAbs _ _ -> new-                    IEThingAll _ n -> IEThingAll EpAnnNotUsed n+                    IEThingAll _ n -> IEThingAll (Nothing, EpAnnNotUsed) n                     IEThingWith _ n wildcard g ->                       case new of-                        IEVar NoExtField _ ->+                        IEVar _ _ ->                           error "Ormolu.Imports broken presupposition"                         IEThingAbs _ _ ->-                          IEThingWith EpAnnNotUsed n wildcard g+                          IEThingWith (Nothing, EpAnnNotUsed) n wildcard g                         IEThingAll _ n' ->-                          IEThingAll EpAnnNotUsed n'+                          IEThingAll (Nothing, EpAnnNotUsed) n'                         IEThingWith _ n' wildcard' g' ->                           let combinedWildcard =                                 case (wildcard, wildcard') of@@ -161,7 +161,7 @@                                   (_, IEWildcard _) -> IEWildcard 0                                   _ -> NoIEWildcard                            in IEThingWith-                                EpAnnNotUsed+                                (Nothing, EpAnnNotUsed)                                 n'                                 combinedWildcard                                 (normalizeWNames (g <> g'))@@ -187,7 +187,7 @@ -- | Project @'IEWrappedName' 'GhcPs'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case-  IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)+  IEVar _ x -> IEWrappedNameOrd (unLoc x)   IEThingAbs _ x -> IEWrappedNameOrd (unLoc x)   IEThingAll _ x -> IEWrappedNameOrd (unLoc x)   IEThingWith _ x _ _ -> IEWrappedNameOrd (unLoc x)

@@ -28,7 +28,6 @@ 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@@ -44,7 +43,6 @@ 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@@ -70,7 +68,7 @@   -- | Input for parser   Text ->   m-    ( [GHC.Warn],+    ( GHC.DriverMessages,       Either (SrcSpan, String) [SourceSnippet]     ) parseModule config@Config {..} packageFixityMap path rawInput = liftIO $ do@@ -134,7 +132,7 @@                   Nothing -> ""                 msg =                   showOutputable-                    . formatBulleted defaultSDocContext+                    . formatBulleted                     . diagnosticMessage GHC.NoDiagnosticOpts                     $ err          in case L.sortOn (rateSeverity . errMsgSeverity) errs of@@ -254,7 +252,8 @@     LinearTypes, -- steals the (%) type operator in some cases     OverloadedRecordDot, -- f.g parses differently     OverloadedRecordUpdate, -- qualified fields are not supported-    OverloadedLabels -- a#b is parsed differently+    OverloadedLabels, -- a#b is parsed differently+    ExtendedLiterals -- 1#Word32 is parsed differently   ]  -- | Run a 'GHC.P' computation.@@ -289,7 +288,7 @@   FilePath ->   -- | Input for parser   StringBuffer ->-  IO (Either String ([GHC.Warn], DynFlags))+  IO (Either String (GHC.DriverMessages, DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath input =   catchGhcErrors $ do     let (_warnings, fileOpts) =

@@ -18,6 +18,7 @@  import Control.Monad import Data.Text qualified as T+import GHC.Data.FastString import GHC.Hs.Doc import GHC.Hs.Extension (GhcPs) import GHC.Hs.ImpExp@@ -71,6 +72,8 @@           NameAnn {nann_adornment = NameParens} ->             parens N . handleUnboxedSumsAndHashInteraction           NameAnn {nann_adornment = NameBackquotes} -> backticks+          -- whether the `->` identifier is parenthesized+          NameAnnRArrow {nann_mopen = Just _} -> parens N           -- special case for unboxed unit tuples           NameAnnOnly {nann_adornment = NameParensHash} -> const $ txt "(# #)"           _ -> id@@ -188,4 +191,4 @@ p_sourceText :: SourceText -> R () p_sourceText = \case   NoSourceText -> pure ()-  SourceText s -> txt (T.pack s)+  SourceText s -> atom @FastString s

@@ -139,7 +139,9 @@     p_dataDecl       Associated       tcdLName-      (tyVarsToTyPats tcdTyVars)+      (hsq_explicit tcdTyVars)+      getLocA+      (located' p_hsTyVarBndr)       tcdFixity       tcdDataDefn   ClassDecl {..} ->

@@ -24,21 +24,25 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type-import Ormolu.Utils (matchAddEpAnn)+import Ormolu.Utils  p_dataDecl ::   -- | Whether to format as data family   FamilyStyle ->   -- | Type constructor   LocatedN RdrName ->-  -- | Type patterns-  HsTyPats GhcPs ->+  -- | Type variables+  [tyVar] ->+  -- | Get location information for type variables+  (tyVar -> SrcSpan) ->+  -- | How to print type variables+  (tyVar -> R ()) ->   -- | Lexical fixity   LexicalFixity ->   -- | Data definition   HsDataDefn GhcPs ->   R ()-p_dataDecl style name tpats fixity HsDataDefn {..} = do+p_dataDecl style name tyVars getTyVarLoc p_tyVar fixity HsDataDefn {..} = do   txt $ case dd_cons of     NewTypeCon _ -> "newtype"     DataTypeCons False _ -> "data"@@ -57,7 +61,7 @@       space       p_sourceText type_       txt " #-}"-  let constructorSpans = getLocA name : fmap lhsTypeArgSrcSpan tpats+  let constructorSpans = getLocA name : fmap getTyVarLoc tyVars       sigSpans = maybeToList . fmap getLocA $ dd_kindSig       declHeaderSpans =         maybeToList (getLocA <$> dd_ctxt) ++ constructorSpans ++ sigSpans@@ -76,7 +80,7 @@           (isInfix fixity)           True           (p_rdrName name)-          (p_lhsTypeArg <$> tpats)+          (p_tyVar <$> tyVars)       forM_ dd_kindSig $ \k -> do         space         txt "::"

@@ -97,7 +97,14 @@  p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R () p_dataFamInstDecl style (DataFamInstDecl {dfid_eqn = FamEqn {..}}) =-  p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs+  p_dataDecl+    style+    feqn_tycon+    feqn_pats+    lhsTypeArgSrcSpan+    p_lhsTypeArg+    feqn_fixity+    feqn_rhs  match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy =

@@ -15,6 +15,8 @@ where  import Data.Functor ((<&>))+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import GHC.Hs import GHC.Types.Fixity import GHC.Types.Name (occNameString)@@ -81,7 +83,7 @@ -- | Convert a 'LHsExpr' containing an operator tree to the 'OpTree' -- intermediate representation. exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)-exprOpTree (L _ (OpApp _ x op y)) = OpBranches [exprOpTree x, exprOpTree y] [op]+exprOpTree (L _ (OpApp _ x op y)) = BinaryOpBranches (exprOpTree x) op (exprOpTree y) exprOpTree n = OpNode n  -- | Print an operator tree where leaves are values.@@ -93,17 +95,15 @@   OpTree (LHsExpr GhcPs) (OpInfo (LHsExpr GhcPs)) ->   R () p_exprOpTree s (OpNode x) = located x (p_hsExpr' NotApplicand s)-p_exprOpTree s t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_exprOpTree s t@(OpBranches exprs@(firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           exprPlacement           firstExpr           (last otherExprs)       rightMostNode = \case         n@(OpNode _) -> n-        OpBranches exprs'' _ -> rightMostNode (last exprs'')+        OpBranches exprs'' _ -> rightMostNode (NE.last exprs'')       isDoBlock = \case         OpNode (L _ (HsDo _ ctx _)) -> case ctx of           DoExpr _ -> True@@ -127,7 +127,7 @@           && not (isDoBlock $ rightMostNode prevExpr)       -- If all operators at the current level match the conditions to be       -- trailing, then put them in a trailing position-      isTrailing = all couldBeTrailing $ zip exprs ops+      isTrailing = all couldBeTrailing $ zip (NE.toList exprs) ops   ub <- if isTrailing then return useBraces else opBranchBraceStyle placement   let p_x = ub $ p_exprOpTree s firstExpr       putOpsExprs prevExpr (opi : ops') (expr : exprs') = do@@ -171,7 +171,7 @@ cmdOpTree :: LHsCmdTop GhcPs -> OpTree (LHsCmdTop GhcPs) (LHsExpr GhcPs) cmdOpTree = \case   (L _ (HsCmdTop _ (L _ (HsCmdArrForm _ op Infix _ [x, y])))) ->-    OpBranches [cmdOpTree x, cmdOpTree y] [op]+    BinaryOpBranches (cmdOpTree x) op (cmdOpTree y)   n -> OpNode n  -- | Print an operator tree where leaves are commands.@@ -183,10 +183,8 @@   OpTree (LHsCmdTop GhcPs) (OpInfo (LHsExpr GhcPs)) ->   R () p_cmdOpTree s (OpNode x) = located x (p_hsCmdTop s)-p_cmdOpTree s t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_cmdOpTree s t@(OpBranches (firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           cmdTopPlacement           firstExpr@@ -218,7 +216,7 @@ -- intermediate representation. tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (LocatedN RdrName) tyOpTree (L _ (HsOpTy _ _ l op r)) =-  OpBranches [tyOpTree l, tyOpTree r] [op]+  BinaryOpBranches (tyOpTree l) op (tyOpTree r) tyOpTree n = OpNode n  -- | Print an operator tree where leaves are types.@@ -228,10 +226,8 @@   OpTree (LHsType GhcPs) (OpInfo (LocatedN RdrName)) ->   R () p_tyOpTree (OpNode n) = located n p_hsType-p_tyOpTree t@(OpBranches exprs ops) = do-  let firstExpr = head exprs-      otherExprs = tail exprs-      placement =+p_tyOpTree t@(OpBranches (firstExpr :| otherExprs) ops) = do+  let placement =         opBranchPlacement           tyOpPlacement           firstExpr

@@ -33,6 +33,7 @@ import Data.Text qualified as Text import Data.Void import GHC.Data.Bag (bagToList)+import GHC.Data.FastString import GHC.Data.Strict qualified as Strict import GHC.Hs import GHC.LanguageExtensions.Type (Extension (NegativeLiterals))@@ -347,7 +348,7 @@       inci (sequence_ (intersperse breakpoint (located' (p_hsCmdTop N) <$> cmds)))   HsCmdArrForm _ form Infix _ [left, right] -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [cmdOpTree left, cmdOpTree right] [form]+    let opTree = BinaryOpBranches (cmdOpTree left) form (cmdOpTree right)     p_cmdOpTree       s       (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)@@ -678,7 +679,7 @@       located (hswc_body a) p_hsType   OpApp _ x op y -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [exprOpTree x, exprOpTree y] [op]+    let opTree = BinaryOpBranches (exprOpTree x) op (exprOpTree y)     p_exprOpTree       s       (reassociateOpTree (getOpName . unLoc) modFixityMap opTree)@@ -791,11 +792,11 @@               Ambiguous NoExtField n -> n         p_recFields p_lbl =           sep commaDel (sitcc . located' (p_hsFieldBind p_lbl))-    inci . braces N $-      either-        (p_recFields p_updLbl)-        (p_recFields $ located' $ coerce p_ldotFieldOccs)-        rupd_flds+    inci . braces N $ case rupd_flds of+      RegularRecUpdFields {..} ->+        p_recFields p_updLbl recUpdFields+      OverloadedRecUpdFields {..} ->+        p_recFields (located' (coerce p_ldotFieldOccs)) olRecUpdFields   HsGetField {..} -> do     located gf_expr p_hsExpr     txt "."@@ -1184,9 +1185,9 @@           _ -> False  -- | Print the source text of a string literal while indenting gaps correctly.-p_stringLit :: String -> R ()+p_stringLit :: FastString -> R () p_stringLit src =-  let s = splitGaps src+  let s = splitGaps (unpackFS src)       singleLine =         txt $ Text.pack (mconcat s)       multiLine =@@ -1221,11 +1222,7 @@     -- Attaches previous and next items to each list element     zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]     zipPrevNext xs =-      let z =-            zip-              (zip (Nothing : map Just xs) xs)-              (map Just (tail xs) ++ repeat Nothing)-       in map (\((p, x), n) -> (p, x, n)) z+      zip3 (Nothing : map Just xs) xs (map Just (drop 1 xs) ++ [Nothing])     orig (_, x, _) = x  ----------------------------------------------------------------------------

@@ -11,6 +11,7 @@   ) where +import GHC.Data.FastString import GHC.Hs import Ormolu.Printer.Combinators @@ -18,7 +19,7 @@ p_pat :: Pat GhcPs -> R () p_hsExpr :: HsExpr GhcPs -> R () p_hsUntypedSplice :: SpliceDecoration -> HsUntypedSplice GhcPs -> R ()-p_stringLit :: String -> R ()+p_stringLit :: FastString -> R ()  data IsApplicand 

@@ -1,14 +1,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Ormolu.Printer.Meat.Declaration.Warning   ( p_warnDecls,-    p_moduleWarning,+    p_warningTxt,   ) where  import Data.Foldable import Data.Text (Text)+import Data.Text qualified as T import GHC.Hs import GHC.Types.Name.Reader import GHC.Types.SourceText@@ -16,6 +18,7 @@ import GHC.Unit.Module.Warnings import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Utils  p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings _ warnings) =@@ -25,8 +28,8 @@ p_warnDecl (Warning _ functions warningTxt) =   p_topLevelWarning functions warningTxt -p_moduleWarning :: WarningTxt GhcPs -> R ()-p_moduleWarning wtxt = do+p_warningTxt :: WarningTxt GhcPs -> R ()+p_warningTxt wtxt = do   let (pragmaText, lits) = warningText wtxt   inci $ pragma pragmaText $ inci $ p_lits lits @@ -41,7 +44,12 @@  warningText :: WarningTxt GhcPs -> (Text, [Located StringLiteral]) warningText = \case-  WarningTxt _ lits -> ("WARNING", fmap hsDocString <$> lits)+  WarningTxt mcat _ lits -> ("WARNING" <> T.pack cat, fmap hsDocString <$> lits)+    where+      cat = case unLoc <$> mcat of+        Just InWarningCategory {..} ->+          " in " <> show (showOutputable @WarningCategory (unLoc iwc_wc))+        Nothing -> ""   DeprecatedTxt _ lits -> ("DEPRECATED", fmap hsDocString <$> lits)  p_lits :: [Located StringLiteral] -> R ()

@@ -10,12 +10,14 @@ where  import Control.Monad+import Data.Foldable (for_) import GHC.Hs import GHC.LanguageExtensions.Type import GHC.Types.PkgQual import GHC.Types.SrcLoc import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Utils (RelativePos (..), attachRelativePos)  p_hsmodExports :: [LIE GhcPs] -> R ()@@ -74,7 +76,10 @@  p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case-  IEVar NoExtField l1 -> do+  IEVar mwarn l1 -> do+    for_ mwarn $ \warnTxt -> do+      located warnTxt p_warningTxt+      breakpoint     located l1 p_ieWrappedName     p_comma   IEThingAbs _ l1 -> do

@@ -49,7 +49,7 @@           p_hsmodName name         breakpoint         forM_ hsmodDeprecMessage $ \w -> do-          located' p_moduleWarning w+          located' p_warningTxt w           breakpoint         case hsmodExports of           Nothing -> return ()

@@ -14,7 +14,6 @@     p_conDeclFields,     p_lhsTypeArg,     p_hsSigType,-    tyVarsToTyPats,     hsOuterTyVarBndrsToHsType,     lhsTypeToSigType,   )@@ -74,7 +73,7 @@       breakpoint       inci $         sep breakpoint (located' p_hsType) args-  HsAppKindTy _ ty kd -> sitcc $ do+  HsAppKindTy _ ty _ kd -> sitcc $ do     -- The first argument is the location of the "@..." part. Not 100% sure,     -- but I think we can ignore it as long as we use 'located' on both the     -- type and the kind.@@ -111,7 +110,7 @@       sep (space >> txt "|" >> breakpoint) (sitcc . located' p_hsType) xs   HsOpTy _ _ x op y -> do     modFixityMap <- askModuleFixityMap-    let opTree = OpBranches [tyOpTree x, tyOpTree y] [op]+    let opTree = BinaryOpBranches (tyOpTree x) op (tyOpTree y)     p_tyOpTree       (reassociateOpTree (Just . unLoc) modFixityMap opTree)   HsParTy _ t ->@@ -199,27 +198,38 @@   [x] -> located x p_hsType   xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs -class IsInferredTyVarBndr flag where+class IsTyVarBndrFlag flag where   isInferred :: flag -> Bool+  p_tyVarBndrFlag :: flag -> R ()+  p_tyVarBndrFlag _ = pure () -instance IsInferredTyVarBndr () where+instance IsTyVarBndrFlag () where   isInferred () = False -instance IsInferredTyVarBndr Specificity where+instance IsTyVarBndrFlag Specificity where   isInferred = \case     InferredSpec -> True     SpecifiedSpec -> False -p_hsTyVarBndr :: (IsInferredTyVarBndr flag) => HsTyVarBndr flag GhcPs -> R ()+instance IsTyVarBndrFlag (HsBndrVis GhcPs) where+  isInferred _ = False+  p_tyVarBndrFlag = \case+    HsBndrRequired -> pure ()+    HsBndrInvisible _ -> txt "@"++p_hsTyVarBndr :: (IsTyVarBndrFlag flag) => HsTyVarBndr flag GhcPs -> R () p_hsTyVarBndr = \case-  UserTyVar _ flag x ->+  UserTyVar _ flag x -> do+    p_tyVarBndrFlag flag     (if isInferred flag then braces N else id) $ p_rdrName x-  KindedTyVar _ flag l k -> (if isInferred flag then braces else parens) N $ do-    located l atom-    space-    txt "::"-    breakpoint-    inci (located k p_hsType)+  KindedTyVar _ flag l k -> do+    p_tyVarBndrFlag flag+    (if isInferred flag then braces else parens) N $ do+      located l atom+      space+      txt "::"+      breakpoint+      inci (located k p_hsType)  data ForAllVisibility = ForAllInvis | ForAllVis @@ -274,21 +284,6 @@  ---------------------------------------------------------------------------- -- Conversion functions--tyVarToType :: HsTyVarBndr () GhcPs -> HsType GhcPs-tyVarToType = \case-  UserTyVar _ () tvar -> HsTyVar EpAnnNotUsed NotPromoted tvar-  KindedTyVar _ () tvar kind ->-    -- Note: we always add parentheses because for whatever reason GHC does-    -- not use HsParTy for left-hand sides of declarations. Please see-    -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as-    -- long as 'tyVarToType' does not get applied to right-hand sides of-    -- declarations.-    HsParTy EpAnnNotUsed . noLocA $-      HsKindSig EpAnnNotUsed (noLocA (HsTyVar EpAnnNotUsed NotPromoted tvar)) kind--tyVarsToTyPats :: LHsQTyVars GhcPs -> HsTyPats GhcPs-tyVarsToTyPats HsQTvs {..} = HsValArg . fmap tyVarToType <$> hsq_explicit  -- could be generalized to also handle () instead of Specificity hsOuterTyVarBndrsToHsType ::

@@ -1,9 +1,11 @@ {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternSynonyms #-}  -- | This module helps handle operator chains composed of different -- operators that may have different precedence and fixities. module Ormolu.Printer.Operators   ( OpTree (..),+    pattern BinaryOpBranches,     OpInfo (..),     opTreeLoc,     reassociateOpTree,@@ -11,6 +13,7 @@   ) where +import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import GHC.Types.Name.Reader import GHC.Types.SrcLoc@@ -31,9 +34,12 @@   | -- | A subtree of operator application(s); the invariant is: @length     -- exprs == length ops + 1@. @OpBranches [x, y, z] [op1, op2]@     -- represents the expression @x op1 y op2 z@.-    OpBranches [OpTree ty op] [op]+    OpBranches (NonEmpty (OpTree ty op)) [op]   deriving (Eq, Show) +pattern BinaryOpBranches :: OpTree ty op -> op -> OpTree ty op -> OpTree ty op+pattern BinaryOpBranches x op y = OpBranches (x :| [y]) [op]+ -- | Wrapper for an operator, carrying information about its name and -- fixity. data OpInfo op = OpInfo@@ -78,7 +84,7 @@ opTreeLoc :: (HasSrcSpan l) => OpTree (GenLocated l a) b -> SrcSpan opTreeLoc (OpNode n) = getLoc' n opTreeLoc (OpBranches exprs _) =-  combineSrcSpans' . NE.fromList . fmap opTreeLoc $ exprs+  combineSrcSpans' . fmap opTreeLoc $ exprs  -- | Re-associate an 'OpTree' taking into account precedence of operators. -- Users are expected to first construct an initial 'OpTree', then@@ -129,11 +135,11 @@   OpBranches rExprs rOps   where     makeFlatOpTree' expr = case makeFlatOpTree expr of-      OpNode n -> ([OpNode n], [])+      OpNode n -> (NE.singleton (OpNode n), [])       OpBranches noptExprs noptOps -> (noptExprs, noptOps)     flattenedSubTrees = makeFlatOpTree' <$> exprs-    rExprs = concatMap fst flattenedSubTrees-    rOps = concat $ interleave (snd <$> flattenedSubTrees) (pure <$> ops)+    rExprs = fst =<< flattenedSubTrees+    rOps = concat $ interleave (snd <$> NE.toList flattenedSubTrees) (pure <$> ops)     interleave (x : xs) (y : ys) = x : y : interleave xs ys     interleave [] ys = ys     interleave xs [] = xs@@ -239,7 +245,7 @@     --   [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7]     -- into     --   [ex0 op0 [ex1 op1 ex2] op2 [ex3 op3 ex4 op4 ex5] op5 [ex6 op6 ex7]]-    splitTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] []+    splitTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] []       where         go ::           -- Remaining exprs to look up@@ -267,15 +273,15 @@           -- expr in the subExprs bag, so we build a subtree (if necessary)           -- with sub-bags, add the node/subtree to the result bag, and then           -- emit the result tree-          let resExpr = buildFromSub subExprs subOps-           in OpBranches (reverse (resExpr : resExprs)) (reverse resOps)+          let resExpr = buildFromSub (NE.fromList subExprs) subOps+           in OpBranches (NE.reverse (resExpr :| resExprs)) (reverse resOps)         go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps           | i == idx =               -- The op we are looking at is one on which we need to split.               -- So we build a subtree from the sub-bags and the current               -- expr, append it to the result exprs, and continue with               -- cleared sub-bags-              let resExpr = buildFromSub (x : subExprs) subOps+              let resExpr = buildFromSub (x :| subExprs) subOps                in go xs os idxs (i + 1) [] [] (resExpr : resExprs) (o : resOps)         go (x : xs) ops idxs i subExprs subOps resExprs resOps =           -- Either there is no op left, or the op we are looking at is not@@ -288,7 +294,7 @@     --   [ex0 op0 ex1 op1 ex2 op2 ex3 op3 ex4 op4 ex5 op5 ex6 op6 ex7]     -- into     --   [[ex0 op0 ex1 op1 ex2] op2 ex3 op3 [ex4 op4 ex5] op5 ex6 op6 ex7]-    groupTree nExprs nOps indices = go nExprs nOps indices 0 [] [] [] []+    groupTree nExprs nOps indices = go (NE.toList nExprs) nOps indices 0 [] [] [] []       where         go ::           -- remaining exprs to look up@@ -316,11 +322,10 @@           -- empty. If it is not, we build a subtree (if necessary) with           -- sub-bags and add the resulting node/subtree to the result bag.           -- In any case, we then emit the result tree-          let resExprs' =-                if null subExprs-                  then resExprs-                  else buildFromSub subExprs subOps : resExprs-           in OpBranches (reverse resExprs') (reverse resOps)+          let resExprs' = case NE.nonEmpty subExprs of+                Nothing -> NE.fromList resExprs+                Just subExprs' -> buildFromSub subExprs' subOps :| resExprs+           in OpBranches (NE.reverse resExprs') (reverse resOps)         go (x : xs) (o : os) (idx : idxs) i subExprs subOps resExprs resOps           | i == idx =               -- The op we are looking at is one on which we need to group.@@ -333,7 +338,7 @@           -- the current expr, to form a subtree which is then added to the           -- result bag.           let (ops', resOps') = moveOneIfPossible ops resOps-              resExpr = buildFromSub (x : subExprs) subOps+              resExpr = buildFromSub (x :| subExprs) subOps            in go xs ops' idxs (i + 1) [] [] (resExpr : resExprs) resOps'         go (x : xs) ops idxs i [] subOps resExprs resOps =           -- Either there is no op left, or the op we are looking at is not@@ -349,8 +354,8 @@     buildFromSub subExprs subOps = reassociateFlatOpTree $ case subExprs of       -- Do not build a subtree when the potential subtree would have       -- 1 expr(s) and 0 op(s)-      [x] -> x-      _ -> OpBranches (reverse subExprs) (reverse subOps)+      x :| [] -> x+      _ -> OpBranches (NE.reverse subExprs) (reverse subOps)  -- | Indicate if an operator has @'InfixR' 0@ fixity. We special-case this -- class of operators because they often have, like ('$'), a specific

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}  module Ormolu.OpTreeSpec (spec) where