hindent 6.0.0 → 6.1.0

raw patch · 34 files changed

+2010/−955 lines, 34 filesdep −textdep ~ghc-lib-parserPVP ok

version bump matches the API change (PVP)

Dependencies removed: text

Dependency ranges changed: ghc-lib-parser

API changes (from Hackage documentation)

Files

• BENCHMARKS.md +6/−0
• CHANGELOG.md +45/−5
• README.md +1/−2
• TESTS.md +245/−122
• app/Main.hs +2/−139
• benchmarks/Main.hs +7/−13
• hindent.cabal +66/−34
• internal/HIndent/Internal/Test/Markdone.hs +9/−8
• src/HIndent.hs +128/−102
• src/HIndent/ByteString.hs +75/−0
• src/HIndent/CabalFile.hs +23/−25
• src/HIndent/CodeBlock.hs +8/−5
• src/HIndent/CommandlineOptions.hs +95/−0
• src/HIndent/Config.hs +17/−11
• src/HIndent/Error.hs +25/−0
• src/HIndent/Fixity.hs +67/−0
• src/HIndent/GhcLibParserWrapper/GHC/Hs.hs +15/−0
• src/HIndent/LanguageExtension.hs +15/−43
• src/HIndent/ModulePreprocessing.hs +32/−25
• src/HIndent/ModulePreprocessing/CommentRelocation.hs +190/−52
• src/HIndent/Parse.hs +2/−2
• src/HIndent/Pretty.hs +623/−224
• src/HIndent/Pretty/Combinators/Lineup.hs +9/−9
• src/HIndent/Pretty/Combinators/Outputable.hs +6/−0
• src/HIndent/Pretty/Combinators/String.hs +7/−3
• src/HIndent/Pretty/Combinators/Switch.hs +4/−2
• src/HIndent/Pretty/Import.hs +8/−6
• src/HIndent/Pretty/Import/Sort.hs +9/−0
• src/HIndent/Pretty/NodeComments.hs +131/−21
• src/HIndent/Pretty/Pragma.hs +29/−14
• src/HIndent/Pretty/SigBindFamily.hs +48/−6
• src/HIndent/Pretty/Types.hs +18/−3
• src/HIndent/Printer.hs +1/−3
• tests/Main.hs +44/−76

@@ -3,6 +3,8 @@ Bunch of declarations  ``` haskell+{-# LANGUGAE QuasiQuotes #-}+ listPrinters =   [(''[]    ,\(typeVariable:_) _automaticPrinter ->@@ -59,6 +61,8 @@ Bunch of declarations - sans comments  ``` haskell+{-# LANGUGAE QuasiQuotes #-}+ listPrinters =   [(''[]    ,\(typeVariable:_) _automaticPrinter ->@@ -116,6 +120,8 @@ Quasi-quotes with nested lets and operators  ``` haskell+{-# LANGUGAE QuasiQuotes #-}+ quasiQuotes =   [(''[]    ,\(typeVariable:_) _automaticPrinter ->

@@ -4,19 +4,42 @@  ### Added -- ...+### Changed +### Fixed++### Removed++## [6.1.0] - 2023-05-17++### Added++- Support for GHC 9.6 ([#699])+- The `hindent` function for easy use within a project ([#709]).+ ### Changed -- ...+- `reformat` now takes a list of `Extension`s instead of a `Maybe` value containing the list ([#712]).+- `reformat` and `testAst` now return a `ParseError` on error ([#715]).+- `reformat` now returns the formatted code as a `ByteString` instead of a `Builder`. ([#720]).+- HIndent now assumes no extensions are enabled by default ([#728]).+- All modules except for `HIndent` are now private, and the minimum necessary definitions are exposed from the module ([#729]).+- HIndent now prints all `do` expressions in a unified style  ([#739]).+- HIndent now formats operators based on their fixities ([#741], [#742]).  ### Fixed -- ...+- Fixed module names being removed from uses of qualified `do` ([#696]).+- Misplaced haddocks for class declarations ([#706]).+- Misplaced comments in do expressions ([#707]).+- Misplaced comments in case expressions  ([#708]).+- The bug of extensions specified via pragmas not enabling implied ones ([#727]).+- Language extensions enabled via pragmas were not effective across CPP boundaries ([#731]).  ### Removed -- ...+- `HIndent.LanguageExtension.defaultExtensions` ([#728])+- `HIndent.LanguageExtension.allExtensions` ([#728])  ## [6.0.0] - 2023-02-20 @@ -308,7 +331,8 @@  - A bug in printing operators in statements. -[unreleased]: https://github.com/mihaimaruseac/hindent/compare/v6.0.0...HEAD+[unreleased]: https://github.com/mihaimaruseac/hindent/compare/v6.1.0...HEAD+[6.1.0]: https://github.com/mihaimaruseac/hindent/compare/v6.0.0...v6.1.0 [6.0.0]: https://github.com/mihaimaruseac/hindent/compare/v5.3.4...v6.0.0 [5.3.4]: https://github.com/mihaimaruseac/hindent/compare/v5.3.3...v5.3.4 [5.3.3]: https://github.com/mihaimaruseac/hindent/compare/v5.3.2...v5.3.3@@ -338,6 +362,22 @@ [@uhbif19]: https://github.com/uhbif19 [@toku-sa-n]: https://github.com/toku-sa-n +[#742]: https://github.com/mihaimaruseac/hindent/pull/742+[#741]: https://github.com/mihaimaruseac/hindent/pull/741+[#739]: https://github.com/mihaimaruseac/hindent/pull/739+[#731]: https://github.com/mihaimaruseac/hindent/pull/731+[#729]: https://github.com/mihaimaruseac/hindent/pull/729+[#728]: https://github.com/mihaimaruseac/hindent/pull/728+[#727]: https://github.com/mihaimaruseac/hindent/pull/727+[#720]: https://github.com/mihaimaruseac/hindent/pull/720+[#715]: https://github.com/mihaimaruseac/hindent/pull/715+[#712]: https://github.com/mihaimaruseac/hindent/pull/712+[#709]: https://github.com/mihaimaruseac/hindent/pull/709+[#708]: https://github.com/mihaimaruseac/hindent/pull/708+[#707]: https://github.com/mihaimaruseac/hindent/pull/707+[#706]: https://github.com/mihaimaruseac/hindent/pull/706+[#699]: https://github.com/mihaimaruseac/hindent/pull/699+[#696]: https://github.com/mihaimaruseac/hindent/pull/696 [#672]: https://github.com/mihaimaruseac/hindent/pull/672 [#671]: https://github.com/mihaimaruseac/hindent/pull/671 [#670]: https://github.com/mihaimaruseac/hindent/pull/670

@@ -1,5 +1,4 @@-# hindent [![Hackage](https://img.shields.io/hackage/v/hindent.svg?style=flat)](https://hackage.haskell.org/package/hindent) ![CI (Stack)](https://github.com/mihaimaruseac/hindent/workflows/CI%20(Stack)/badge.svg) ![CI (Cabal)](https://github.com/mihaimaruseac/hindent/workflows/CI%20(Cabal)/badge.svg) [![OpenSSF Scorecard](https://api.securityscorecards.dev/projects/github.com/mihaimaruseac/hindent/badge)](https://api.securityscorecards.dev/projects/github.com/mihaimaruseac/hindent)-+# hindent [![Hackage](https://img.shields.io/hackage/v/hindent.svg?style=flat)](https://hackage.haskell.org/package/hindent) [![Haskell Cabal](https://github.com/mihaimaruseac/hindent/actions/workflows/presubmit-cabal.yaml/badge.svg)](https://github.com/mihaimaruseac/hindent/actions/workflows/presubmit-cabal.yaml) [![Haskell Stack](https://github.com/mihaimaruseac/hindent/actions/workflows/presubmit-stack.yaml/badge.svg)](https://github.com/mihaimaruseac/hindent/actions/workflows/presubmit-stack.yaml) [![OpenSSF Scorecard](https://api.securityscorecards.dev/projects/github.com/mihaimaruseac/hindent/badge)](https://api.securityscorecards.dev/projects/github.com/mihaimaruseac/hindent)  Haskell pretty printer 

@@ -255,6 +255,8 @@ Pretty import specification  ```haskell+{-# LANGUAGE ForeignFunctionInterface #-}+ import A hiding   ( foobarbazqux   , foobarbazqux@@ -1010,8 +1012,10 @@  ```haskell foo =-  if fooooooo ||-     baaaaaaaaaaaaaaaaaaaaa || apsdgiuhasdpfgiuahdfpgiuah || bazzzzzzzzzzzzz+  if fooooooo+       || baaaaaaaaaaaaaaaaaaaaa+       || apsdgiuhasdpfgiuahdfpgiuah+       || bazzzzzzzzzzzzz     then a     else b ```@@ -1062,7 +1066,8 @@   , x <- Just x =     case x of       Just x -> e-  | otherwise = do e+  | otherwise = do+    e   where     x = y ```@@ -1161,6 +1166,8 @@ n+k patterns  ```haskell+{-# LANGUAGE NPlusKPatterns #-}+ f (n+5) = 0 ``` @@ -1182,7 +1189,7 @@  ```haskell -- https://github.com/mihaimaruseac/hindent/issues/424-from $ \(author `InnerJoin` post) -> pure ()+a = from $ \(author `InnerJoin` post) -> pure () ```  Unboxed sum pattern matching.@@ -1593,19 +1600,17 @@ Implicit parameters  ```haskell+{-# LANGUAGE ImplicitParams #-}+ f :: (?x :: Int) => Int ```  Quasiquotes in types  ```haskell-fun :: [a|bc|]-```--Implicit parameters+{-# LANGUAGE QuasiQuotes #-} -```haskell-f :: (?x :: Int) => Int+fun :: [a|bc|] ```  Tuples@@ -1634,7 +1639,6 @@ g :: forall a b. a -> b ``` - An infix operator containing `#`  ```haskell@@ -1671,7 +1675,7 @@  Class constraints should leave `::` on same line -``` haskell+```haskell -- see https://github.com/chrisdone/hindent/pull/266#issuecomment-244182805 fun ::      (Class a, Class b)@@ -2005,7 +2009,7 @@ ```haskell {-# LANGUAGE TypeApplications #-} -fun @Int 12+a = fun @Int 12 ```  An expression with a SCC pragma@@ -2023,6 +2027,8 @@ Implicit value  ```haskell+{-# LANGUAGE ImplicitParams #-}+ foo = ?undefined ``` @@ -2198,6 +2204,9 @@ cases  ```haskell since 9.4.1+{-# LANGUAGE Arrows #-}+{-# LANGUAGE LambdaCase #-}+ foo =   \cases     1 1 -> 1@@ -2225,10 +2234,10 @@ ```haskell -- https://github.com/mihaimaruseac/hindent/issues/238 -- https://github.com/mihaimaruseac/hindent/issues/296-block =-  do ds <- inBraces $ inWhiteSpace declarations-     return $ Block ds-     <?> "block"+block = do+  ds <- inBraces $ inWhiteSpace declarations+  return $ Block ds+  <?> "block" ```  #### Bindings@@ -2299,37 +2308,61 @@   bar ``` +#### `QualifiedDo`++Qualified do++```haskell+{-# LANGUAGE QualifiedDo #-}++f = Module.Path.do+  a <- foo+  return a+```++Qualified do with `mdo`++```haskell+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE QualifiedDo #-}++f = Module.Path.mdo+  a <- foo+  return a+```+ ### Function applications  Long line, tuple  ```haskell-test-  (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmicro79)-  (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmicron80)-  ( alphaBetaGamma-  , deltaEpsilonZeta-  , etaThetaIota-  , kappaLambdaMu-  , nuXiOmicronP81)+a =+  test+    (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmic79)+    (alphaBetaGamma, deltaEpsilonZeta, etaThetaIota, kappaLambdaMu, nuXiOmicr80)+    ( alphaBetaGamma+    , deltaEpsilonZeta+    , etaThetaIota+    , kappaLambdaMu+    , nuXiOmicro81) ```  Long line, tuple section  ```haskell-test-  (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, nu79, )-  (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, , n80, )-  (-  , alphaBetaGamma-  ,-  , deltaEpsilonZeta-  ,-  , etaThetaIota-  , kappaLambdaMu-  ,-  , nu81-  ,)+a =+  test+    (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, nu79)+    (, alphaBetaGamma, , deltaEpsilonZeta, , etaThetaIota, kappaLambdaMu, nuX80)+    (+    , alphaBetaGamma+    ,+    , deltaEpsilonZeta+    ,+    , etaThetaIota+    , kappaLambdaMu+    , nuXi81+    ,) ```  Linebreaks after very short names if the total line length goes over the limit@@ -2369,9 +2402,10 @@ An infix operator with a lambda expression  ```haskell-for xs $ \x -> do-  left x-  right x+a =+  for xs $ \x -> do+    left x+    right x ```  Nested lambdas@@ -2406,6 +2440,8 @@ With implicit parameters  ```haskell+{-# LANGUAGE ImplicitParams #-}+ f =   let ?x = 42    in f@@ -2464,8 +2500,8 @@  ```haskell defaultExtensions =-  [e | e@EnableExtension {} <- knownExtensions] \\-  map EnableExtension badExtensions+  [e | e@EnableExtension {} <- knownExtensions]+    \\ map EnableExtension badExtensions ```  Transform list comprehensions@@ -2507,45 +2543,21 @@  ### Operators -Bad--```haskell-x =-  Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*>-  Just thisissolong <*>-  Just stilllonger <*>-  evenlonger-```--Good--```haskell pending-x =-  Value <$> thing <*> secondThing <*> thirdThing <*> fourthThing <*>-  Just thisissolong <*> Just stilllonger <*> evenlonger-```- With `do`  ```haskell-for xs $ do-  left x-  right x+a =+  for xs $ do+    left x+    right x ```  With lambda-case  ```haskell-for xs $ \case-  Left x -> x-```--`$` chain--```haskell-f =-  Right $-  S.lazyByteStrings $ addPrefix prefix $ S.toLazyByteString $ prettyPrint m+a =+  for xs $ \case+    Left x -> x ```  Qualified operator as an argument@@ -2602,14 +2614,62 @@  ```haskell -- https://github.com/mihaimaruseac/hindent/issues/473-template $-  haskell-    [ SomeVeryLongName-    , AnotherLongNameEvenLongToBreakTheLine-    , LastLongNameInList-    ]+a =+  template+    $ haskell+        [ SomeVeryLongName+        , AnotherLongNameEvenLongToBreakTheLine+        , LastLongNameInList+        ] ``` +#### Operator chains++Applicative style++```haskell+x =+  Value+    <$> thing+    <*> secondThing+    <*> thirdThing+    <*> fourthThing+    <*> Just thisissolong+    <*> Just stilllonger+    <*> evenlonger+```++`$` chain++```haskell+f =+  Right+    $ S.lazyByteStrings+    $ addPrefix prefix+    $ S.toLazyByteString+    $ prettyPrint m+```++Arithmetic operations++```haskell+f =+  aaaaaaaaaa * bbbbbbbbbbbbbb / cccccccccccccccccccccc+    + dddddddddddddd * eeeeeeeeeeeeeeee+    - ffffffffffffffff / -ggggggggggggg+```++Lens operators++```haskell+updateUsr usr =+  usr+    & userFirstName .~ "newfirst"+    & userLastName .~ "newlast"+    & userEmail .~ "newemail"+    & userPassword .~ "newpass"+```+ ### Primitive type values  `Char`@@ -2651,24 +2711,32 @@ Unboxed integers  ```haskell+{-# LANGUAGE MagicHash #-}+ a = 0# ```  Unboxed floating point numbers  ```haskell+{-# LANGUAGE MagicHash #-}+ a = 3.3# ```  Unboxed `Char`  ```haskell+{-# LANGUAGE MagicHash #-}+ a = 'c'# ```  Unboxed `String`  ```haskell+{-# LANGUAGE MagicHash #-}+ a = "Foo"# ``` @@ -2718,6 +2786,7 @@   [s|foo |] ```+ ### Ranges  from@@ -2829,12 +2898,13 @@   where     g h =       let x = undefined-       in do foo-             pure-               h-                 { grhssLocalBinds =-                     HsValBinds x (ValBinds (newSigs newSigMethods))-                 }+       in do+            foo+            pure+              h+                { grhssLocalBinds =+                    HsValBinds x (ValBinds (newSigs newSigMethods))+                } ```  `OverloadedRecordDot`@@ -2897,12 +2967,16 @@ Pattern brackets  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ mkPat = [p|(x, y)|] ```  Type brackets  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ foo :: $([t|Bool|]) -> a ``` @@ -2910,6 +2984,8 @@  ```haskell -- https://github.com/mihaimaruseac/hindent/issues/412+{-# LANGUAGE TemplateHaskell #-}+ data (-)  q = ''(-)@@ -2918,12 +2994,16 @@ Quoted list constructors  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ cons = '(:) ```  Pattern splices  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ f $pat = ()  g =@@ -2935,6 +3015,8 @@ Typed splice  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ foo = $$bar ``` @@ -2974,17 +3056,21 @@        Just -- after Just         -> do          justice -- after justice-          *-           foo-             (blah * blah + z + 2 / 4 + a - -- before a line break-              2 * -- inside this mess-              z /-              2 /-              2 /-              aooooo /-              aaaaa -- bob comment-              ) +-           (sdfsdfsd fsdfsdf) -- blah comment+           * foo+               (blah * blah+                  + z+                  + 2 / 4+                  + a+                  - -- before a line break+                   2+                     * -- inside this mess+                      z+                     / 2+                     / 2+                     / aooooo+                     / aaaaa -- bob comment+                )+           + (sdfsdfsd fsdfsdf) -- blah comment          putStrLn "")     [1, 2, 3]     [ 1 -- foo@@ -3013,26 +3099,14 @@   -- the very last block is detected differently ``` -Doesn't work yet (wrong comment position detection)+Comments in a do expression -```haskell pending+```haskell gamma = do   -- in the beginning of a do-block   delta-  where-    -- before alpha-    alpha = alpha ``` -Comments in a class declaration--```haskell-class Foo a-    -- A comment-  where-  foo :: a -> Int-```- Comments in a class instance  ```haskell@@ -3042,6 +3116,17 @@   pretty' = undefined ``` +Comments in a case expression++```haskell+-- https://github.com/mihaimaruseac/hindent/issues/553+f x =+  case x of+    -- Bla bla+    Nothing -> 0+    Just y -> y+```+ Haddock comments  ```haskell@@ -3076,6 +3161,15 @@ foo = undefined ``` +Haddock for a class method++```haskell+-- https://github.com/mihaimaruseac/hindent/issues/607+class Foo a where+  -- | Doc+  foo :: a+```+ Module header with haddock comments  ```haskell@@ -3119,17 +3213,21 @@        Just {- after Just -}         -> do          justice {- after justice -}-          *-           foo-             (blah * blah + z + 2 / 4 + a - {- before a line break -}-              2 * {- inside this mess -}-              z /-              2 /-              2 /-              aooooo /-              aaaaa {- bob comment -}-              ) +-           (sdfsdfsd fsdfsdf) {- blah comment -}+           * foo+               (blah * blah+                  + z+                  + 2 / 4+                  + a+                  - {- before a line break -}+                   2+                     * {- inside this mess -}+                      z+                     / 2+                     / 2+                     / aooooo+                     / aaaaa {- bob comment -}+                )+           + (sdfsdfsd fsdfsdf) {- blah comment -}          putStrLn "")     [1, 2, 3]     [ 1 {- foo -}@@ -3233,6 +3331,8 @@ A complex, slow-to-print decl  ```haskell+{-# LANGUAGE TemplateHaskell #-}+ quasiQuotes =   [ ( ''[]     , \(typeVariable:_) _automaticPrinter ->@@ -3291,6 +3391,8 @@ Quasi quotes  ```haskell+{-# LANGUAGE QuasiQuotes #-}+ exp = [name|exp|]  f [qq|pattern|] = ()@@ -3326,4 +3428,25 @@     } #define SHORT_MACRO_DEFINITION \   x+```++Language extensions are effective across CPP boundaries.++```haskell+{-# LANGUAGE PatternSynonyms #-}+#if 1+pattern Foo :: Int -> Bar+#else+pattern Foo :: Int -> Bar+#endif+```++## Literate Haskell++Code with `>`s++```haskell+> -- https://github.com/mihaimaruseac/hindent/issues/103+> foo :: a+> foo = undefined ```

@@ -1,6 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Unsafe #-}- -- | Main entry point to hindent. -- -- hindent@@ -8,143 +5,9 @@   ( main   ) where -import Control.Applicative-import Control.Exception-import Control.Monad-import qualified Data.ByteString as S-import qualified Data.ByteString.Builder as S-import qualified Data.ByteString.Lazy.Char8 as L8-import Data.Maybe-import qualified Data.Text as T-import Data.Version (showVersion)-import Foreign.C.Error-import GHC.IO.Exception import HIndent-import HIndent.CabalFile-import HIndent.Config-import HIndent.LanguageExtension-import HIndent.LanguageExtension.Types-import Options.Applicative hiding (action, style)-import Paths_hindent (version)-import qualified System.Directory as IO-import System.Exit (exitWith)-import qualified System.IO as IO--data Action-  = Validate-  | Reformat--data RunMode-  = ShowVersion-  | Run Config [Extension] Action [FilePath]+import System.Environment  -- | Main entry point. main :: IO ()-main = do-  config <- getConfig-  runMode <--    execParser-      (info-         (options config <**> helper)-         (header "hindent - Reformat Haskell source code"))-  case runMode of-    ShowVersion -> putStrLn ("hindent " ++ showVersion version)-    Run style exts action paths ->-      if null paths-        then L8.interact-               (either error S.toLazyByteString .-                reformat style (Just exts) Nothing . L8.toStrict)-        else forM_ paths $ \filepath -> do-               cabalexts <- getCabalExtensionsForSourcePath filepath-               text <- S.readFile filepath-               case reformat-                      style-                      (Just $ cabalexts ++ exts)-                      (Just filepath)-                      text of-                 Left e -> error e-                 Right out ->-                   unless (L8.fromStrict text == S.toLazyByteString out) $-                   case action of-                     Validate -> do-                       IO.putStrLn $ filepath ++ " is not formatted"-                       exitWith (ExitFailure 1)-                     Reformat -> do-                       tmpDir <- IO.getTemporaryDirectory-                       (fp, h) <- IO.openTempFile tmpDir "hindent.hs"-                       L8.hPutStr h (S.toLazyByteString out)-                       IO.hFlush h-                       IO.hClose h-                       let exdev e =-                             if ioe_errno e == Just ((\(Errno a) -> a) eXDEV)-                               then IO.copyFile fp filepath >> IO.removeFile fp-                               else throw e-                       IO.copyPermissions filepath fp-                       IO.renameFile fp filepath `catch` exdev---- | Program options.-options :: Config -> Parser RunMode-options config =-  flag' ShowVersion (long "version" <> help "Print the version") <|>-  (Run <$> style <*> exts <*> action <*> files)-  where-    style =-      (makeStyle config <$> lineLen <*> indentSpaces <*> trailingNewline <*>-       sortImports) <*-      optional-        (strOption-           (long "style" <>-            help "Style to print with (historical, now ignored)" <>-            metavar "STYLE") :: Parser String)-    exts =-      fmap-        getExtensions-        (many-           (T.pack <$>-            strOption-              (short 'X' <> help "Language extension" <> metavar "GHCEXT")))-    indentSpaces =-      option-        auto-        (long "indent-size" <>-         help "Indentation size in spaces" <>-         value (configIndentSpaces config) <> showDefault) <|>-      option-        auto-        (long "tab-size" <> help "Same as --indent-size, for compatibility")-    lineLen =-      option-        auto-        (long "line-length" <>-         help "Desired length of lines" <>-         value (configMaxColumns config) <> showDefault)-    trailingNewline =-      not <$>-      flag-        (not (configTrailingNewline config))-        (configTrailingNewline config)-        (long "no-force-newline" <>-         help "Don't force a trailing newline" <> showDefault)-    sortImports =-      flag-        Nothing-        (Just True)-        (long "sort-imports" <> help "Sort imports in groups" <> showDefault) <|>-      flag-        Nothing-        (Just False)-        (long "no-sort-imports" <> help "Don't sort imports")-    action =-      flag-        Reformat-        Validate-        (long "validate" <>-         help "Check if files are formatted without changing them")-    makeStyle s mlen tabs trailing imports =-      s-        { configMaxColumns = mlen-        , configIndentSpaces = tabs-        , configTrailingNewline = trailing-        , configSortImports = fromMaybe (configSortImports s) imports-        }-    files = many (strArgument (metavar "FILENAMES"))+main = getArgs >>= hindent

@@ -8,13 +8,10 @@ import Criterion import Criterion.Main import qualified Data.ByteString as S-import qualified Data.ByteString.Builder as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.UTF8 as UTF8 import HIndent-import HIndent.Config import HIndent.Internal.Test.Markdone-import HIndent.LanguageExtension  -- | Main benchmarks. main :: IO ()@@ -31,16 +28,13 @@       bgroup (S8.unpack name) (go children) : go next     go (PlainText desc:CodeFence lang code:next) =       if lang == "haskell"-        then (bench-                (UTF8.toString desc)-                (nf-                   (either error S.toLazyByteString .-                    reformat-                      HIndent.Config.defaultConfig-                      (Just defaultExtensions)-                      Nothing)-                   code)) :-             go next+        then bench+               (UTF8.toString desc)+               (nf+                  (either (error . show) id+                     . reformat HIndent.defaultConfig [] Nothing)+                  code)+               : go next         else go next     go (PlainText {}:next) = go next     go (CodeFence {}:next) = go next

@@ -1,13 +1,13 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack  name:           hindent-version:        6.0.0+version:        6.1.0 synopsis:       Extensible Haskell pretty printer-description:    Extensible Haskell pretty printer. Both a library and an executable. See the GitHub page for usage/explanation: <https://github.com/mihaimaruseac/hindent>+description:    Extensible Haskell pretty printer. Both a library and an executable. See the GitHub page for usage / explanation: <https://github.com/mihaimaruseac/hindent> category:       Development stability:      Unstable homepage:       https://github.com/mihaimaruseac/hindent@@ -33,10 +33,16 @@ library   exposed-modules:       HIndent+  other-modules:       HIndent.Applicative+      HIndent.ByteString       HIndent.CabalFile       HIndent.CodeBlock+      HIndent.CommandlineOptions       HIndent.Config+      HIndent.Error+      HIndent.Fixity+      HIndent.GhcLibParserWrapper.GHC.Hs       HIndent.Language       HIndent.LanguageExtension       HIndent.LanguageExtension.Conversion@@ -65,8 +71,9 @@       HIndent.Pretty.SigBindFamily       HIndent.Pretty.Types       HIndent.Printer-  other-modules:       Paths_hindent+  autogen-modules:+      Paths_hindent   hs-source-dirs:       src   ghc-options: -Wall -O2@@ -81,29 +88,35 @@     , ghc-lib-parser-ex     , monad-loops     , mtl+    , optparse-applicative     , path     , path-io     , regex-tdfa     , split     , syb-    , text     , transformers     , unicode-show     , utf8-string     , yaml-  if impl(ghc >= 9.4.1)+  default-language: Haskell2010+  if impl(ghc >= 9.6.1)     build-depends:-        ghc-lib-parser >=9.4.1.20220807 && <9.5+        ghc-lib-parser >=9.6.1.20230312 && <9.7   else-    build-depends:-        ghc-lib-parser >=9.2.3.20220527 && <9.3-  default-language: Haskell2010+    if impl(ghc >= 9.4.1)+      build-depends:+          ghc-lib-parser >=9.4.1.20220807 && <9.5+    else+      build-depends:+          ghc-lib-parser >=9.2.3.20220527 && <9.3  library hindent-internal   exposed-modules:       HIndent.Internal.Test.Markdone   other-modules:       Paths_hindent+  autogen-modules:+      Paths_hindent   hs-source-dirs:       internal   ghc-options: -Wall -O2@@ -119,23 +132,27 @@     , ghc-lib-parser-ex     , monad-loops     , mtl+    , optparse-applicative     , path     , path-io     , regex-tdfa     , split     , syb-    , text     , transformers     , unicode-show     , utf8-string     , yaml-  if impl(ghc >= 9.4.1)+  default-language: Haskell2010+  if impl(ghc >= 9.6.1)     build-depends:-        ghc-lib-parser >=9.4.1.20220807 && <9.5+        ghc-lib-parser >=9.6.1.20230312 && <9.7   else-    build-depends:-        ghc-lib-parser >=9.2.3.20220527 && <9.3-  default-language: Haskell2010+    if impl(ghc >= 9.4.1)+      build-depends:+          ghc-lib-parser >=9.4.1.20220807 && <9.5+    else+      build-depends:+          ghc-lib-parser >=9.2.3.20220527 && <9.3  executable hindent   main-is: Main.hs@@ -164,24 +181,29 @@     , regex-tdfa     , split     , syb-    , text     , transformers     , unicode-show     , utf8-string     , yaml-  if impl(ghc >= 9.4.1)+  default-language: Haskell2010+  if impl(ghc >= 9.6.1)     build-depends:-        ghc-lib-parser >=9.4.1.20220807 && <9.5+        ghc-lib-parser >=9.6.1.20230312 && <9.7   else-    build-depends:-        ghc-lib-parser >=9.2.3.20220527 && <9.3-  default-language: Haskell2010+    if impl(ghc >= 9.4.1)+      build-depends:+          ghc-lib-parser >=9.4.1.20220807 && <9.5+    else+      build-depends:+          ghc-lib-parser >=9.2.3.20220527 && <9.3  test-suite hindent-test   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:       Paths_hindent+  autogen-modules:+      Paths_hindent   hs-source-dirs:       tests   ghc-options: -Wall -O2@@ -200,29 +222,35 @@     , hspec     , monad-loops     , mtl+    , optparse-applicative     , path     , path-io     , regex-tdfa     , split     , syb-    , text     , transformers     , unicode-show     , utf8-string     , yaml-  if impl(ghc >= 9.4.1)+  default-language: Haskell2010+  if impl(ghc >= 9.6.1)     build-depends:-        ghc-lib-parser >=9.4.1.20220807 && <9.5+        ghc-lib-parser >=9.6.1.20230312 && <9.7   else-    build-depends:-        ghc-lib-parser >=9.2.3.20220527 && <9.3-  default-language: Haskell2010+    if impl(ghc >= 9.4.1)+      build-depends:+          ghc-lib-parser >=9.4.1.20220807 && <9.5+    else+      build-depends:+          ghc-lib-parser >=9.2.3.20220527 && <9.3  benchmark hindent-bench   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:       Paths_hindent+  autogen-modules:+      Paths_hindent   hs-source-dirs:       benchmarks   ghc-options: -Wall -O2@@ -241,20 +269,24 @@     , hindent-internal     , monad-loops     , mtl+    , optparse-applicative     , path     , path-io     , regex-tdfa     , split     , syb-    , text     , transformers     , unicode-show     , utf8-string     , yaml-  if impl(ghc >= 9.4.1)+  default-language: Haskell2010+  if impl(ghc >= 9.6.1)     build-depends:-        ghc-lib-parser >=9.4.1.20220807 && <9.5+        ghc-lib-parser >=9.6.1.20230312 && <9.7   else-    build-depends:-        ghc-lib-parser >=9.2.3.20220527 && <9.3-  default-language: Haskell2010+    if impl(ghc >= 9.4.1)+      build-depends:+          ghc-lib-parser >=9.4.1.20220807 && <9.5+    else+      build-depends:+          ghc-lib-parser >=9.2.3.20220527 && <9.3

@@ -65,14 +65,14 @@         Normal ->           if S8.isPrefixOf "#" line             then let (hashes, title) = S8.span (== '#') line-                  in return $-                     Heading (S8.length hashes) (S8.dropWhile isSpace title)+                  in return+                       $ Heading (S8.length hashes) (S8.dropWhile isSpace title)             else if S8.isPrefixOf "```" line                    then do                      put Fenced-                     return $-                       BeginFence-                         (S8.dropWhile (\c -> c == '`' || c == ' ') line)+                     return+                       $ BeginFence+                           (S8.dropWhile (\c -> c == '`' || c == ' ') line)                    else return $ PlainLine line         Fenced ->           if line == "```"@@ -94,9 +94,10 @@                      Heading nextN _ -> nextN > n                      _ -> True)                   rest-           in do childs <- go (level + 1) children-                 siblings <- go level rest'-                 return (Section label childs : siblings)+           in do+                childs <- go (level + 1) children+                siblings <- go level rest'+                return (Section label childs : siblings)         (BeginFence label:rest)           | level > 0 ->             let (content, rest') =

@@ -5,37 +5,48 @@  -- | Haskell indenter. module HIndent-  ( -- * Formatting functions.+  ( -- * The entry point.+    hindent+  , -- * Formatting functions.     reformat-  , prettyPrint+  , -- * Config+    Config(..)+  , defaultConfig+  , getConfig+  , -- * Extension+    Extension(..)+  , -- * Error+    ParseError(..)+  , prettyParseError   , -- * Testing     testAst+  , HsModule'   ) where +import Control.Exception+import Control.Monad import Control.Monad.State.Strict-import Control.Monad.Trans.Maybe import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as S import qualified Data.ByteString.Char8 as S8-import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.ByteString.Unsafe as S import Data.Char-import Data.Either-import Data.Function-import Data.Functor.Identity-import Data.List hiding (stripPrefix) import Data.Maybe-import Data.Monoid-import GHC.Hs-import GHC.Parser.Lexer hiding (buffer)+import Data.Version+import Foreign.C+import GHC.IO.Exception+import GHC.Parser.Lexer hiding (buffer, options) import GHC.Types.SrcLoc+import HIndent.ByteString+import HIndent.CabalFile import HIndent.CodeBlock+import HIndent.CommandlineOptions import HIndent.Config+import HIndent.Error+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.LanguageExtension import qualified HIndent.LanguageExtension.Conversion as CE import HIndent.LanguageExtension.Types@@ -43,132 +54,147 @@ import HIndent.Parse import HIndent.Pretty import HIndent.Printer-import Prelude+import Options.Applicative hiding (ParseError, action, style)+import Paths_hindent+import qualified System.Directory as IO+import System.Exit+import qualified System.IO as IO +-- | Runs HIndent with the given commandline options.+hindent :: [String] -> IO ()+hindent args = do+  config <- getConfig+  runMode <-+    handleParseResult+      $ execParserPure+          defaultPrefs+          (info+             (options config <**> helper)+             (header "hindent - Reformat Haskell source code"))+          args+  case runMode of+    ShowVersion -> putStrLn ("hindent " ++ showVersion version)+    Run style exts action paths ->+      if null paths+        then S8.interact+               (either (error . prettyParseError) id+                  . reformat style exts Nothing)+        else forM_ paths $ \filepath -> do+               cabalexts <- getCabalExtensionsForSourcePath filepath+               text <- S.readFile filepath+               case reformat style (cabalexts ++ exts) (Just filepath) text of+                 Left e -> error $ prettyParseError e+                 Right out ->+                   unless (text == out)+                     $ case action of+                         Validate -> do+                           IO.putStrLn $ filepath ++ " is not formatted"+                           exitWith (ExitFailure 1)+                         Reformat -> do+                           tmpDir <- IO.getTemporaryDirectory+                           (fp, h) <- IO.openTempFile tmpDir "hindent.hs"+                           S8.hPutStr h out+                           IO.hFlush h+                           IO.hClose h+                           let exdev e =+                                 if ioe_errno e+                                      == Just ((\(Errno a) -> a) eXDEV)+                                   then IO.copyFile fp filepath+                                          >> IO.removeFile fp+                                   else throw e+                           IO.copyPermissions filepath fp+                           IO.renameFile fp filepath `catch` exdev+ -- | Format the given source. reformat ::      Config-  -> Maybe [Extension]+  -> [Extension]   -> Maybe FilePath   -> ByteString-  -> Either String Builder-reformat config mexts mfilepath =+  -> Either ParseError ByteString+reformat config mexts mfilepath rawCode =   preserveTrailingNewline-    (fmap (mconcat . intersperse "\n") . mapM processBlock . cppSplitBlocks)+    (fmap unlines' . mapM processBlock . cppSplitBlocks)+    rawCode   where-    processBlock :: CodeBlock -> Either String Builder-    processBlock (Shebang text) = Right $ S.byteString text-    processBlock (CPPDirectives text) = Right $ S.byteString text+    processBlock :: CodeBlock -> Either ParseError ByteString+    processBlock (Shebang text) = Right text+    processBlock (CPPDirectives text) = Right text     processBlock (HaskellSource yPos text) =       let ls = S8.lines text           prefix = findPrefix ls           code = unlines' (map (stripPrefix prefix) ls)-          allExts =-            fromMaybe allExtensions mexts ++-            configExtensions config ++-            collectLanguageExtensionsFromSource (UTF8.toString code)-          exts = CE.uniqueExtensions allExts-       in case parseModule mfilepath exts (UTF8.toString code) of+       in case parseModule mfilepath allExts (UTF8.toString code) of             POk _ m ->-              Right $-              S.lazyByteString $-              addPrefix prefix $ S.toLazyByteString $ prettyPrint config m+              Right+                $ addPrefix prefix+                $ L.toStrict+                $ S.toLazyByteString+                $ prettyPrint config m             PFailed st ->               let rawErrLoc = psRealLoc $ loc st-                  adjustedLoc =-                    (srcLocLine rawErrLoc + yPos, srcLocCol rawErrLoc)-               in Left $ "Parse failed near " ++ show adjustedLoc-    unlines' = S.concat . intersperse "\n"-    unlines'' = L.concat . intersperse "\n"-    addPrefix :: ByteString -> L8.ByteString -> L8.ByteString-    addPrefix prefix = unlines'' . map (L8.fromStrict prefix <>) . L8.lines-    stripPrefix :: ByteString -> ByteString -> ByteString-    stripPrefix prefix line =-      if S.null (S8.dropWhile (== '\n') line)-        then line-        else fromMaybe (error "Missing expected prefix") . s8_stripPrefix prefix $-             line-    findPrefix :: [ByteString] -> ByteString-    findPrefix = takePrefix False . findSmallestPrefix . dropNewlines-    dropNewlines :: [ByteString] -> [ByteString]-    dropNewlines = filter (not . S.null . S8.dropWhile (== '\n'))-    takePrefix :: Bool -> ByteString -> ByteString-    takePrefix bracketUsed txt =-      case S8.uncons txt of-        Nothing -> ""-        Just ('>', txt') ->-          if not bracketUsed-            then S8.cons '>' (takePrefix True txt')-            else ""-        Just (c, txt') ->-          if c == ' ' || c == '\t'-            then S8.cons c (takePrefix bracketUsed txt')-            else ""-    findSmallestPrefix :: [ByteString] -> ByteString-    findSmallestPrefix [] = ""-    findSmallestPrefix ("":_) = ""-    findSmallestPrefix (p:ps) =-      let first = S8.head p-          startsWithChar c x = S8.length x > 0 && S8.head x == c-       in if all (startsWithChar first) ps-            then S8.cons first (findSmallestPrefix (S.tail p : map S.tail ps))-            else ""+               in Left+                    $ ParseError+                        { errorLine = srcLocLine rawErrLoc + yPos+                        , errorCol = srcLocCol rawErrLoc+                        , errorFile = fromMaybe "<interactive>" mfilepath+                        }     preserveTrailingNewline f x       | S8.null x || S8.all isSpace x = return mempty       | hasTrailingLine x || configTrailingNewline config =         fmap           (\x' ->-             if hasTrailingLine (L.toStrict (S.toLazyByteString x'))+             if hasTrailingLine x'                then x'                else x' <> "\n")           (f x)       | otherwise = f x+    allExts =+      CE.uniqueExtensions+        $ concatMap (\x -> x : extensionImplies x)+        $ mexts ++ configExtensions config ++ allExtsFromCode+    allExtsFromCode = concatMap f codeBlocks+      where+        f (HaskellSource _ text) =+          collectLanguageExtensionsFromSource $ UTF8.toString text+        f _ = []+    codeBlocks = cppSplitBlocks rawCode  -- | Generate an AST from the given module for debugging.-testAst :: ByteString -> Either String HsModule+testAst :: ByteString -> Either ParseError HsModule' testAst x =   case parseModule Nothing exts (UTF8.toString x) of     POk _ m -> Right $ modifyASTForPrettyPrinting m     PFailed st ->-      Left $-      "Parse failed near " ++-      show ((,) <$> srcLocLine <*> srcLocCol $ psRealLoc $ loc st)+      Left+        $ ParseError <$> srcLocLine <*> srcLocCol <*> pure "<interactive>"+        $ psRealLoc+        $ loc st   where     exts =-      CE.uniqueExtensions $-      collectLanguageExtensionsFromSource $ UTF8.toString x---- | Does the strict bytestring have a trailing newline?-hasTrailingLine :: ByteString -> Bool-hasTrailingLine xs = not (S8.null xs) && S8.last xs == '\n'+      CE.uniqueExtensions+        $ collectLanguageExtensionsFromSource+        $ UTF8.toString x  -- | Print the module.-prettyPrint :: Config -> HsModule -> Builder+prettyPrint :: Config -> HsModule' -> Builder prettyPrint config m =   runPrinterStyle config (pretty $ modifyASTForPrettyPrinting m)  -- | Pretty print the given printable thing. runPrinterStyle :: Config -> Printer () -> Builder runPrinterStyle config m =-  maybe-    (error "Printer failed with mzero call.")-    psOutput-    (runIdentity-       (runMaybeT-          (execStateT-             (runPrinter m)-             (PrintState-                { psIndentLevel = 0-                , psOutput = mempty-                , psNewline = False-                , psColumn = 0-                , psLine = 1-                , psConfig = config-                , psFitOnOneLine = False-                , psEolComment = False-                }))))--s8_stripPrefix :: ByteString -> ByteString -> Maybe ByteString-s8_stripPrefix bs1@(S.PS _ _ l1) bs2-  | bs1 `S.isPrefixOf` bs2 = Just (S.unsafeDrop l1 bs2)-  | otherwise = Nothing+  maybe (error "Printer failed with mzero call.") psOutput+    $ execStateT (runPrinter m) initState+  where+    initState =+      PrintState+        { psIndentLevel = 0+        , psOutput = mempty+        , psNewline = False+        , psColumn = 0+        , psLine = 1+        , psConfig = config+        , psFitOnOneLine = False+        , psEolComment = False+        }

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Helper functions to manipulate `ByteString`.+module HIndent.ByteString+  ( findPrefix+  , stripPrefix+  , addPrefix+  , unlines'+  , hasTrailingLine+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import Data.List hiding (stripPrefix)+import Data.Maybe++-- | Returns the prefix that all the given `ByteString`s except for the ones composed of `\n`s have.+--+-- The regex of the prefix is `>?[ \t]*`.+findPrefix :: [ByteString] -> ByteString+findPrefix = takePrefix . findCommonPrefix . dropNewlines++-- | Removes the given prefix from the passed `ByteString`, or raises an error.+stripPrefix :: ByteString -> ByteString -> ByteString+stripPrefix prefix =+  fromMaybe (error "Missing expected prefix") . S.stripPrefix prefix++-- | Add a prefix to all lines in a `ByteString`.+addPrefix :: ByteString -> ByteString -> ByteString+addPrefix prefix = unlines' . map (prefix <>) . S8.lines++-- | Returns the prefix that all the given `ByteString`s have.+findCommonPrefix :: [ByteString] -> ByteString+findCommonPrefix [] = ""+findCommonPrefix ("":_) = ""+findCommonPrefix (p:ps) =+  if all (startsWithChar first) ps+    then S8.cons first (findCommonPrefix (S.tail p : map S.tail ps))+    else ""+  where+    first = S8.head p++-- | `unlines'` for `ByteString`.+unlines' :: [ByteString] -> ByteString+unlines' = S.concat . intersperse "\n"++-- | Returns the prefix from the `ByteString`+--+-- The regex of the prefix is `>?[ \t]*`.+takePrefix :: ByteString -> ByteString+takePrefix txt+  | S8.null txt = ""+  | S8.head txt == '>' = S8.cons '>' $ takeSpaceOrTab $ S8.tail txt+  | otherwise = takeSpaceOrTab txt++-- | Filters out `ByteString`s composed of only `\n`s.+dropNewlines :: [ByteString] -> [ByteString]+dropNewlines = filter (not . S.null . S8.dropWhile (== '\n'))++-- | `takeWhile` for spaces or tabs+takeSpaceOrTab :: ByteString -> ByteString+takeSpaceOrTab = S8.takeWhile isSpaceOrTab++-- | Does the strict bytestring have a trailing newline?+hasTrailingLine :: ByteString -> Bool+hasTrailingLine xs = not (S8.null xs) && S8.last xs == '\n'++-- | Returns if the `ByteString` starts with the given `Char`.+startsWithChar :: Char -> ByteString -> Bool+startsWithChar c x = S8.length x > 0 && S8.head x == c++-- | Returns if the `Char` is either a space or a tab.+isSpaceOrTab :: Char -> Bool+isSpaceOrTab = (`elem` [' ', '\t'])

@@ -21,7 +21,7 @@ import Distribution.PackageDescription.Parse #endif import HIndent.Language-import HIndent.LanguageExtension hiding (defaultExtensions)+import HIndent.LanguageExtension import HIndent.LanguageExtension.Conversion import HIndent.LanguageExtension.Types import Language.Haskell.Extension hiding (Extension)@@ -50,8 +50,8 @@           case toRelative dir path of             Nothing -> False             Just relpath ->-              any (equalFilePath $ dropExtension relpath) modpaths ||-              any (equalFilePath relpath) fpaths+              any (equalFilePath $ dropExtension relpath) modpaths+                || any (equalFilePath relpath) fpaths      in any inDir $ hsSourceDirs' bi   where @@ -79,15 +79,15 @@              _ -> [])       benchStanza :: Benchmark -> Stanza       benchStanza bn =-        mkStanza (benchmarkBuildInfo bn) [] $-        case benchmarkInterface bn of-          BenchmarkExeV10 _ path -> [path]-          _ -> []+        mkStanza (benchmarkBuildInfo bn) []+          $ case benchmarkInterface bn of+              BenchmarkExeV10 _ path -> [path]+              _ -> []    in mconcat-        [ maybeToList $ fmap libStanza $ library pd-        , fmap exeStanza $ executables pd-        , fmap testStanza $ testSuites pd-        , fmap benchStanza $ benchmarks pd+        [ maybeToList $ libStanza <$> library pd+        , exeStanza <$> executables pd+        , testStanza <$> testSuites pd+        , benchStanza <$> benchmarks pd         ]  -- | Find cabal files that are "above" the source path@@ -100,7 +100,7 @@     []       | dir == "/" -> return Nothing     [] -> findCabalFiles (takeDirectory dir) (takeFileName dir </> rel)-    _ -> return $ Just (fmap (\n -> dir </> n) cabalnames, rel)+    _ -> return $ Just (fmap (dir </>) cabalnames, rel)  getGenericPackageDescription :: FilePath -> IO (Maybe GenericPackageDescription) #if MIN_VERSION_Cabal(2, 2, 0)@@ -128,27 +128,25 @@             Nothing -> return []             Just gpd -> do               return $ packageStanzas $ flattenPackageDescription gpd-      return $-        case filter (\stanza -> stanzaIsSourceFilePath stanza relpath) $-             mconcat stanzass of-          [] -> Nothing-          (stanza:_) -> Just stanza -- just pick the first one+      return+        $ case filter (`stanzaIsSourceFilePath` relpath) $ mconcat stanzass of+            [] -> Nothing+            (stanza:_) -> Just stanza -- just pick the first one     Nothing -> return Nothing  -- | Get language and extensions from the cabal file for this source path getCabalExtensions :: FilePath -> IO (Language, [Extension]) getCabalExtensions srcpath = do   mstanza <- getCabalStanza srcpath-  return $-    case mstanza of-      Nothing -> (Haskell98, [])-      Just (MkStanza bi _) ->-        ( fromMaybe Haskell98 $ defaultLanguage bi-        , mapMaybe fromCabalExtension $ defaultExtensions bi)+  return+    $ case mstanza of+        Nothing -> (Haskell98, [])+        Just (MkStanza bi _) ->+          ( fromMaybe Haskell98 $ defaultLanguage bi+          , mapMaybe fromCabalExtension $ defaultExtensions bi)  -- | Get extensions from the cabal file for this source path getCabalExtensionsForSourcePath :: FilePath -> IO [Extension] getCabalExtensionsForSourcePath srcpath = do   (lang, exts) <- getCabalExtensions srcpath-  let allExts = exts ++ implicitExtensions (convertLanguage lang)-  return $ concatMap extensionImplies allExts+  return $ exts ++ implicitExtensions (convertLanguage lang)

@@ -31,9 +31,12 @@ -- will become five blocks, one for each CPP line and one for each pair of declarations. cppSplitBlocks :: ByteString -> [CodeBlock] cppSplitBlocks inp =-  modifyLast (inBlock (<> trailing)) .-  groupLines . classifyLines . zip [0 ..] . S8.lines $-  inp+  modifyLast (inBlock (<> trailing))+    . groupLines+    . classifyLines+    . zip [0 ..]+    . S8.lines+    $ inp   where     groupLines :: [CodeBlock] -> [CodeBlock]     groupLines (line1:line2:remainingLines) =@@ -73,8 +76,8 @@     classifyLines allLines@((lineIndex, src):nextLines)       | cppLine src =         let (cppLines, nextLines') = spanCPPLines allLines-         in CPPDirectives (S8.intercalate "\n" (map snd cppLines)) :-            classifyLines nextLines'+         in CPPDirectives (S8.intercalate "\n" (map snd cppLines))+              : classifyLines nextLines'       | shebangLine src = Shebang src : classifyLines nextLines       | otherwise = HaskellSource lineIndex src : classifyLines nextLines     classifyLines [] = []

@@ -0,0 +1,95 @@+-- | Types and functions related to HIndent's commandline options.+module HIndent.CommandlineOptions+  ( Action(..)+  , RunMode(..)+  , options+  ) where++import Data.Maybe+import HIndent.Config+import HIndent.LanguageExtension+import HIndent.LanguageExtension.Types+import Options.Applicative hiding (action, style)++-- | HIndent actions.+data Action+  = Validate -- ^ Validate if the code is formatted.+  | Reformat -- ^ Format the code.++-- | HIndent running mode.+data RunMode+  = ShowVersion -- ^ Show HIndent's version.+  | Run Config [Extension] Action [FilePath] -- ^ Format or validate the code.++-- | Program options.+options :: Config -> Parser RunMode+options config =+  flag' ShowVersion (long "version" <> help "Print the version")+    <|> (Run <$> style <*> exts <*> action <*> files)+  where+    style =+      (makeStyle config+         <$> lineLen+         <*> indentSpaces+         <*> trailingNewline+         <*> sortImports)+        <* optional+             (strOption+                (long "style"+                   <> help "Style to print with (historical, now ignored)"+                   <> metavar "STYLE") :: Parser String)+    exts =+      fmap+        getExtensions+        (many+           (strOption+              (short 'X' <> help "Language extension" <> metavar "GHCEXT")))+    indentSpaces =+      option+        auto+        (long "indent-size"+           <> help "Indentation size in spaces"+           <> value (configIndentSpaces config)+           <> showDefault)+        <|> option+              auto+              (long "tab-size"+                 <> help "Same as --indent-size, for compatibility")+    lineLen =+      option+        auto+        (long "line-length"+           <> help "Desired length of lines"+           <> value (configMaxColumns config)+           <> showDefault)+    trailingNewline =+      not+        <$> flag+              (not (configTrailingNewline config))+              (configTrailingNewline config)+              (long "no-force-newline"+                 <> help "Don't force a trailing newline"+                 <> showDefault)+    sortImports =+      flag+        Nothing+        (Just True)+        (long "sort-imports" <> help "Sort imports in groups" <> showDefault)+        <|> flag+              Nothing+              (Just False)+              (long "no-sort-imports" <> help "Don't sort imports")+    action =+      flag+        Reformat+        Validate+        (long "validate"+           <> help "Check if files are formatted without changing them")+    makeStyle s mlen tabs trailing imports =+      s+        { configMaxColumns = mlen+        , configIndentSpaces = tabs+        , configTrailingNewline = trailing+        , configSortImports = fromMaybe (configSortImports s) imports+        }+    files = many (strArgument (metavar "FILENAMES"))

@@ -32,17 +32,23 @@  instance FromJSON Config where   parseJSON (Y.Object v) =-    Config <$>-    fmap (fromMaybe (configMaxColumns defaultConfig)) (v Y..:? "line-length") <*>-    fmap-      (fromMaybe (configIndentSpaces defaultConfig))-      (v Y..:? "indent-size" <|> v Y..:? "tab-size") <*>-    fmap-      (fromMaybe (configTrailingNewline defaultConfig))-      (v Y..:? "force-trailing-newline") <*>-    fmap (fromMaybe (configSortImports defaultConfig)) (v Y..:? "sort-imports") <*>-    fmap (fromMaybe (configLineBreaks defaultConfig)) (v Y..:? "line-breaks") <*>-    (traverse convertExt . fromMaybe [] =<< v Y..:? "extensions")+    Config+      <$> fmap+            (fromMaybe (configMaxColumns defaultConfig))+            (v Y..:? "line-length")+      <*> fmap+            (fromMaybe (configIndentSpaces defaultConfig))+            (v Y..:? "indent-size" <|> v Y..:? "tab-size")+      <*> fmap+            (fromMaybe (configTrailingNewline defaultConfig))+            (v Y..:? "force-trailing-newline")+      <*> fmap+            (fromMaybe (configSortImports defaultConfig))+            (v Y..:? "sort-imports")+      <*> fmap+            (fromMaybe (configLineBreaks defaultConfig))+            (v Y..:? "line-breaks")+      <*> (traverse convertExt . fromMaybe [] =<< v Y..:? "extensions")     where       convertExt x =         case strToExt x of

@@ -0,0 +1,25 @@+{-# LANGUAGE RecordWildCards #-}++-- | Error types and functions.+module HIndent.Error+  ( ParseError(..)+  , prettyParseError+  ) where++-- | Parse error type with the location.+data ParseError = ParseError+  { errorLine :: Int -- ^ The row of the parse error's location.+  , errorCol :: Int -- ^ The column of the parse error's location.+  , errorFile :: FilePath -- ^ The filename HIndent failed to parse.+  } deriving (Eq, Ord, Show, Read)++-- | Pretty-print `ParseError`.+prettyParseError :: ParseError -> String+prettyParseError ParseError {..} =+  "Parse failed at ("+    <> show errorLine+    <> ", "+    <> show errorCol+    <> ") in "+    <> errorFile+    <> "."

@@ -0,0 +1,67 @@+-- | Operator fixities.+--+-- It is very difficult to take operators' fixities into account as fixity+-- information is not stored in an AST. While `ghc-lib-parser-ex` provides+-- `fixitiesFromModule`, it is almost useless as operators are usually imported+-- from other modules.+--+-- Ormolu is trying to resolve this issue by examing Hackage, but doing the same+-- way in HIndent is not so easy.+module HIndent.Fixity+  ( fixities+  ) where++import GHC.Types.Fixity+import Language.Haskell.GhclibParserEx.Fixity++-- | Operator fixities that HIndent supports.+fixities :: [(String, Fixity)]+fixities = baseFixities <> lensFixities++-- | Fixities of operators defined in lens package.+lensFixities :: [(String, Fixity)]+lensFixities =+  concat+    [ infixr_+        4+        [ ".~"+        , "%~"+        , "+~"+        , "-~"+        , "*~"+        , "//~"+        , "^~"+        , "^^~"+        , "**~"+        , "||~"+        , "<>~"+        , "&&~"+        , "<.~"+        , "?~"+        , "<?~"+        , "%@~"+        , ".@~"+        ]+    , infix_+        4+        [ ".="+        , "%="+        , "+="+        , "-="+        , "*="+        , "//="+        , "^="+        , "^^="+        , "**="+        , "||="+        , "<>="+        , "&&="+        , "<.="+        , "?="+        , "<?="+        , "%@="+        , ".@="+        ]+    , infixr_ 2 ["<^"]+    , infixl_ 1 ["&"]+    ]

@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++-- | Wrapper for 'GHC.Hs'+module HIndent.GhcLibParserWrapper.GHC.Hs+  ( module GHC.Hs+  , HsModule'+  ) where++import GHC.Hs+-- | The wrapper for `HsModule`+#if MIN_VERSION_ghc_lib_parser(9,6,1)+type HsModule' = HsModule GhcPs+#else+type HsModule' = HsModule+#endif

@@ -6,8 +6,6 @@   ( implicitExtensions   , extensionImplies   , collectLanguageExtensionsFromSource-  , defaultExtensions-  , allExtensions   , getExtensions   ) where @@ -15,9 +13,7 @@ import Data.List import Data.List.Split import Data.Maybe-import qualified Data.Text as T import qualified GHC.Driver.Session as GLP-import qualified GHC.LanguageExtensions as GLP import HIndent.LanguageExtension.Conversion import HIndent.LanguageExtension.Types import HIndent.Pragma@@ -44,12 +40,13 @@ -- | Collect pragmas specified in the source code. collectLanguageExtensionsFromSource :: String -> [Extension] collectLanguageExtensionsFromSource =-  (++) <$> collectLanguageExtensionsSpecifiedViaLanguagePragma <*>-  collectLanguageExtensionsFromSourceViaOptionsPragma+  (++)+    <$> collectLanguageExtensionsSpecifiedViaLanguagePragma+    <*> collectLanguageExtensionsFromSourceViaOptionsPragma  -- | Consume an extensions list from arguments.-getExtensions :: [T.Text] -> [Extension]-getExtensions = foldr (f . T.unpack) defaultExtensions+getExtensions :: [String] -> [Extension]+getExtensions = foldr f []   where     f "Haskell98" _ = []     f x a =@@ -64,18 +61,21 @@ -- This function ignores language extensions not supported by Cabal. collectLanguageExtensionsSpecifiedViaLanguagePragma :: String -> [Extension] collectLanguageExtensionsSpecifiedViaLanguagePragma =-  mapMaybe (strToExt . stripSpaces) .-  concatMap (splitOn ",") .-  fmap snd . filter ((== "LANGUAGE") . fst) . extractPragmasFromCode+  mapMaybe (strToExt . stripSpaces)+    . concatMap (splitOn ",")+    . fmap snd+    . filter ((== "LANGUAGE") . fst)+    . extractPragmasFromCode  -- | Extracts the language extensions specified by @-XFOO@ from @OPTIONS@ -- or @OPTIONS_GHC@ pragmas collectLanguageExtensionsFromSourceViaOptionsPragma :: String -> [Extension] collectLanguageExtensionsFromSourceViaOptionsPragma =-  mapMaybe (strToExt . stripSpaces) .-  concatMap extractLanguageExtensionsFromOptions .-  fmap snd .-  filter ((`elem` ["OPTIONS", "OPTIONS_GHC"]) . fst) . extractPragmasFromCode+  mapMaybe (strToExt . stripSpaces)+    . concatMap extractLanguageExtensionsFromOptions+    . fmap snd+    . filter ((`elem` ["OPTIONS", "OPTIONS_GHC"]) . fst)+    . extractPragmasFromCode  -- | Extracts the language extensions specified in the '-XFOO' format from -- the given string@@ -91,31 +91,3 @@ -- | Removes spaces before and after the string. stripSpaces :: String -> String stripSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace---- | Default extensions.-defaultExtensions :: [Extension]-defaultExtensions = fmap EnableExtension $ [minBound ..] \\ badExtensions---- | All extensions supported by Cabal.-allExtensions :: [Extension]-allExtensions = fmap EnableExtension [minBound ..]---- | Extensions which steal too much syntax.-badExtensions :: [GLP.Extension]-badExtensions =-  [ GLP.Arrows -- steals proc-  , GLP.TransformListComp -- steals the group keyword-  , GLP.UnboxedTuples -- breaks (#) lens operator-  , GLP.UnboxedSums -- Same as 'UnboxedTuples'-    -- ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break-  , GLP.PatternSynonyms -- steals the pattern keyword-  , GLP.RecursiveDo -- steals the rec keyword-  , GLP.TypeApplications -- Steals `@`-  , GLP.StaticPointers -- Steals the `static` keyword-  , GLP.AlternativeLayoutRule -- Breaks a few tests-  , GLP.AlternativeLayoutRuleTransitional -- Same as `AlternativeLayoutRule`-  , GLP.LexicalNegation -- Cannot handle minus signs in some cases-  , GLP.OverloadedRecordDot -- Breaks 'a.b'-  , GLP.OverloadedRecordUpdate -- Cannot handle symbol members starting-                               -- with a dot in a record well-  ]

@@ -18,6 +18,8 @@ import GHC.Hs import GHC.Types.SrcLoc import Generics.SYB hiding (GT, typeOf, typeRep)+import HIndent.Fixity+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.ModulePreprocessing.CommentRelocation import Language.Haskell.GhclibParserEx.Fixity import Type.Reflection@@ -26,26 +28,29 @@ -- -- Pretty-printing a module without calling this function for it before may -- raise an error or not print it correctly.-modifyASTForPrettyPrinting :: HsModule -> HsModule+modifyASTForPrettyPrinting :: HsModule' -> HsModule' modifyASTForPrettyPrinting m = relocateComments (beforeRelocation m) allComments   where     beforeRelocation =-      resetLGRHSEndPositionInModule .-      removeAllDocDs .-      closeEpAnnOfHsFunTy .-      closeEpAnnOfMatchMExt .-      closePlaceHolderEpAnns .-      closeEpAnnOfFunBindFunId .-      resetModuleNameColumn .-      replaceAllNotUsedAnns . removeComments . sortExprLStmt . fixFixities+      resetLGRHSEndPositionInModule+        . removeAllDocDs+        . closeEpAnnOfHsFunTy+        . closeEpAnnOfMatchMExt+        . closePlaceHolderEpAnns+        . closeEpAnnOfFunBindFunId+        . resetModuleNameColumn+        . replaceAllNotUsedAnns+        . removeComments+        . sortExprLStmt+        . fixFixities     allComments = listify (not . isEofComment . ac_tok . unLoc) m     isEofComment EpaEofComment = True     isEofComment _ = False  -- | This function modifies the given module AST to apply fixities of infix -- operators defined in the 'base' package.-fixFixities :: HsModule -> HsModule-fixFixities = applyFixities baseFixities+fixFixities :: HsModule' -> HsModule'+fixFixities = applyFixities fixities  -- | This function sets an 'LGRHS's end position to the end position of the -- last RHS in the 'grhssGRHSs'.@@ -54,7 +59,7 @@ -- locates comments in the wrong position in the process of comment -- relocation. This function prevents it by fixing the 'L?GRHS''s source -- span.-resetLGRHSEndPositionInModule :: HsModule -> HsModule+resetLGRHSEndPositionInModule :: HsModule' -> HsModule' resetLGRHSEndPositionInModule = everywhere (mkT resetLGRHSEndPosition)  -- | This function sorts lists of statements in order their positions.@@ -62,7 +67,7 @@ -- For example, the last element of 'HsDo' of 'HsExpr' is the element -- before a bar, and the elements are not sorted by their locations. This -- function fixes the orderings.-sortExprLStmt :: HsModule -> HsModule+sortExprLStmt :: HsModule' -> HsModule' sortExprLStmt m@HsModule {hsmodDecls = xs} = m {hsmodDecls = sorted}   where     sorted = everywhere (mkT sortByLoc) xs@@ -71,12 +76,12 @@  -- | This function removes all comments from the given module not to -- duplicate them on comment relocation.-removeComments :: HsModule -> HsModule+removeComments :: HsModule' -> HsModule' removeComments = everywhere (mkT $ const emptyComments)  -- | This function replaces all 'EpAnnNotUsed's in 'SrcSpanAnn''s with -- 'EpAnn's to make it possible to locate comments on them.-replaceAllNotUsedAnns :: HsModule -> HsModule+replaceAllNotUsedAnns :: HsModule' -> HsModule' replaceAllNotUsedAnns = everywhere app   where     app ::@@ -91,10 +96,12 @@               try ann = do                 HRefl <- eqTypeRep (typeOf ann) z                 pure sp {ann = EpAnn (spanAsAnchor $ locA sp) ann emptyComments}-          try emptyListItem <|> try emptyList <|> try emptyPragma <|>-            try emptyContext <|>-            try emptyNameAnn <|>-            try NoEpAnns+          try emptyListItem+            <|> try emptyList+            <|> try emptyPragma+            <|> try emptyContext+            <|> try emptyNameAnn+            <|> try NoEpAnns     app x = x     emptyListItem = AnnListItem []     emptyList = AnnList Nothing Nothing Nothing [] []@@ -106,7 +113,7 @@  -- | This function sets the start column of 'hsmodName' of the given -- 'HsModule' to 1 to correctly locate comments above the module name.-resetModuleNameColumn :: HsModule -> HsModule+resetModuleNameColumn :: HsModule' -> HsModule' resetModuleNameColumn m@HsModule {hsmodName = Just (L (SrcSpanAnn epa@EpAnn {..} sp) name)} =   m {hsmodName = Just (L (SrcSpanAnn newAnn sp) name)}   where@@ -124,7 +131,7 @@ -- The 'fun_id' contains the function's name. However, 'FunRhs' of 'Match' -- also contains the name, and we use the latter one. This function -- prevents comments from being located in 'fun_id'.-closeEpAnnOfFunBindFunId :: HsModule -> HsModule+closeEpAnnOfFunBindFunId :: HsModule' -> HsModule' closeEpAnnOfFunBindFunId = everywhere (mkT closeEpAnn)   where     closeEpAnn :: HsBind GhcPs -> HsBind GhcPs@@ -138,7 +145,7 @@ -- The field contains the annotation of the match LHS. However, the same -- information is also stored inside the 'Match'. This function removes the -- duplication not to locate comments on a wrong point.-closeEpAnnOfMatchMExt :: HsModule -> HsModule+closeEpAnnOfMatchMExt :: HsModule' -> HsModule' closeEpAnnOfMatchMExt = everywhere closeEpAnn   where     closeEpAnn ::@@ -156,7 +163,7 @@ -- -- 'HsFunTy' should not have any comments. Instead, its LHS and RHS should -- have them.-closeEpAnnOfHsFunTy :: HsModule -> HsModule+closeEpAnnOfHsFunTy :: HsModule' -> HsModule' closeEpAnnOfHsFunTy = everywhere (mkT closeEpAnn)   where     closeEpAnn :: HsType GhcPs -> HsType GhcPs@@ -166,7 +173,7 @@ -- | This function replaces all 'EpAnn's that contain placeholder anchors -- to locate comments correctly. A placeholder anchor is an anchor pointing -- on (-1, -1).-closePlaceHolderEpAnns :: HsModule -> HsModule+closePlaceHolderEpAnns :: HsModule' -> HsModule' closePlaceHolderEpAnns = everywhere closeEpAnn   where     closeEpAnn ::@@ -183,7 +190,7 @@ -- | This function removes all 'DocD's from the given module. They have -- haddocks, but the same information is stored in 'EpaCommentTok's. Thus, -- we need to remove the duplication.-removeAllDocDs :: HsModule -> HsModule+removeAllDocDs :: HsModule' -> HsModule' removeAllDocDs x@HsModule {hsmodDecls = decls} =   x {hsmodDecls = filter (not . isDocD . unLoc) decls}   where

@@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE GADTs, CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -44,13 +44,15 @@ import Data.Function import Data.List import GHC.Data.Bag-import GHC.Hs import GHC.Types.SrcLoc import Generics.SYB hiding (GT, typeOf, typeRep)+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Pretty.Pragma import HIndent.Pretty.SigBindFamily import Type.Reflection-+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+import Control.Monad+#endif -- | A wrapper type used in everywhereMEpAnnsBackwards' to collect all -- 'EpAnn's to apply a function with them in order their positions. data Wrapper =@@ -62,30 +64,49 @@  -- | This function collects all comments from the passed 'HsModule', and -- modifies all 'EpAnn's so that all 'EpAnn's have 'EpaCommentsBalanced's.-relocateComments :: HsModule -> [LEpaComment] -> HsModule+relocateComments :: HsModule' -> [LEpaComment] -> HsModule' relocateComments = evalState . relocate   where     relocate =-      relocatePragmas >=>-      relocateCommentsBeforePragmas >=>-      relocateCommentsInExportList >=>-      relocateCommentsBeforeTopLevelDecls >=>-      relocateCommentsSameLine >=>-      relocateCommentsTopLevelWhereClause >=>-      relocateCommentsAfter >=> assertAllCommentsAreConsumed+      relocatePragmas+        >=> relocateCommentsBeforePragmas+        >=> relocateCommentsInExportList+        >=> relocateCommentsInClass+        >=> relocateCommentsBeforeTopLevelDecls+        >=> relocateCommentsSameLine+        >=> relocateCommentsInDoExpr+        >=> relocateCommentsInCase+        >=> relocateCommentsTopLevelWhereClause+        >=> relocateCommentsAfter+        >=> assertAllCommentsAreConsumed     assertAllCommentsAreConsumed x = do       cs <- get       assert (null cs) (pure x)- -- | This function locates pragmas to the module's EPA.+#if MIN_VERSION_ghc_lib_parser(9,6,1)+relocatePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)+relocatePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = epa@EpAnn {}}} = do+  newAnn <- insertComments (isPragma . ac_tok . unLoc) insertPriorComments epa+  return m {hsmodExt = xmod {hsmodAnn = newAnn}}+#else relocatePragmas :: HsModule -> WithComments HsModule relocatePragmas m@HsModule {hsmodAnn = epa@EpAnn {}} = do   newAnn <- insertComments (isPragma . ac_tok . unLoc) insertPriorComments epa   return m {hsmodAnn = newAnn}+#endif relocatePragmas m = pure m- -- | This function locates comments that are located before pragmas to the -- module's EPA.+#if MIN_VERSION_ghc_lib_parser(9,6,1)+relocateCommentsBeforePragmas :: HsModule GhcPs -> WithComments (HsModule GhcPs)+relocateCommentsBeforePragmas m@HsModule {hsmodExt = xmod@XModulePs {hsmodAnn = ann}}+  | pragmaExists m = do+    newAnn <- insertCommentsByPos (< startPosOfPragmas) insertPriorComments ann+    pure m {hsmodExt = xmod {hsmodAnn = newAnn}}+  | otherwise = pure m+  where+    startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann+#else  relocateCommentsBeforePragmas :: HsModule -> WithComments HsModule relocateCommentsBeforePragmas m@HsModule {hsmodAnn = ann}   | pragmaExists m = do@@ -94,43 +115,135 @@   | otherwise = pure m   where     startPosOfPragmas = anchor $ getLoc $ head $ priorComments $ comments ann-+#endif -- | This function locates comments that are located before each element of -- an export list.-relocateCommentsInExportList :: HsModule -> WithComments HsModule-relocateCommentsInExportList m@HsModule {hsmodExports = Just (L listSp@SrcSpanAnn {ann = EpAnn {entry = listAnn}} xs)} = do-  newExports <- mapM insertCommentsBeforeElement xs-  pure m {hsmodExports = Just (L listSp newExports)}+relocateCommentsInExportList :: HsModule' -> WithComments HsModule'+relocateCommentsInExportList =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond   where-    insertCommentsBeforeElement (L sp@SrcSpanAnn {ann = entryAnn@EpAnn {}} x) = do-      newEpa <--        insertCommentsByPos-          (isBefore $ anchor $ entry entryAnn)-          insertPriorComments-          entryAnn-      pure $ L sp {ann = newEpa} x-    insertCommentsBeforeElement x = pure x-    isBefore anc comAnc =-      srcSpanStartLine comAnc < srcSpanStartLine anc &&-      realSrcSpanStart (anchor listAnn) < realSrcSpanStart comAnc-relocateCommentsInExportList x = pure x+    elemGetter :: HsModule' -> [LIE GhcPs]+    elemGetter HsModule {hsmodExports = Just (L _ xs)} = xs+    elemGetter _ = []+    elemSetter xs HsModule {hsmodExports = Just (L sp _), ..} =+      HsModule {hsmodExports = Just (L sp xs), ..}+    elemSetter _ x = x+    annGetter (L SrcSpanAnn {..} _) = ann+    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x+    cond HsModule {hsmodExports = Just (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = listAnc}}} _)} (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnc}}} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnc+        && realSrcSpanStart listAnc < realSrcSpanStart comAnc+    cond _ _ _ = False +-- | Locates comments before each case branch.+relocateCommentsInCase :: HsModule' -> WithComments HsModule'+relocateCommentsInCase =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]+    elemGetter (L _ (HsCase _ _ (MG {mg_alts = L _ xs}))) = xs+    elemGetter _ = []+    elemSetter xs (L sp (HsCase ext expr (MG {mg_alts = L sp' _, ..}))) =+      L sp (HsCase ext expr (MG {mg_alts = L sp' xs, ..}))+    elemSetter _ x = x+    annGetter (L SrcSpanAnn {..} _) = ann+    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x+    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = caseAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = branchAnchor}}} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine branchAnchor+        && realSrcSpanStart caseAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | Locates comments before each class element.+relocateCommentsInClass :: HsModule' -> WithComments HsModule'+relocateCommentsInClass =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsDecl GhcPs -> [LSigBindFamily]+    elemGetter (L _ (TyClD _ ClassDecl {..})) =+      mkSortedLSigBindFamilyList+        tcdSigs+        (bagToList tcdMeths)+        tcdATs+        tcdATDefs+        []+    elemGetter _ = []+    elemSetter xs (L sp (TyClD ext ClassDecl {..})) = L sp (TyClD ext newDecl)+      where+        newDecl =+          ClassDecl+            { tcdSigs = sigs+            , tcdMeths = listToBag binds+            , tcdATs = typeFamilies+            , tcdATDefs = tyFamInsts+            , ..+            }+        (sigs, binds, typeFamilies, tyFamInsts, _) =+          destructLSigBindFamilyList xs+    elemSetter _ x = x+    annGetter (L SrcSpanAnn {..} _) = ann+    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x+    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = classAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnchor}}} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor+        && realSrcSpanStart classAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False++-- | Locates comments before each statement in a do expression.+relocateCommentsInDoExpr :: HsModule' -> WithComments HsModule'+relocateCommentsInDoExpr =+  relocateCommentsBeforeEachElement+    elemGetter+    elemSetter+    annGetter+    annSetter+    cond+  where+    elemGetter :: LHsExpr GhcPs -> [ExprLStmt GhcPs]+    elemGetter (L _ (HsDo _ DoExpr {} (L _ xs))) = xs+    elemGetter (L _ (HsDo _ MDoExpr {} (L _ xs))) = xs+    elemGetter _ = []+    elemSetter xs (L sp (HsDo ext flavor@DoExpr {} (L sp' _))) =+      L sp (HsDo ext flavor (L sp' xs))+    elemSetter xs (L sp (HsDo ext flavor@MDoExpr {} (L sp' _))) =+      L sp (HsDo ext flavor (L sp' xs))+    elemSetter _ x = x+    annGetter (L SrcSpanAnn {..} _) = ann+    annSetter newAnn (L SrcSpanAnn {..} x) = L SrcSpanAnn {ann = newAnn, ..} x+    cond (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = doAnchor}}} _) (L SrcSpanAnn {ann = EpAnn {entry = Anchor {anchor = elemAnchor}}} _) comAnc =+      srcSpanStartLine comAnc < srcSpanStartLine elemAnchor+        && realSrcSpanStart doAnchor < realSrcSpanStart comAnc+    cond _ _ _ = False+ -- | This function locates comments located before top-level declarations.-relocateCommentsBeforeTopLevelDecls :: HsModule -> WithComments HsModule+relocateCommentsBeforeTopLevelDecls :: HsModule' -> WithComments HsModule' relocateCommentsBeforeTopLevelDecls = everywhereM (applyM f)   where     f epa@EpAnn {..} =       insertCommentsByPos (isBefore $ anchor entry) insertPriorComments epa     f EpAnnNotUsed = pure EpAnnNotUsed     isBefore anc comAnc =-      srcSpanStartCol anc == 1 &&-      srcSpanStartCol comAnc == 1 &&-      srcSpanStartLine comAnc < srcSpanStartLine anc+      srcSpanStartCol anc == 1+        && srcSpanStartCol comAnc == 1+        && srcSpanStartLine comAnc < srcSpanStartLine anc  -- | This function scans the given AST from bottom to top and locates -- comments that are on the same line as the node.  Comments are stored in -- the 'followingComments' of 'EpaCommentsBalanced'.-relocateCommentsSameLine :: HsModule -> WithComments HsModule+relocateCommentsSameLine :: HsModule' -> WithComments HsModule' relocateCommentsSameLine = everywhereMEpAnnsBackwards f   where     f epa@EpAnn {..} =@@ -140,12 +253,12 @@         epa     f EpAnnNotUsed = pure EpAnnNotUsed     isOnSameLine anc comAnc =-      srcSpanStartLine comAnc == srcSpanStartLine anc &&-      srcSpanStartLine comAnc == srcSpanEndLine anc+      srcSpanStartLine comAnc == srcSpanStartLine anc+        && srcSpanStartLine comAnc == srcSpanEndLine anc  -- | This function locates comments above the top-level declarations in -- a 'where' clause in the topmost declaration.-relocateCommentsTopLevelWhereClause :: HsModule -> WithComments HsModule+relocateCommentsTopLevelWhereClause :: HsModule' -> WithComments HsModule' relocateCommentsTopLevelWhereClause m@HsModule {..} = do   hsmodDecls' <- mapM relocateCommentsDeclWhereClause hsmodDecls   pure m {hsmodDecls = hsmodDecls'}@@ -177,21 +290,21 @@       pure $ L (SrcSpanAnn epa' sp) x     addCommentsBeforeEpAnn x = pure x     partitionAboveNotAbove cs sp =-      fst $-      foldr'-        (\c@(L l _) ((ls, rs), lastSpan) ->-           if anchor l `isAbove` anchor lastSpan-             then ((ls, c : rs), l)-             else ((c : ls, rs), lastSpan))-        (([], []), sp)-        cs+      fst+        $ foldr'+            (\c@(L l _) ((ls, rs), lastSpan) ->+               if anchor l `isAbove` anchor lastSpan+                 then ((ls, c : rs), l)+                 else ((c : ls, rs), lastSpan))+            (([], []), sp)+            cs     isAbove comAnc anc =-      srcSpanStartCol comAnc == srcSpanStartCol anc &&-      srcSpanEndLine comAnc + 1 == srcSpanStartLine anc+      srcSpanStartCol comAnc == srcSpanStartCol anc+        && srcSpanEndLine comAnc + 1 == srcSpanStartLine anc  -- | This function scans the given AST from bottom to top and locates -- comments in the comment pool after each node on it.-relocateCommentsAfter :: HsModule -> WithComments HsModule+relocateCommentsAfter :: HsModule' -> WithComments HsModule' relocateCommentsAfter = everywhereMEpAnnsBackwards f   where     f epa@EpAnn {..} =@@ -199,6 +312,31 @@     f EpAnnNotUsed = pure EpAnnNotUsed     isAfter anc comAnc = srcSpanEndLine anc <= srcSpanStartLine comAnc +-- | Locates comments before each element in a parent.+relocateCommentsBeforeEachElement ::+     forall a b c. Typeable a+  => (a -> [b]) -- ^ Element getter+  -> ([b] -> a -> a) -- ^ Element setter+  -> (b -> EpAnn c) -- ^ Annotation getter+  -> (EpAnn c -> b -> b) -- ^ Annotation setter+  -> (a -> b -> RealSrcSpan -> Bool) -- ^ The function to decide whether to locate comments+  -> HsModule'+  -> WithComments HsModule'+relocateCommentsBeforeEachElement elemGetter elemSetter annGetter annSetter cond =+  everywhereM (mkM f)+  where+    f :: a -> WithComments a+    f x = do+      newElems <- mapM insertCommentsBeforeElement (elemGetter x)+      pure $ elemSetter newElems x+      where+        insertCommentsBeforeElement element+          | elemAnn@EpAnn {} <- annGetter element = do+            newEpa <-+              insertCommentsByPos (cond x element) insertPriorComments elemAnn+            pure $ annSetter newEpa element+          | otherwise = pure element+ -- | This function applies the given function to all 'EpAnn's. applyM ::      forall a. Typeable a@@ -270,9 +408,9 @@   -> a   -> WithComments a everywhereMEpAnnsInOrder cmp f hm =-  collectEpAnnsInOrderEverywhereMTraverses >>=-  applyFunctionInOrderEpAnnEndPositions >>=-  putModifiedEpAnnsToModule+  collectEpAnnsInOrderEverywhereMTraverses+    >>= applyFunctionInOrderEpAnnEndPositions+    >>= putModifiedEpAnnsToModule   where     collectEpAnnsInOrderEverywhereMTraverses       -- This function uses 'everywhereM' to collect 'EpAnn's because they

@@ -10,12 +10,12 @@ import qualified GHC.Data.EnumSet as ES import GHC.Data.FastString import GHC.Data.StringBuffer-import GHC.Hs import qualified GHC.LanguageExtensions as GLP import qualified GHC.Parser as GLP import GHC.Parser.Lexer hiding (buffer) import GHC.Stack import GHC.Types.SrcLoc+import HIndent.GhcLibParserWrapper.GHC.Hs #if MIN_VERSION_ghc_lib_parser(9,4,1) import GHC.Utils.Error import GHC.Utils.Outputable hiding ((<>), empty, text)@@ -23,7 +23,7 @@ -- | This function parses the given Haskell source code with the given file -- path (if any) and parse options. parseModule ::-     Maybe FilePath -> [GLP.Extension] -> String -> ParseResult HsModule+     Maybe FilePath -> [GLP.Extension] -> String -> ParseResult HsModule' parseModule filepath exts src =   case unP GLP.parseModule initState of     POk s m -> POk s $ unLoc m

@@ -37,10 +37,10 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc-import GHC.Unit import GHC.Unit.Module.Warnings import HIndent.Applicative import HIndent.Config+import HIndent.Fixity import HIndent.Pretty.Combinators import HIndent.Pretty.Import import HIndent.Pretty.NodeComments@@ -48,7 +48,15 @@ import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types import HIndent.Printer+import Language.Haskell.GhclibParserEx.GHC.Hs.Expr import Text.Show.Unicode+#if MIN_VERSION_ghc_lib_parser(9,6,1)+import qualified Data.Foldable as NonEmpty+import GHC.Core.DataCon+#endif+#if !MIN_VERSION_ghc_lib_parser(9,6,1)+import GHC.Unit+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) import GHC.Types.PkgQual #endif@@ -84,8 +92,10 @@   col <- gets psColumn   if col == 0     then indentedWithFixedLevel-           (fromIntegral $ srcSpanStartCol $ anchor $ getLoc c) $-         spaced $ fmap pretty $ c : cs+           (fromIntegral $ srcSpanStartCol $ anchor $ getLoc c)+           $ spaced+           $ fmap pretty+           $ c : cs     else spacePrefixed $ fmap pretty $ c : cs   eolCommentsArePrinted printCommentOnSameLine _ = return ()@@ -112,11 +122,68 @@       Pretty a   where   pretty' :: a -> Printer ()- -- Do nothing if there are no pragmas, module headers, imports, or -- declarations. Otherwise, extra blank lines will be inserted if only -- comments are present in the source code. See -- https://github.com/mihaimaruseac/hindent/issues/586#issuecomment-1374992624.+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (HsModule GhcPs) where+  pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []}+    | not (pragmaExists m) = pure ()+  pretty' m = blanklined printers >> newline+    where+      printers = snd <$> filter fst pairs+      pairs =+        [ (pragmaExists m, prettyPragmas m)+        , (moduleDeclExists m, prettyModuleDecl m)+        , (importsExist m, prettyImports)+        , (declsExist m, prettyDecls)+        ]+      prettyModuleDecl HsModule {hsmodName = Nothing} =+        error "The module declaration does not exist."+      prettyModuleDecl HsModule { hsmodName = Just name+                                , hsmodExports = Nothing+                                , hsmodExt = XModulePs {..}+                                } = do+        pretty $ fmap ModuleNameWithPrefix name+        whenJust hsmodDeprecMessage $ \x -> do+          space+          pretty $ fmap ModuleDeprecatedPragma x+        string " where"+      prettyModuleDecl HsModule { hsmodName = Just name+                                , hsmodExports = Just exports+                                , hsmodExt = XModulePs {..}+                                } = do+        pretty $ fmap ModuleNameWithPrefix name+        whenJust hsmodDeprecMessage $ \x -> do+          space+          pretty $ fmap ModuleDeprecatedPragma x+        newline+        indentedBlock $ do+          printCommentsAnd exports (vTuple . fmap pretty)+          string " where"+      moduleDeclExists HsModule {hsmodName = Nothing} = False+      moduleDeclExists _ = True+      prettyDecls =+        mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp)+          $ addDeclSeparator+          $ hsmodDecls m+      addDeclSeparator [] = []+      addDeclSeparator [x] = [(x, Nothing)]+      addDeclSeparator (x:xs) =+        (x, Just $ declSeparator $ unLoc x) : addDeclSeparator xs+      declSeparator (SigD _ TypeSig {}) = newline+      declSeparator (SigD _ InlineSig {}) = newline+      declSeparator (SigD _ PatSynSig {}) = newline+      declSeparator _ = blankline+      declsExist = not . null . hsmodDecls+      prettyImports = importDecls >>= blanklined . fmap outputImportGroup+      outputImportGroup = lined . fmap pretty+      importDecls =+        gets (configSortImports . psConfig) >>= \case+          True -> pure $ extractImportsSorted m+          False -> pure $ extractImports m+#else instance Pretty HsModule where   pretty' m@HsModule {hsmodName = Nothing, hsmodImports = [], hsmodDecls = []}     | not (pragmaExists m) = pure ()@@ -155,8 +222,9 @@       moduleDeclExists HsModule {hsmodName = Nothing} = False       moduleDeclExists _ = True       prettyDecls =-        mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp) $-        addDeclSeparator $ hsmodDecls m+        mapM_ (\(x, sp) -> pretty x >> fromMaybe (return ()) sp)+          $ addDeclSeparator+          $ hsmodDecls m       addDeclSeparator [] = []       addDeclSeparator [x] = [(x, Nothing)]       addDeclSeparator (x:xs) =@@ -172,7 +240,7 @@         gets (configSortImports . psConfig) >>= \case           True -> pure $ extractImportsSorted m           False -> pure $ extractImports m-+#endif instance (CommentExtraction l, Pretty e) => Pretty (GenLocated l e) where   pretty' (L _ e) = pretty e @@ -213,7 +281,7 @@   where     hor = string " = " >> pretty tcdRhs     ver = newline >> indentedBlock (string "= " |=> pretty tcdRhs)-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9,6,1) prettyTyClDecl DataDecl {..} = do   printDataNewtype |=> do     whenJust (dd_ctxt tcdDataDefn) $ \x -> do@@ -225,6 +293,21 @@   pretty tcdDataDefn   where     printDataNewtype =+      case dd_cons tcdDataDefn of+        DataTypeCons {} -> string "data "+        NewTypeCon {} -> string "newtype "+#elif MIN_VERSION_ghc_lib_parser(9,4,1)+prettyTyClDecl DataDecl {..} = do+  printDataNewtype |=> do+    whenJust (dd_ctxt tcdDataDefn) $ \x -> do+      pretty $ Context x+      string " =>"+      newline+    pretty tcdLName+  spacePrefixed $ pretty <$> hsq_explicit tcdTyVars+  pretty tcdDataDefn+  where+    printDataNewtype =       case dd_ND tcdDataDefn of         DataType -> string "data "         NewType -> string "newtype "@@ -271,12 +354,13 @@         printNameAndTypeVariables       unless (null tcdFDs) $ do         newline-        indentedBlock $-          string "| " |=>-          vCommaSep-            (flip fmap tcdFDs $ \x@(L _ FunDep {}) ->-               printCommentsAnd x $ \(FunDep _ from to) ->-                 spaced $ fmap pretty from ++ [string "->"] ++ fmap pretty to)+        indentedBlock+          $ string "| "+              |=> vCommaSep+                    (flip fmap tcdFDs $ \x@(L _ FunDep {}) ->+                       printCommentsAnd x $ \(FunDep _ from to) ->+                         spaced+                           $ fmap pretty from ++ [string "->"] ++ fmap pretty to)       unless (null sigsMethodsFamilies) $ do         newline         indentedBlock $ string "where"@@ -287,8 +371,8 @@         Infix ->           case hsq_explicit tcdTyVars of             (l:r:xs) -> do-              parens $-                spaced [pretty l, pretty $ fmap InfixOp tcdLName, pretty r]+              parens+                $ spaced [pretty l, pretty $ fmap InfixOp tcdLName, pretty r]               spacePrefixed $ fmap pretty xs             _ -> error "Not enough parameters are given."     sigsMethodsFamilies =@@ -310,7 +394,7 @@ prettyHsBind AbsBinds {} = notGeneratedByParser #endif prettyHsBind (PatSynBind _ x) = pretty x-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (Sig GhcPs) where   pretty' (TypeSig _ funName params) = do     printFunName@@ -324,9 +408,10 @@         if headLen < indentSpaces           then space           else newline-        indentedBlock $-          indentedWithSpace 3 $-          pretty $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params+        indentedBlock+          $ indentedWithSpace 3+          $ pretty+          $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params       printFunName = pretty $ head funName   pretty' (PatSynSig _ names sig) =     spaced@@ -346,9 +431,74 @@       hor = space >> printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)       ver = do         newline-        indentedBlock $-          indentedWithSpace 3 $-          printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)+        indentedBlock+          $ indentedWithSpace 3+          $ printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)+  pretty' (FixSig _ x) = pretty x+  pretty' (InlineSig _ name detail) =+    spaced [string "{-#", pretty detail, pretty name, string "#-}"]+  pretty' (SpecSig _ name sig _) =+    spaced+      [ string "{-# SPECIALISE"+      , pretty name+      , string "::"+      , pretty $ head sig+      , string "#-}"+      ]+  pretty' (SpecInstSig _ sig) =+    spaced [string "{-# SPECIALISE instance", pretty sig, string "#-}"]+  pretty' (MinimalSig _ xs) =+    string "{-# MINIMAL " |=> do+      pretty xs+      string " #-}"+  pretty' (SCCFunSig _ name _) =+    spaced [string "{-# SCC", pretty name, string "#-}"]+  pretty' (CompleteMatchSig _ names _) =+    spaced+      [ string "{-# COMPLETE"+      , printCommentsAnd names (hCommaSep . fmap pretty)+      , string "#-}"+      ]+#else+instance Pretty (Sig GhcPs) where+  pretty' (TypeSig _ funName params) = do+    printFunName+    string " ::"+    horizontal <-|> vertical+    where+      horizontal = space >> pretty (hswc_body params)+      vertical = do+        headLen <- printerLength printFunName+        indentSpaces <- getIndentSpaces+        if headLen < indentSpaces+          then space+          else newline+        indentedBlock+          $ indentedWithSpace 3+          $ pretty+          $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params+      printFunName = pretty $ head funName+  pretty' (PatSynSig _ names sig) =+    spaced+      [string "pattern", hCommaSep $ fmap pretty names, string "::", pretty sig]+  pretty' (ClassOpSig _ True funNames params) =+    spaced+      [ string "default"+      , hCommaSep $ fmap pretty funNames+      , string "::"+      , printCommentsAnd params pretty+      ]+  pretty' (ClassOpSig _ False funNames params) = do+    hCommaSep $ fmap pretty funNames+    string " ::"+    hor <-|> ver+    where+      hor = space >> printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)+      ver = do+        newline+        indentedBlock+          $ indentedWithSpace 3+          $ printCommentsAnd params (pretty . HsSigTypeInsideDeclSig)   pretty' IdSig {} = notGeneratedByParser   pretty' (FixSig _ x) = pretty x   pretty' (InlineSig _ name detail) =@@ -375,7 +525,7 @@       , printCommentsAnd names (hCommaSep . fmap pretty)       , string "#-}"       ]-+#endif instance Pretty DeclSig where   pretty' (DeclSig (TypeSig _ funName params)) = do     printFunName@@ -392,12 +542,13 @@           then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)           else do             newline-            indentedBlock $-              indentedWithSpace 3 $-              pretty $ HsSigTypeInsideDeclSig <$> hswc_body params+            indentedBlock+              $ indentedWithSpace 3+              $ pretty+              $ HsSigTypeInsideDeclSig <$> hswc_body params       printFunName = hCommaSep $ fmap pretty funName   pretty' (DeclSig x) = pretty x-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (HsDataDefn GhcPs) where   pretty' HsDataDefn {..} =     if isGADT@@ -406,6 +557,46 @@           string " :: "           pretty x         string " where"+        indentedBlock $ newlinePrefixed $ fmap pretty cons+      else do+        case cons of+          [] -> indentedBlock derivingsAfterNewline+          [x@(L _ ConDeclH98 {con_args = RecCon {}})] -> do+            string " = "+            pretty x+            unless (null dd_derivs) $ space |=> printDerivings+          [x] -> do+            string " ="+            newline+            indentedBlock $ do+              pretty x+              derivingsAfterNewline+          _ ->+            indentedBlock $ do+              newline+              string "= " |=> vBarSep (fmap pretty cons)+              derivingsAfterNewline+    where+      cons =+        case dd_cons of+          NewTypeCon x -> [x]+          DataTypeCons _ xs -> xs+      isGADT =+        case dd_cons of+          (DataTypeCons _ (L _ ConDeclGADT {}:_)) -> True+          _ -> False+      derivingsAfterNewline =+        unless (null dd_derivs) $ newline >> printDerivings+      printDerivings = lined $ fmap pretty dd_derivs+#else+instance Pretty (HsDataDefn GhcPs) where+  pretty' HsDataDefn {..} =+    if isGADT+      then do+        whenJust dd_kindSig $ \x -> do+          string " :: "+          pretty x+        string " where"         indentedBlock $ newlinePrefixed $ fmap pretty dd_cons       else do         case dd_cons of@@ -433,15 +624,15 @@       derivingsAfterNewline =         unless (null dd_derivs) $ newline >> printDerivings       printDerivings = lined $ fmap pretty dd_derivs-+#endif instance Pretty (ClsInstDecl GhcPs) where   pretty' ClsInstDecl {..} = do     string "instance " |=> do       whenJust cid_overlap_mode $ \x -> do         pretty x         space-      pretty (fmap HsSigTypeInsideInstDecl cid_poly_ty) |=>-        unless (null sigsAndMethods) (string " where")+      pretty (fmap HsSigTypeInsideInstDecl cid_poly_ty)+        |=> unless (null sigsAndMethods) (string " where")     unless (null sigsAndMethods) $ do       newline       indentedBlock $ lined $ fmap pretty sigsAndMethods@@ -466,7 +657,11 @@ prettyHsExpr :: HsExpr GhcPs -> Printer () prettyHsExpr (HsVar _ bind) = pretty $ fmap PrefixOp bind prettyHsExpr (HsUnboundVar _ x) = pretty x+#if MIN_VERSION_ghc_lib_parser(9,6,1)+prettyHsExpr (HsOverLabel _ _ l) = string "#" >> string (unpackFS l)+#else prettyHsExpr (HsOverLabel _ l) = string "#" >> string (unpackFS l)+#endif prettyHsExpr (HsIPVar _ var) = string "?" >> pretty var prettyHsExpr (HsOverLit _ x) = pretty x prettyHsExpr (HsLit _ l) = pretty l@@ -490,10 +685,11 @@       pretty f       col' <- gets psColumn       let diff =-            col' - col --            if col == 0-              then spaces-              else 0+            col'+              - col+              - if col == 0+                  then spaces+                  else 0       if diff + 1 <= spaces         then space         else newline@@ -507,10 +703,17 @@     insertComments cs (L s@SrcSpanAnn {ann = e@EpAnn {comments = cs'}} r') =       L (s {ann = e {comments = cs <> cs'}}) r'     insertComments _ x = x+#if MIN_VERSION_ghc_lib_parser(9,6,1)+prettyHsExpr (HsAppType _ l _ r) = do+  pretty l+  string " @"+  pretty r+#else prettyHsExpr (HsAppType _ l r) = do   pretty l   string " @"   pretty r+#endif prettyHsExpr (OpApp _ l o r) = pretty (InfixApp l o r False) prettyHsExpr (NegApp _ x _) = string "-" >> pretty x #if MIN_VERSION_ghc_lib_parser(9,4,1)@@ -524,9 +727,9 @@   where     horizontal = hTuple $ fmap pretty full     vertical =-      parens $-      prefixedLined "," $-      fmap (\e -> unless (isMissing e) (space |=> pretty e)) full+      parens+        $ prefixedLined ","+        $ fmap (\e -> unless (isMissing e) (space |=> pretty e)) full     isMissing Missing {} = True     isMissing _ = False prettyHsExpr (ExplicitSum _ position numElem expr) = do@@ -553,17 +756,18 @@     branch :: String -> LHsExpr GhcPs -> Printer ()     branch str e =       case e of-        (L _ (HsDo _ DoExpr {} xs)) -> doStmt "do" xs-        (L _ (HsDo _ MDoExpr {} xs)) -> doStmt "mdo" xs+        (L _ (HsDo _ (DoExpr m) xs)) -> doStmt (QualifiedDo m Do) xs+        (L _ (HsDo _ (MDoExpr m) xs)) -> doStmt (QualifiedDo m Mdo) xs         _ -> string str |=> pretty e       where-        doStmt pref stmts = do-          string $ str ++ pref+        doStmt qDo stmts = do+          string str+          pretty qDo           newline           indentedBlock $ printCommentsAnd stmts (lined . fmap pretty) prettyHsExpr (HsMultiIf _ guards) =-  string "if " |=>-  lined (fmap (pretty . fmap (GRHSExpr GRHSExprMultiWayIf)) guards)+  string "if "+    |=> lined (fmap (pretty . fmap (GRHSExpr GRHSExprMultiWayIf)) guards) #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyHsExpr (HsLet _ _ binds _ exprs) = pretty $ LetIn binds exprs #else@@ -578,8 +782,10 @@   error "Not enough arguments are passed to pretty-print a list comprehension." prettyHsExpr (HsDo _ MonadComp {} (L l (lhs:rhs))) =   pretty $ L l $ ListComprehension lhs rhs-prettyHsExpr (HsDo _ DoExpr {} (L l xs)) = pretty $ L l $ DoExpression xs Do-prettyHsExpr (HsDo _ MDoExpr {} (L l xs)) = pretty $ L l $ DoExpression xs Mdo+prettyHsExpr (HsDo _ (DoExpr m) (L l xs)) =+  pretty $ L l $ DoExpression xs (QualifiedDo m Do)+prettyHsExpr (HsDo _ (MDoExpr m) (L l xs)) =+  pretty $ L l $ DoExpression xs (QualifiedDo m Mdo) prettyHsExpr (HsDo _ GhciStmtCtxt {} _) = error "We're not using GHCi, are we?" prettyHsExpr (ExplicitList _ xs) = horizontal <-|> vertical   where@@ -598,9 +804,9 @@     ver = do       pretty name       newline-      indentedBlock $-        either printHorFields printHorFields fields <-|>-        either printVerFields printVerFields fields+      indentedBlock+        $ either printHorFields printHorFields fields+            <-|> either printVerFields printVerFields fields     printHorFields ::          (Pretty a, Pretty b, CommentExtraction l)       => [GenLocated l (HsFieldBind a b)]@@ -628,9 +834,9 @@     ver = do       pretty name       newline-      indentedBlock $-        either printHorFields printHorFields fields <-|>-        either printVerFields printVerFields fields+      indentedBlock+        $ either printHorFields printHorFields fields+            <-|> either printVerFields printVerFields fields     printHorFields ::          (Pretty a, Pretty b, CommentExtraction l)       => [GenLocated l (HsRecField' a b)]@@ -657,21 +863,24 @@   dot   pretty f prettyHsExpr HsProjection {..} =-  parens $-  forM_ proj_flds $ \x -> do-    string "."-    pretty x+  parens+    $ forM_ proj_flds+    $ \x -> do+        string "."+        pretty x prettyHsExpr (ExprWithTySig _ e sig) = do   pretty e   string " :: "   pretty $ hswc_body sig prettyHsExpr (ArithSeq _ _ x) = pretty x+#if !MIN_VERSION_ghc_lib_parser(9,6,1) prettyHsExpr (HsSpliceE _ x) = pretty x+#endif prettyHsExpr (HsProc _ pat x@(L _ (HsCmdTop _ (L _ (HsCmdDo _ xs))))) = do   spaced [string "proc", pretty pat, string "-> do"]   newline-  indentedBlock $-    printCommentsAnd x (const (printCommentsAnd xs (lined . fmap pretty)))+  indentedBlock+    $ printCommentsAnd x (const (printCommentsAnd xs (lined . fmap pretty))) prettyHsExpr (HsProc _ pat body) = hor <-|> ver   where     hor = spaced [string "proc", pretty pat, string "->", pretty body]@@ -698,6 +907,10 @@ prettyHsExpr HsRnBracketOut {} = notGeneratedByParser prettyHsExpr HsTcBracketOut {} = notGeneratedByParser #endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+prettyHsExpr (HsTypedSplice _ x) = string "$$" >> pretty x+prettyHsExpr (HsUntypedSplice _ x) = pretty x+#endif instance Pretty LambdaCase where   pretty' (LambdaCase matches caseOrCases) = do     case caseOrCases of@@ -728,10 +941,12 @@                   ver = do                     newline                     pretty $ VerticalContext hst_ctxt-               in do hor <-|> ver-                     newline-                     prefixed "=> " $-                       prefixedLined "-> " $ pretty <$> flatten hst_body+               in do+                    hor <-|> ver+                    newline+                    prefixed "=> "+                      $ prefixedLined "-> "+                      $ pretty <$> flatten hst_body           _ ->             let hor = space >> pretty (fmap HsTypeInsideDeclSig sig_body)                 ver =@@ -750,8 +965,8 @@         dot         printCommentsAnd sig_body $ \case           HsQualTy {..} -> do-            (space >> pretty (HorizontalContext hst_ctxt)) <-|>-              (newline >> pretty (VerticalContext hst_ctxt))+            (space >> pretty (HorizontalContext hst_ctxt))+              <-|> (newline >> pretty (VerticalContext hst_ctxt))             newline             prefixed "=> " $ pretty hst_body           x -> pretty $ HsTypeInsideDeclSig x@@ -770,7 +985,52 @@   pretty' = prettyConDecl  prettyConDecl :: ConDecl GhcPs -> Printer ()+#if MIN_VERSION_ghc_lib_parser(9,6,1) prettyConDecl ConDeclGADT {..} = do+  hCommaSep $ fmap pretty $ NonEmpty.toList con_names+  hor <-|> ver+  where+    hor = string " :: " |=> body+    ver = do+      newline+      indentedBlock (string ":: " |=> body)+    body =+      case (forallNeeded, con_mb_cxt) of+        (True, Just ctx) -> withForallCtx ctx+        (True, Nothing) -> withForallOnly+        (False, Just ctx) -> withCtxOnly ctx+        (False, Nothing) -> noForallCtx+    withForallOnly = do+      pretty con_bndrs+      (space >> horArgs) <-|> (newline >> verArgs)+    noForallCtx = horArgs <-|> verArgs+    withForallCtx ctx = do+      pretty con_bndrs+      (space >> pretty (Context ctx)) <-|> (newline >> pretty (Context ctx))+      newline+      prefixed "=> " verArgs+    withCtxOnly ctx =+      (pretty (Context ctx) >> string " => " >> horArgs)+        <-|> (pretty (Context ctx) >> prefixed "=> " verArgs)+    horArgs =+      case con_g_args of+        PrefixConGADT xs ->+          inter (string " -> ")+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+        RecConGADT xs _ -> inter (string " -> ") [recArg xs, pretty con_res_ty]+    verArgs =+      case con_g_args of+        PrefixConGADT xs ->+          prefixedLined "-> "+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+        RecConGADT xs _ -> prefixedLined "-> " [recArg xs, pretty con_res_ty]+    recArg xs = printCommentsAnd xs $ \xs' -> vFields' $ fmap pretty xs'+    forallNeeded =+      case unLoc con_bndrs of+        HsOuterImplicit {} -> False+        HsOuterExplicit {} -> True+#else+prettyConDecl ConDeclGADT {..} = do   hCommaSep $ fmap pretty con_names   hor <-|> ver   where@@ -796,46 +1056,46 @@       prefixed "=> " verArgs          withCtxOnly ctx =-      (pretty (Context ctx) >> string " => " >> horArgs) <-|>-      (pretty (Context ctx) >> prefixed "=> " verArgs)+      (pretty (Context ctx) >> string " => " >> horArgs)+        <-|> (pretty (Context ctx) >> prefixed "=> " verArgs)          horArgs =       case con_g_args of         PrefixConGADT xs ->-          inter (string " -> ") $-          fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+          inter (string " -> ")+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]         RecConGADT xs _ -> inter (string " -> ") [recArg xs, pretty con_res_ty]          verArgs =       case con_g_args of         PrefixConGADT xs ->-          prefixedLined "-> " $-          fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+          prefixedLined "-> "+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]         RecConGADT xs _ -> prefixedLined "-> " [recArg xs, pretty con_res_ty] #else     withForallCtx _ = do       pretty con_bndrs-      (space >> pretty (Context con_mb_cxt)) <-|>-        (newline >> pretty (Context con_mb_cxt))+      (space >> pretty (Context con_mb_cxt))+        <-|> (newline >> pretty (Context con_mb_cxt))       newline       prefixed "=> " verArgs          withCtxOnly _ =-      (pretty (Context con_mb_cxt) >> string " => " >> horArgs) <-|>-      (pretty (Context con_mb_cxt) >> prefixed "=> " verArgs)+      (pretty (Context con_mb_cxt) >> string " => " >> horArgs)+        <-|> (pretty (Context con_mb_cxt) >> prefixed "=> " verArgs)          horArgs =       case con_g_args of         PrefixConGADT xs ->-          inter (string " -> ") $-          fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+          inter (string " -> ")+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]         RecConGADT xs -> inter (string " -> ") [recArg xs, pretty con_res_ty]          verArgs =       case con_g_args of         PrefixConGADT xs ->-          prefixedLined "-> " $-          fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]+          prefixedLined "-> "+            $ fmap (\(HsScaled _ x) -> pretty x) xs ++ [pretty con_res_ty]         RecConGADT xs -> prefixedLined "-> " [recArg xs, pretty con_res_ty] #endif     recArg xs = printCommentsAnd xs $ \xs' -> vFields' $ fmap pretty xs'@@ -844,28 +1104,33 @@       case unLoc con_bndrs of         HsOuterImplicit {} -> False         HsOuterExplicit {} -> True+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyConDecl ConDeclH98 {con_forall = True, ..} =-  (do string "forall "-      spaced $ fmap pretty con_ex_tvs-      string ". ") |=>-  (do whenJust con_mb_cxt $ \c -> do-        pretty $ Context c-        string " =>"-        newline-      pretty con_name-      pretty con_args)+  (do+     string "forall "+     spaced $ fmap pretty con_ex_tvs+     string ". ")+    |=> (do+           whenJust con_mb_cxt $ \c -> do+             pretty $ Context c+             string " =>"+             newline+           pretty con_name+           pretty con_args) #else prettyConDecl ConDeclH98 {con_forall = True, ..} =-  (do string "forall "-      spaced $ fmap pretty con_ex_tvs-      string ". ") |=>-  (do whenJust con_mb_cxt $ \_ -> do-        pretty $ Context con_mb_cxt-        string " =>"-        newline-      pretty con_name-      pretty con_args)+  (do+     string "forall "+     spaced $ fmap pretty con_ex_tvs+     string ". ")+    |=> (do+           whenJust con_mb_cxt $ \_ -> do+             pretty $ Context con_mb_cxt+             string " =>"+             newline+           pretty con_name+           pretty con_args) #endif prettyConDecl ConDeclH98 {con_forall = False, ..} =   case con_args of@@ -881,11 +1146,11 @@ prettyMatchExpr :: Match GhcPs (LHsExpr GhcPs) -> Printer () prettyMatchExpr Match {m_ctxt = LambdaExpr, ..} = do   string "\\"-  unless (null m_pats) $-    case unLoc $ head m_pats of-      LazyPat {} -> space-      BangPat {} -> space-      _ -> return ()+  unless (null m_pats)+    $ case unLoc $ head m_pats of+        LazyPat {} -> space+        BangPat {} -> space+        _ -> return ()   spaced $ fmap pretty m_pats   pretty $ GRHSsExpr GRHSExprLambda m_grhss prettyMatchExpr Match {m_ctxt = CaseAlt, ..} = do@@ -905,8 +1170,9 @@     Infix -> do       case (m_pats, m_ctxt) of         (l:r:xs, FunRhs {..}) -> do-          spaced $-            [pretty l, pretty $ fmap InfixOp mc_fun, pretty r] ++ fmap pretty xs+          spaced+            $ [pretty l, pretty $ fmap InfixOp mc_fun, pretty r]+                ++ fmap pretty xs           pretty m_grhss         _ -> error "Not enough parameters are passed." @@ -916,11 +1182,11 @@ prettyMatchProc :: Match GhcPs (LHsCmd GhcPs) -> Printer () prettyMatchProc Match {m_ctxt = LambdaExpr, ..} = do   string "\\"-  unless (null m_pats) $-    case unLoc $ head m_pats of-      LazyPat {} -> space-      BangPat {} -> space-      _ -> return ()+  unless (null m_pats)+    $ case unLoc $ head m_pats of+        LazyPat {} -> space+        BangPat {} -> space+        _ -> return ()   spaced $ fmap pretty m_pats ++ [pretty m_grhss] prettyMatchProc Match {m_ctxt = CaseAlt, ..} =   spaced [mapM_ pretty m_pats, pretty m_grhss]@@ -989,8 +1255,8 @@   pretty' HsRecFields {..} = hvFields fieldPrinters     where       fieldPrinters =-        fmap pretty rec_flds ++-        maybeToList (fmap (const (string "..")) rec_dotdot)+        fmap pretty rec_flds+          ++ maybeToList (fmap (const (string "..")) rec_dotdot)  instance Pretty (HsType GhcPs) where   pretty' = pretty' . HsType' HsTypeForNormalDecl HsTypeNoDir@@ -1109,11 +1375,11 @@           newline           string "where " |=> pretty grhssLocalBinds       (HsValBinds epa lr, _) ->-        indentedWithSpace 2 $-        newlinePrefixed-          [ string "where"-          , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)-          ]+        indentedWithSpace 2+          $ newlinePrefixed+              [ string "where"+              , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)+              ]       _ -> return ()  instance Pretty (GRHSs GhcPs (GenLocated SrcSpanAnnA (HsCmd GhcPs))) where@@ -1121,11 +1387,11 @@     mapM_ (pretty . fmap GRHSProc) grhssGRHSs     case grhssLocalBinds of       (HsValBinds epa lr) ->-        indentedWithSpace 2 $-        newlinePrefixed-          [ string "where"-          , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)-          ]+        indentedWithSpace 2+          $ newlinePrefixed+              [ string "where"+              , printCommentsAnd (L epa lr) (indentedWithSpace 2 . pretty)+              ]       _ -> return ()  instance Pretty (HsMatchContext GhcPs) where@@ -1165,18 +1431,20 @@     space     rhsSeparator grhsExprType     case unLoc body of-      HsDo _ DoExpr {} stmts ->-        printCommentsAnd body (const (doExpr "do" stmts))-      HsDo _ MDoExpr {} stmts ->-        printCommentsAnd body (const (doExpr "mdo" stmts))+      HsDo _ (DoExpr m) stmts ->+        printCommentsAnd body (const (doExpr (QualifiedDo m Do) stmts))+      HsDo _ (MDoExpr m) stmts ->+        printCommentsAnd body (const (doExpr (QualifiedDo m Mdo) stmts))+      OpApp _ (L _ (HsDo _ DoExpr {} _)) _ _ -> space >> pretty body+      OpApp _ (L _ (HsDo _ MDoExpr {} _)) _ _ -> space >> pretty body       _ ->         let hor = space >> pretty body             ver = newline >> indentedBlock (pretty body)          in hor <-|> ver     where-      doExpr pref stmts = do+      doExpr qDo stmts = do         space-        string pref+        pretty qDo         newline         indentedBlock $ printCommentsAnd stmts (lined . fmap pretty)   pretty' (GRHSExpr {grhsExpr = (GRHS _ guards body), ..}) = do@@ -1188,21 +1456,18 @@       space       rhsSeparator grhsExprType       printCommentsAnd body $ \case-        HsDo _ DoExpr {} stmts -> doExpr "do" stmts-        HsDo _ MDoExpr {} stmts -> doExpr "mdo" stmts+        HsDo _ (DoExpr m) stmts -> doExpr (QualifiedDo m Do) stmts+        HsDo _ (MDoExpr m) stmts -> doExpr (QualifiedDo m Mdo) stmts         x ->           let hor = space >> pretty x               ver = newline >> indentedBlock (pretty x)            in hor <-|> ver     where-      doExpr pref stmts = do+      doExpr qDo stmts = do         space-        string pref-        let hor = space >> printCommentsAnd stmts (lined . fmap pretty)-            ver = do-              newline-              indentedBlock (printCommentsAnd stmts (lined . fmap pretty))-        hor <-|> ver+        pretty qDo+        newline+        indentedBlock (printCommentsAnd stmts (lined . fmap pretty))  instance Pretty GRHSProc where   pretty' (GRHSProc (GRHS _ guards body)) =@@ -1245,7 +1510,7 @@  instance Pretty (SpliceDecl GhcPs) where   pretty' (SpliceDecl _ sp _) = pretty sp-+#if !MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (HsSplice GhcPs) where   pretty' (HsTypedSplice _ _ _ body) = string "$$" >> pretty body   pretty' (HsUntypedSplice _ DollarSplice _ body) = string "$" >> pretty body@@ -1255,15 +1520,18 @@   pretty' (HsQuasiQuote _ _ l _ r) =     brackets $ do       pretty l-      wrapWithBars $-        indentedWithFixedLevel 0 $ sequence_ $ printers [] "" $ unpackFS r+      wrapWithBars+        $ indentedWithFixedLevel 0+        $ sequence_+        $ printers [] ""+        $ unpackFS r     where       printers ps s [] = reverse (string (reverse s) : ps)       printers ps s ('\n':xs) =         printers (newline : string (reverse s) : ps) "" xs       printers ps s (x:xs) = printers ps (x : s) xs   pretty' HsSpliced {} = notGeneratedByParser-+#endif instance Pretty (Pat GhcPs) where   pretty' = prettyPat @@ -1276,7 +1544,11 @@ prettyPat WildPat {} = string "_" prettyPat (VarPat _ x) = pretty x prettyPat (LazyPat _ x) = string "~" >> pretty x+#if MIN_VERSION_ghc_lib_parser(9,6,1)+prettyPat (AsPat _ a _ b) = pretty a >> string "@" >> pretty b+#else prettyPat (AsPat _ a b) = pretty a >> string "@" >> pretty b+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyPat (ParPat _ _ inner _) = parens $ pretty inner #else@@ -1321,8 +1593,8 @@       xs -> hvFields xs     where       fieldPrinters =-        fmap (pretty . fmap RecConField) rec_flds ++-        maybeToList (fmap (const (string "..")) rec_dotdot)+        fmap (pretty . fmap RecConField) rec_flds+          ++ maybeToList (fmap (const (string "..")) rec_dotdot) #if !MIN_VERSION_ghc_lib_parser(9,4,1) instance Pretty (HsBracket GhcPs) where   pretty' (ExpBr _ expr) = brackets $ wrapWithBars $ pretty expr@@ -1465,50 +1737,58 @@   pretty' InfixApp {..} = horizontal <-|> vertical     where       horizontal = spaced [pretty lhs, pretty (InfixExpr op), pretty rhs]-      vertical = do-        lhsVer-        beforeRhs <--          case unLoc lhs of-            (HsDo _ DoExpr {} _) -> do-              indentedWithSpace 3 (newline >> pretty (InfixExpr op)) -- 3 for "do "-              return space-            (HsDo _ MDoExpr {} _) -> do-              indentedWithSpace 4 (newline >> pretty (InfixExpr op)) -- 4 for "mdo "-              return space-            _ -> do-              space-              pretty (InfixExpr op)-              return newline-        case unLoc rhs of-          (HsDo _ (DoExpr _) xs) -> do-            string " do"-            newline-            indentedBlock $ printCommentsAnd xs (lined . fmap pretty)-          (HsDo _ (MDoExpr _) xs) -> do-            string " mdo"-            newline-            indentedBlock $ printCommentsAnd xs (lined . fmap pretty)-          HsLam {} -> do-            space-            pretty rhs-          HsLamCase {} -> do-            space-            pretty rhs-          _ ->-            (if immediatelyAfterDo-               then indentedBlock-               else id) $ do-              beforeRhs-              col <- startingColumn-              (if col == 0-                 then indentedBlock-                 else id) $-                pretty rhs-      lhsVer =-        case lhs of-          (L loc (OpApp _ l o r)) ->-            pretty (L loc (InfixApp l o r immediatelyAfterDo))-          _ -> pretty lhs+      vertical =+        case findFixity op of+          Fixity _ _ InfixL -> leftAssoc+          Fixity _ _ InfixR -> rightAssoc+          Fixity _ _ InfixN -> noAssoc+      leftAssoc = prettyOps allOperantsAndOperatorsLeftAssoc+      rightAssoc = prettyOps allOperantsAndOperatorsRightAssoc+      noAssoc+        | L _ (OpApp _ _ o _) <- lhs+        , isSameAssoc o = leftAssoc+        | otherwise = rightAssoc+      prettyOps [l, o, L _ (HsDo _ (DoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Do]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, L _ (HsDo _ (MDoExpr m) xs)] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty $ QualifiedDo m Mdo]+        newline+        indentedBlock $ printCommentsAnd xs (lined . fmap pretty)+      prettyOps [l, o, r@(L _ HsLam {})] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty r]+      prettyOps [l, o, r@(L _ HsLamCase {})] = do+        spaced [pretty l, pretty $ InfixExpr o, pretty r]+      prettyOps (l:xs) = do+        pretty l+        newline+        indentedBlock $ f xs+        where+          f (o:r:rems) = do+            (pretty (InfixExpr o) >> space) |=> pretty r+            unless (null rems) $ do+              newline+              f rems+          f _ =+            error+              "The number of the sum of operants and operators should be odd."+      prettyOps _ = error "Too short list."+      findFixity o = fromMaybe defaultFixity $ lookup (varToStr o) fixities+      allOperantsAndOperatorsLeftAssoc = reverse $ rhs : op : collect lhs+        where+          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]+          collect (L _ (OpApp _ l o r))+            | isSameAssoc o = r : o : collect l+          collect x = [x]+      allOperantsAndOperatorsRightAssoc = lhs : op : collect rhs+        where+          collect :: LHsExpr GhcPs -> [LHsExpr GhcPs]+          collect (L _ (OpApp _ l o r))+            | isSameAssoc o = l : o : collect r+          collect x = [x]+      isSameAssoc (findFixity -> Fixity _ lv d) = lv == level && d == dir+      Fixity _ level dir = findFixity op  instance Pretty a => Pretty (BooleanFormula a) where   pretty' (Var x) = pretty x@@ -1522,7 +1802,7 @@ instance Pretty (AmbiguousFieldOcc GhcPs) where   pretty' (Unambiguous _ name) = pretty name   pretty' (Ambiguous _ name) = pretty name-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (ImportDecl GhcPs) where   pretty' decl@ImportDecl {..} = do     string "import "@@ -1536,11 +1816,31 @@     whenJust ideclAs $ \x -> do       string " as "       pretty x+    whenJust ideclImportList $ \(x, ps) -> do+      when (x == EverythingBut) (string " hiding")+      (string " " >> printCommentsAnd ps (hTuple . fmap pretty))+        <-|> (newline+                >> indentedBlock (printCommentsAnd ps (vTuple . fmap pretty)))+#else+instance Pretty (ImportDecl GhcPs) where+  pretty' decl@ImportDecl {..} = do+    string "import "+    when (ideclSource == IsBoot) $ string "{-# SOURCE #-} "+    when ideclSafe $ string "safe "+    unless (ideclQualified == NotQualified) $ string "qualified "+    whenJust (packageName decl) $ \x -> do+      pretty x+      space+    pretty ideclName+    whenJust ideclAs $ \x -> do+      string " as "+      pretty x     whenJust ideclHiding $ \(x, ps) -> do       when x (string " hiding")-      (string " " >> printCommentsAnd ps (hTuple . fmap pretty)) <-|>-        (newline >> indentedBlock (printCommentsAnd ps (vTuple . fmap pretty)))-+      (string " " >> printCommentsAnd ps (hTuple . fmap pretty))+        <-|> (newline+                >> indentedBlock (printCommentsAnd ps (vTuple . fmap pretty)))+#endif packageName :: ImportDecl GhcPs -> Maybe StringLiteral #if MIN_VERSION_ghc_lib_parser(9,4,1) packageName (ideclPkgQual -> RawPkgQual name) = Just name@@ -1577,11 +1877,11 @@ -- | This instance is for type family declarations inside a class declaration. instance Pretty (FamilyDecl GhcPs) where   pretty' FamilyDecl {..} = do-    string $-      case fdInfo of-        DataFamily -> "data"-        OpenTypeFamily -> "type"-        ClosedTypeFamily {} -> "type"+    string+      $ case fdInfo of+          DataFamily -> "data"+          OpenTypeFamily -> "type"+          ClosedTypeFamily {} -> "type"     case fdTopLevel of       TopLevel -> string " family "       NotTopLevel -> space@@ -1626,8 +1926,8 @@   pretty' (FromTo from to) =     brackets $ spaced [pretty from, string "..", pretty to]   pretty' (FromThenTo from next to) =-    brackets $-    spaced [pretty from >> comma >> pretty next, string "..", pretty to]+    brackets+      $ spaced [pretty from >> comma >> pretty next, string "..", pretty to]  instance Pretty (HsForAllTelescope GhcPs) where   pretty' HsForAllVis {..} = do@@ -1659,7 +1959,7 @@       string "."       pretty name   pretty' (PrefixOp Orig {}) = notUsedInParsedStage-  pretty' (PrefixOp (Exact name)) = parensIfSymbol occ $ pretty occ+  pretty' (PrefixOp (Exact name)) = parensIfSymbol occ $ output name     where       occ = occName name @@ -1773,9 +2073,13 @@   pretty' (VarBr _ True x) = string "'" >> pretty x   pretty' (VarBr _ False x) = string "''" >> pretty x #endif+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (WarnDecls GhcPs) where+  pretty' (Warnings _ x) = lined $ fmap pretty x+#else+instance Pretty (WarnDecls GhcPs) where   pretty' (Warnings _ _ x) = lined $ fmap pretty x-+#endif instance Pretty (WarnDecl GhcPs) where   pretty' (Warning _ names deprecatedOrWarning) =     case deprecatedOrWarning of@@ -1793,13 +2097,25 @@ instance Pretty (WithHsDocIdentifiers StringLiteral GhcPs) where   pretty' WithHsDocIdentifiers {..} = pretty hsDocString #endif++#if MIN_VERSION_ghc_lib_parser(9,6,1) -- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)'+instance Pretty (IEWrappedName GhcPs) where+  pretty' (IEName _ name) = pretty name+  pretty' (IEPattern _ name) = spaced [string "pattern", pretty name]+  pretty' (IEType _ name) = string "type " >> pretty name+#else+-- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)' instance Pretty (IEWrappedName RdrName) where   pretty' (IEName name) = pretty name   pretty' (IEPattern _ name) = spaced [string "pattern", pretty name]   pretty' (IEType _ name) = string "type " >> pretty name-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#endif+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (DotFieldOcc GhcPs) where+  pretty' DotFieldOcc {..} = printCommentsAnd dfoLabel pretty+#elif MIN_VERSION_ghc_lib_parser(9,4,1)+instance Pretty (DotFieldOcc GhcPs) where   pretty' DotFieldOcc {..} = printCommentsAnd dfoLabel (string . unpackFS) #else instance Pretty (HsFieldLabel GhcPs) where@@ -1808,10 +2124,29 @@ instance Pretty (RuleDecls GhcPs) where   pretty' HsRules {..} =     lined $ string "{-# RULES" : fmap pretty rds_rules ++ [string " #-}"]-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (RuleDecl GhcPs) where   pretty' HsRule {..} =     spaced+      [ printCommentsAnd rd_name (doubleQuotes . string . unpackFS)+      , lhs+      , string "="+      , pretty rd_rhs+      ]+    where+      lhs =+        if null rd_tmvs+          then pretty rd_lhs+          else do+            string "forall "+            spaced $ fmap pretty rd_tmvs+            dot+            space+            pretty rd_lhs+#else+instance Pretty (RuleDecl GhcPs) where+  pretty' HsRule {..} =+    spaced       [ printCommentsAnd rd_name (doubleQuotes . string . unpackFS . snd)       , lhs       , string "="@@ -1827,7 +2162,7 @@             dot             space             pretty rd_lhs-+#endif instance Pretty OccName where   pretty' = output @@ -1883,16 +2218,27 @@       , string "::"       , pretty fd_sig_ty       ]-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (ForeignImport GhcPs) where+  pretty' (CImport (L _ (SourceText s)) conv safety _ _) =+    spaced [pretty conv, pretty safety, string s]+  pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety]+#else instance Pretty ForeignImport where   pretty' (CImport conv safety _ _ (L _ (SourceText s))) =     spaced [pretty conv, pretty safety, string s]   pretty' (CImport conv safety _ _ _) = spaced [pretty conv, pretty safety]+#endif +#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (ForeignExport GhcPs) where+  pretty' (CExport (L _ (SourceText s)) conv) = spaced [pretty conv, string s]+  pretty' (CExport _ conv) = pretty conv+#else instance Pretty ForeignExport where   pretty' (CExport conv (L _ (SourceText s))) = spaced [pretty conv, string s]   pretty' (CExport conv _) = pretty conv-+#endif instance Pretty CExportSpec where   pretty' (CExportStatic _ _ x) = pretty x @@ -1900,20 +2246,28 @@   pretty' PlaySafe = string "safe"   pretty' PlayInterruptible = string "interruptible"   pretty' PlayRisky = string "unsafe"-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (AnnDecl GhcPs) where+  pretty' (HsAnnotation _ (ValueAnnProvenance name) expr) =+    spaced [string "{-# ANN", pretty name, pretty expr, string "#-}"]+  pretty' (HsAnnotation _ (TypeAnnProvenance name) expr) =+    spaced [string "{-# ANN type", pretty name, pretty expr, string "#-}"]+  pretty' (HsAnnotation _ ModuleAnnProvenance expr) =+    spaced [string "{-# ANN module", pretty expr, string "#-}"]+#else+instance Pretty (AnnDecl GhcPs) where   pretty' (HsAnnotation _ _ (ValueAnnProvenance name) expr) =     spaced [string "{-# ANN", pretty name, pretty expr, string "#-}"]   pretty' (HsAnnotation _ _ (TypeAnnProvenance name) expr) =     spaced [string "{-# ANN type", pretty name, pretty expr, string "#-}"]   pretty' (HsAnnotation _ _ ModuleAnnProvenance expr) =     spaced [string "{-# ANN module", pretty expr, string "#-}"]-+#endif instance Pretty (RoleAnnotDecl GhcPs) where   pretty' (RoleAnnotDecl _ name roles) =-    spaced $-    [string "type role", pretty name] ++-    fmap (maybe (string "_") pretty . unLoc) roles+    spaced+      $ [string "type role", pretty name]+          ++ fmap (maybe (string "_") pretty . unLoc) roles  instance Pretty Role where   pretty' Nominal = string "nominal"@@ -2038,20 +2392,29 @@             string "" |=> do               string s               newline-              indentedWithSpace (-1) $-                lined $ fmap (string . dropWhile (/= '\\')) ss-+              indentedWithSpace (-1)+                $ lined+                $ fmap (string . dropWhile (/= '\\')) ss+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (HsPragE GhcPs) where+  pretty' (HsPragSCC _ x) = spaced [string "{-# SCC", pretty x, string "#-}"]+#else+instance Pretty (HsPragE GhcPs) where   pretty' (HsPragSCC _ _ x) = spaced [string "{-# SCC", pretty x, string "#-}"]-+#endif instance Pretty HsIPName where   pretty' (HsIPName x) = string $ unpackFS x-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty (HsTyLit GhcPs) where+  pretty' (HsNumTy _ x) = string $ show x+  pretty' (HsStrTy _ x) = string $ ushow x+  pretty' (HsCharTy _ x) = string $ show x+#else instance Pretty HsTyLit where   pretty' (HsNumTy _ x) = string $ show x   pretty' (HsStrTy _ x) = string $ ushow x   pretty' (HsCharTy _ x) = string $ show x-+#endif instance Pretty (HsPatSigType GhcPs) where   pretty' HsPS {..} = pretty hsps_body @@ -2142,9 +2505,12 @@   pretty' ListComprehension {..} = horizontal <-|> vertical     where       horizontal =-        brackets $-        spaced-          [pretty listCompLhs, string "|", hCommaSep $ fmap pretty listCompRhs]+        brackets+          $ spaced+              [ pretty listCompLhs+              , string "|"+              , hCommaSep $ fmap pretty listCompRhs+              ]       vertical = do         string "[ "         pretty $ fmap StmtLRInsideVerticalList listCompLhs@@ -2156,14 +2522,22 @@       stmtsAndPrefixes l = ("| ", head l) : fmap (", ", ) (tail l)  instance Pretty DoExpression where-  pretty' DoExpression {..} =-    (string pref >> space) |=> lined (fmap pretty doStmts)-    where-      pref =-        case doOrMdo of-          Do -> "do"-          Mdo -> "mdo"+  pretty' DoExpression {..} = do+    pretty qualifiedDo+    newline+    indentedBlock $ lined $ fmap pretty doStmts +instance Pretty DoOrMdo where+  pretty' Do = string "do"+  pretty' Mdo = string "mdo"++instance Pretty QualifiedDo where+  pretty' (QualifiedDo (Just m) d) = do+    pretty m+    string "."+    pretty d+  pretty' (QualifiedDo Nothing d) = pretty d+ instance Pretty LetIn where   pretty' LetIn {..} =     lined [string "let " |=> pretty letBinds, string " in " |=> pretty inExpr]@@ -2208,7 +2582,32 @@     string "forall"     spacePrefixed $ fmap pretty hso_bndrs     dot+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance Pretty FieldLabelString where+  pretty' = output +instance Pretty (HsUntypedSplice GhcPs) where+  pretty' (HsUntypedSpliceExpr _ x) = string "$" >> pretty x+  -- The body of a quasi-quote must not be changed by a formatter.+  -- Changing it will modify the actual behavior of the code.+  --+  -- TODO: Remove duplicated code+  pretty' (HsQuasiQuote _ l r) =+    brackets $ do+      pretty l+      printCommentsAnd+        r+        (wrapWithBars+           . indentedWithFixedLevel 0+           . sequence_+           . printers [] ""+           . unpackFS)+    where+      printers ps s [] = reverse (string (reverse s) : ps)+      printers ps s ('\n':xs) =+        printers (newline : string (reverse s) : ps) "" xs+      printers ps s (x:xs) = printers ps (x : s) xs+#endif -- | Marks an AST node as never appearing in an AST. -- -- Some AST node types are only defined in `ghc-lib-parser` and not

@@ -223,11 +223,11 @@ -- separator. vWrappedLineup :: Char -> (String, String) -> [Printer ()] -> Printer () vWrappedLineup sep (prefix, suffix) ps =-  string prefix >>-  space |=> do-    prefixedLined [sep, ' '] ps-    newline-    indentedWithSpace (-(fromIntegral (length prefix) + 1)) $ string suffix+  string prefix+    >> space |=> do+         prefixedLined [sep, ' '] ps+         newline+         indentedWithSpace (-(fromIntegral (length prefix) + 1)) $ string suffix  -- | Similar to 'vWrappedLineup' but the suffix is in the same line as the -- last element.@@ -235,10 +235,10 @@ vWrappedLineup' _ (prefix, suffix) [x] =   spaced [string prefix, x, string suffix] vWrappedLineup' sep (prefix, suffix) ps =-  string prefix >>-  space |=> do-    prefixedLined [sep, ' '] ps-    string suffix+  string prefix+    >> space |=> do+         prefixedLined [sep, ' '] ps+         string suffix  -- Inserts the first printer between each element of the list passed as the -- second argument and runs them.

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | Printer combinators for printing values of types implementing -- 'Outputable'. module HIndent.Pretty.Combinators.Outputable@@ -33,4 +35,8 @@  -- | 'DynFlags' for calling 'showPpr' dynFlags :: DynFlags+#if MIN_VERSION_ghc_lib_parser(9,6,1)+dynFlags = defaultDynFlags fakeSettings+#else dynFlags = defaultDynFlags fakeSettings fakeLlvmConfig+#endif

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | Printer combinators related to print strings. module HIndent.Pretty.Combinators.String   ( string@@ -13,15 +15,17 @@ import GHC.Stack import HIndent.Config import HIndent.Printer-+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+import Control.Monad+#endif -- | This function prints the given string. -- -- The string must not include '\n's. Use 'newline' to print them. string :: HasCallStack => String -> Printer () string x   | '\n' `elem` x =-    error $-    "You tried to print " ++ show x ++ ". Use `newline` to print '\\n's."+    error+      $ "You tried to print " ++ show x ++ ". Use `newline` to print '\\n's."   | otherwise = do     eol <- gets psEolComment     hardFail <- gets psFitOnOneLine

@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase, CPP #-}  -- | Printer combinators for switching printers depending on situations. module HIndent.Pretty.Combinators.Switch@@ -8,7 +8,9 @@ import Control.Applicative import Control.Monad.State import HIndent.Printer-+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+import Control.Monad+#endif -- | This function runs the first printer if the result of running it fits -- in a single line. Otherwise, it runs the second printer. (<-|>) :: Printer a -> Printer a -> Printer a

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | Helper functions for dealing with import declarations. module HIndent.Pretty.Import   ( importsExist@@ -6,22 +8,22 @@   , groupImports   ) where -import GHC.Hs import GHC.Types.SrcLoc+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Pretty.Import.Sort  -- | Returns if the module has import declarations.-importsExist :: HsModule -> Bool+importsExist :: HsModule' -> Bool importsExist = not . null . hsmodImports  -- | Extracts import declarations from the given module. Adjacent import -- declarations are grouped as a single list.-extractImports :: HsModule -> [[LImportDecl GhcPs]]+extractImports :: HsModule' -> [[LImportDecl GhcPs]] extractImports = groupImports . sortImportsByLocation . hsmodImports  -- | Extracts import declarations from the given module and sorts them by -- their names. Adjacent import declarations are grouped as a single list.-extractImportsSorted :: HsModule -> [[LImportDecl GhcPs]]+extractImportsSorted :: HsModule' -> [[LImportDecl GhcPs]] extractImportsSorted = fmap sortImportsByName . extractImports  -- | Combines adjacent import declarations into a single list.@@ -38,8 +40,8 @@       | z `isAdjacentTo` y = groupImports' ((y : z : zs) : xs) ys       | otherwise = groupImports' ([y] : (z : zs) : xs) ys     a `isAdjacentTo` b =-      srcSpanEndLine (sp a) + 1 == srcSpanStartLine (sp b) ||-      srcSpanEndLine (sp b) + 1 == srcSpanStartLine (sp a)+      srcSpanEndLine (sp a) + 1 == srcSpanStartLine (sp b)+        || srcSpanEndLine (sp b) + 1 == srcSpanStartLine (sp a)     sp x =       case locA $ getLoc x of         RealSrcSpan x' _ -> x'

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | Import declaration sorting for pretty-printing. module HIndent.Pretty.Import.Sort   ( sortImportsByName@@ -42,10 +44,17 @@ -- | This function sorts explicit imports in the given import declaration -- by their names. sortExplicitImportsInDecl :: LImportDecl GhcPs -> LImportDecl GhcPs+#if MIN_VERSION_ghc_lib_parser(9,6,1)+sortExplicitImportsInDecl (L l d@ImportDecl {ideclImportList = Just (x, imports)}) =+  L l d {ideclImportList = Just (x, sorted)}+  where+    sorted = fmap (fmap sortVariants . sortExplicitImports) imports+#else sortExplicitImportsInDecl (L l d@ImportDecl {ideclHiding = Just (x, imports)}) =   L l d {ideclHiding = Just (x, sorted)}   where     sorted = fmap (fmap sortVariants . sortExplicitImports) imports+#endif sortExplicitImportsInDecl x = x  -- | This function sorts the given explicit imports by their names.

@@ -20,15 +20,36 @@ import GHC.Types.Name.Reader import GHC.Types.SourceText import GHC.Types.SrcLoc-import GHC.Unit import HIndent.Pretty.Pragma import HIndent.Pretty.SigBindFamily import HIndent.Pretty.Types-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+import GHC.Core.DataCon+#endif+#if !MIN_VERSION_ghc_lib_parser(9,6,1)+import GHC.Unit+#endif -- | An interface to extract comments from an AST node. class CommentExtraction a where   nodeComments :: a -> NodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction (HsModule GhcPs) where+  nodeComments =+    nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn . hsmodExt+    where+      filterOutEofAndPragmasFromAnn EpAnn {..} =+        EpAnn {comments = filterOutEofAndPragmasFromComments comments, ..}+      filterOutEofAndPragmasFromAnn EpAnnNotUsed = EpAnnNotUsed+      filterOutEofAndPragmasFromComments comments =+        EpaCommentsBalanced+          { priorComments = filterOutEofAndPragmas $ priorComments comments+          , followingComments =+              filterOutEofAndPragmas $ getFollowingComments comments+          }+      filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment+      isNeitherEofNorPragmaComment (L _ (EpaComment EpaEofComment _)) = False+      isNeitherEofNorPragmaComment (L _ (EpaComment tok _)) = not $ isPragma tok+#else instance CommentExtraction HsModule where   nodeComments = nodeComments . filterOutEofAndPragmasFromAnn . hsmodAnn     where@@ -44,7 +65,7 @@       filterOutEofAndPragmas = filter isNeitherEofNorPragmaComment       isNeitherEofNorPragmaComment (L _ (EpaComment EpaEofComment _)) = False       isNeitherEofNorPragmaComment (L _ (EpaComment tok _)) = not $ isPragma tok-+#endif instance CommentExtraction l => CommentExtraction (GenLocated l e) where   nodeComments (L l _) = nodeComments l @@ -64,13 +85,19 @@   nodeComments DocD {} =     error "Document comments should be treated as normal ones."   nodeComments RoleAnnotD {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (TyClDecl GhcPs) where   nodeComments FamDecl {} = emptyNodeComments   nodeComments SynDecl {..} = nodeComments tcdSExt   nodeComments DataDecl {..} = nodeComments tcdDExt+  nodeComments ClassDecl {tcdCExt = (x, _)} = nodeComments x+#else+instance CommentExtraction (TyClDecl GhcPs) where+  nodeComments FamDecl {} = emptyNodeComments+  nodeComments SynDecl {..} = nodeComments tcdSExt+  nodeComments DataDecl {..} = nodeComments tcdDExt   nodeComments ClassDecl {tcdCExt = (x, _, _)} = nodeComments x-+#endif instance CommentExtraction (InstDecl GhcPs) where   nodeComments = nodeCommentsInstDecl @@ -94,11 +121,23 @@ nodeCommentsHsBind AbsBinds {} = emptyNodeComments #endif nodeCommentsHsBind PatSynBind {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (Sig GhcPs) where   nodeComments (TypeSig x _ _) = nodeComments x   nodeComments (PatSynSig x _ _) = nodeComments x   nodeComments (ClassOpSig x _ _ _) = nodeComments x+  nodeComments (FixSig x _) = nodeComments x+  nodeComments (InlineSig x _ _) = nodeComments x+  nodeComments (SpecSig x _ _ _) = nodeComments x+  nodeComments (SpecInstSig x _) = nodeComments $ fst x+  nodeComments (MinimalSig x _) = nodeComments $ fst x+  nodeComments (SCCFunSig x _ _) = nodeComments $ fst x+  nodeComments (CompleteMatchSig x _ _) = nodeComments $ fst x+#else+instance CommentExtraction (Sig GhcPs) where+  nodeComments (TypeSig x _ _) = nodeComments x+  nodeComments (PatSynSig x _ _) = nodeComments x+  nodeComments (ClassOpSig x _ _ _) = nodeComments x   nodeComments IdSig {} = emptyNodeComments   nodeComments (FixSig x _) = nodeComments x   nodeComments (InlineSig x _ _) = nodeComments x@@ -107,7 +146,7 @@   nodeComments (MinimalSig x _ _) = nodeComments x   nodeComments (SCCFunSig x _ _ _) = nodeComments x   nodeComments (CompleteMatchSig x _ _ _) = nodeComments x-+#endif instance CommentExtraction DeclSig where   nodeComments (DeclSig x) = nodeComments x @@ -126,6 +165,12 @@ instance CommentExtraction LambdaCase where   nodeComments (LambdaCase x _) = nodeComments x +instance CommentExtraction DoOrMdo where+  nodeComments = const emptyNodeComments++instance CommentExtraction QualifiedDo where+  nodeComments = const emptyNodeComments+ nodeCommentsHsExpr :: HsExpr GhcPs -> NodeComments nodeCommentsHsExpr HsVar {} = emptyNodeComments nodeCommentsHsExpr (HsUnboundVar x _) = nodeComments x@@ -133,7 +178,11 @@ nodeCommentsHsExpr HsConLikeOut {} = emptyNodeComments nodeCommentsHsExpr HsRecFld {} = emptyNodeComments #endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+nodeCommentsHsExpr (HsOverLabel x _ _) = nodeComments x+#else nodeCommentsHsExpr (HsOverLabel x _) = nodeComments x+#endif nodeCommentsHsExpr (HsIPVar x _) = nodeComments x nodeCommentsHsExpr (HsOverLit x _) = nodeComments x nodeCommentsHsExpr (HsLit x _) = nodeComments x@@ -177,7 +226,9 @@ nodeCommentsHsExpr HsRnBracketOut {} = notUsedInParsedStage nodeCommentsHsExpr HsTcBracketOut {} = notUsedInParsedStage #endif+#if !MIN_VERSION_ghc_lib_parser(9,6,1) nodeCommentsHsExpr (HsSpliceE x _) = nodeComments x+#endif nodeCommentsHsExpr (HsProc x _ _) = nodeComments x nodeCommentsHsExpr (HsStatic x _) = nodeComments x #if !MIN_VERSION_ghc_lib_parser(9,4,1)@@ -190,6 +241,10 @@ nodeCommentsHsExpr (HsTypedBracket x _) = nodeComments x nodeCommentsHsExpr (HsUntypedBracket x _) = nodeComments x #endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+nodeCommentsHsExpr (HsTypedSplice (x, y) _) = nodeComments x <> nodeComments y+nodeCommentsHsExpr (HsUntypedSplice x _) = nodeComments x+#endif instance CommentExtraction (HsSigType GhcPs) where   nodeComments HsSig {} = emptyNodeComments @@ -321,13 +376,13 @@  instance CommentExtraction (SpliceDecl GhcPs) where   nodeComments SpliceDecl {} = emptyNodeComments-+#if !MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (HsSplice GhcPs) where   nodeComments (HsTypedSplice x _ _ _) = nodeComments x   nodeComments (HsUntypedSplice x _ _ _) = nodeComments x   nodeComments HsQuasiQuote {} = emptyNodeComments   nodeComments HsSpliced {} = emptyNodeComments-+#endif instance CommentExtraction (Pat GhcPs) where   nodeComments = nodeCommentsPat @@ -338,7 +393,11 @@ nodeCommentsPat WildPat {} = emptyNodeComments nodeCommentsPat VarPat {} = emptyNodeComments nodeCommentsPat (LazyPat x _) = nodeComments x+#if MIN_VERSION_ghc_lib_parser(9,6,1)+nodeCommentsPat (AsPat x _ _ _) = nodeComments x+#else nodeCommentsPat (AsPat x _ _) = nodeComments x+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) nodeCommentsPat (ParPat x _ _ _) = nodeComments x #else@@ -489,7 +548,10 @@  instance CommentExtraction (ImportDecl GhcPs) where   nodeComments ImportDecl {..} = nodeComments ideclExt-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction XImportDeclPass where+  nodeComments XImportDeclPass {..} = nodeComments ideclAnn+#endif instance CommentExtraction (HsDerivingClause GhcPs) where   nodeComments HsDerivingClause {..} = nodeComments deriv_clause_ext @@ -600,20 +662,32 @@   nodeComments TypBr {} = emptyNodeComments   nodeComments VarBr {} = emptyNodeComments #endif++#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (WarnDecls GhcPs) where+  nodeComments Warnings {..} = nodeComments $ fst wd_ext+#else+instance CommentExtraction (WarnDecls GhcPs) where   nodeComments Warnings {..} = nodeComments wd_ext-+#endif instance CommentExtraction (WarnDecl GhcPs) where   nodeComments (Warning x _ _) = nodeComments x #if MIN_VERSION_ghc_lib_parser(9,4,1) instance CommentExtraction (WithHsDocIdentifiers StringLiteral GhcPs) where   nodeComments WithHsDocIdentifiers {} = emptyNodeComments #endif+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction (IEWrappedName GhcPs) where+  nodeComments IEName {} = emptyNodeComments+  nodeComments IEPattern {} = emptyNodeComments+  nodeComments IEType {} = emptyNodeComments+#else -- | 'Pretty' for 'LIEWrappedName (IdP GhcPs)' instance CommentExtraction (IEWrappedName RdrName) where   nodeComments IEName {} = emptyNodeComments   nodeComments IEPattern {} = emptyNodeComments   nodeComments IEType {} = emptyNodeComments+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance CommentExtraction (DotFieldOcc GhcPs) where   nodeComments DotFieldOcc {..} = nodeComments dfoExt@@ -621,12 +695,22 @@ instance CommentExtraction (HsFieldLabel GhcPs) where   nodeComments HsFieldLabel {..} = nodeComments hflExt #endif++#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (RuleDecls GhcPs) where+  nodeComments HsRules {..} = nodeComments $ fst rds_ext+#else+instance CommentExtraction (RuleDecls GhcPs) where   nodeComments HsRules {..} = nodeComments rds_ext+#endif +#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (RuleDecl GhcPs) where+  nodeComments HsRule {..} = nodeComments $ fst rd_ext+#else+instance CommentExtraction (RuleDecl GhcPs) where   nodeComments HsRule {..} = nodeComments rd_ext-+#endif instance CommentExtraction OccName where   nodeComments = const emptyNodeComments @@ -652,13 +736,21 @@ instance CommentExtraction (ForeignDecl GhcPs) where   nodeComments ForeignImport {..} = nodeComments fd_i_ext   nodeComments ForeignExport {..} = nodeComments fd_e_ext-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction (ForeignImport GhcPs) where+  nodeComments CImport {} = emptyNodeComments+#else instance CommentExtraction ForeignImport where   nodeComments CImport {} = emptyNodeComments+#endif +#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction (ForeignExport GhcPs) where+  nodeComments CExport {} = emptyNodeComments+#else instance CommentExtraction ForeignExport where   nodeComments CExport {} = emptyNodeComments-+#endif instance CommentExtraction CExportSpec where   nodeComments CExportStatic {} = emptyNodeComments @@ -666,10 +758,13 @@   nodeComments PlaySafe = emptyNodeComments   nodeComments PlayInterruptible = emptyNodeComments   nodeComments PlayRisky = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (AnnDecl GhcPs) where+  nodeComments (HsAnnotation (x, _) _ _) = nodeComments x+#else+instance CommentExtraction (AnnDecl GhcPs) where   nodeComments (HsAnnotation x _ _ _) = nodeComments x-+#endif instance CommentExtraction (RoleAnnotDecl GhcPs) where   nodeComments (RoleAnnotDecl x _ _) = nodeComments x @@ -761,18 +856,26 @@   nodeComments HsRat {} = emptyNodeComments   nodeComments HsFloatPrim {} = emptyNodeComments   nodeComments HsDoublePrim {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1) instance CommentExtraction (HsPragE GhcPs) where+  nodeComments (HsPragSCC (x, _) _) = nodeComments x+#else+instance CommentExtraction (HsPragE GhcPs) where   nodeComments (HsPragSCC x _ _) = nodeComments x-+#endif instance CommentExtraction HsIPName where   nodeComments HsIPName {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction (HsTyLit GhcPs) where+  nodeComments HsNumTy {} = emptyNodeComments+  nodeComments HsStrTy {} = emptyNodeComments+  nodeComments HsCharTy {} = emptyNodeComments+#else instance CommentExtraction HsTyLit where   nodeComments HsNumTy {} = emptyNodeComments   nodeComments HsStrTy {} = emptyNodeComments   nodeComments HsCharTy {} = emptyNodeComments-+#endif instance CommentExtraction (HsPatSigType GhcPs) where   nodeComments HsPS {..} = nodeComments hsps_ext @@ -859,7 +962,14 @@ instance CommentExtraction (HsOuterSigTyVarBndrs GhcPs) where   nodeComments HsOuterImplicit {} = emptyNodeComments   nodeComments HsOuterExplicit {..} = nodeComments hso_xexplicit+#if MIN_VERSION_ghc_lib_parser(9,6,1)+instance CommentExtraction FieldLabelString where+  nodeComments = const emptyNodeComments +instance CommentExtraction (HsUntypedSplice GhcPs) where+  nodeComments (HsUntypedSpliceExpr x _) = nodeComments x+  nodeComments HsQuasiQuote {} = emptyNodeComments+#endif -- | Marks an AST node as never appearing in the AST. -- -- Some AST node types are only used in the renaming or type-checking phase.

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | Pretty-printing pragmas module HIndent.Pretty.Pragma   ( prettyPragmas@@ -11,7 +13,7 @@ import Data.List import Data.List.Split import Data.Maybe-import GHC.Hs+import HIndent.GhcLibParserWrapper.GHC.Hs import HIndent.Pragma import HIndent.Pretty.Combinators.Lineup import HIndent.Pretty.Combinators.String@@ -19,31 +21,34 @@ import Text.Regex.TDFA  -- | This function pretty-prints the module's pragmas-prettyPragmas :: HsModule -> Printer ()+prettyPragmas :: HsModule' -> Printer () prettyPragmas = lined . fmap string . collectPragmas  -- | This function returns a 'True' if the module has pragmas. -- Otherwise, it returns a 'False'.-pragmaExists :: HsModule -> Bool+pragmaExists :: HsModule' -> Bool pragmaExists = not . null . collectPragmas- -- | This function collects pragma comments from the -- given module and modifies them into 'String's. -- -- A pragma's name is converted to the @SHOUT_CASE@ (e.g., @lAnGuAgE@ -> -- @LANGUAGE@).+#if MIN_VERSION_ghc_lib_parser(9,6,1)+collectPragmas :: HsModule GhcPs -> [String]+collectPragmas =+  fmap (uncurry constructPragma)+    . mapMaybe extractPragma+    . listify isBlockComment+    . hsmodAnn+    . hsmodExt+#else collectPragmas :: HsModule -> [String] collectPragmas =-  fmap (uncurry constructPragma) .-  mapMaybe extractPragma . listify matchToComment . hsmodAnn-  where-    matchToComment :: EpaCommentTok -> Bool-    matchToComment EpaBlockComment {} = True-    matchToComment _ = False-    constructPragma optionOrPragma xs =-      "{-# " ++-      fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"-+  fmap (uncurry constructPragma)+    . mapMaybe extractPragma+    . listify isBlockComment+    . hsmodAnn+#endif -- | This function returns a 'Just' value with the pragma -- extracted from the passed 'EpaCommentTok' if it has one. Otherwise, it -- returns a 'Nothing'.@@ -59,3 +64,13 @@ isPragma :: EpaCommentTok -> Bool isPragma (EpaBlockComment c) = match pragmaRegex c isPragma _ = False++-- | Construct a pragma.+constructPragma :: String -> [String] -> String+constructPragma optionOrPragma xs =+  "{-# " ++ fmap toUpper optionOrPragma ++ " " ++ intercalate ", " xs ++ " #-}"++-- | Checks if the given comment is a block one.+isBlockComment :: EpaCommentTok -> Bool+isBlockComment EpaBlockComment {} = True+isBlockComment _ = False

@@ -7,6 +7,7 @@   , LSigBindFamily   , mkSortedLSigBindFamilyList   , mkLSigBindFamilyList+  , destructLSigBindFamilyList   , filterLSig   , filterLBind   ) where@@ -39,8 +40,8 @@   -> [LDataFamInstDecl GhcPs]   -> [LSigBindFamily] mkSortedLSigBindFamilyList sigs binds fams datafams =-  sortBy (compare `on` realSrcSpan . locA . getLoc) .-  mkLSigBindFamilyList sigs binds fams datafams+  sortBy (compare `on` realSrcSpan . locA . getLoc)+    . mkLSigBindFamilyList sigs binds fams datafams  -- | Creates a list of 'LSigBindFamily' from arguments. mkLSigBindFamilyList ::@@ -51,11 +52,28 @@   -> [LDataFamInstDecl GhcPs]   -> [LSigBindFamily] mkLSigBindFamilyList sigs binds fams insts datafams =-  fmap (fmap Sig) sigs ++-  fmap (fmap Bind) binds ++-  fmap (fmap TypeFamily) fams ++-  fmap (fmap TyFamInst) insts ++ fmap (fmap DataFamInst) datafams+  fmap (fmap Sig) sigs+    ++ fmap (fmap Bind) binds+    ++ fmap (fmap TypeFamily) fams+    ++ fmap (fmap TyFamInst) insts+    ++ fmap (fmap DataFamInst) datafams +-- | Destructs a list of 'LSigBindFamily'+destructLSigBindFamilyList ::+     [LSigBindFamily]+  -> ( [LSig GhcPs]+     , [LHsBindLR GhcPs GhcPs]+     , [LFamilyDecl GhcPs]+     , [LTyFamInstDecl GhcPs]+     , [LDataFamInstDecl GhcPs])+destructLSigBindFamilyList =+  (,,,,)+    <$> filterLSig+    <*> filterLBind+    <*> filterLTypeFamily+    <*> filterLTyFamInst+    <*> filterLDataFamInst+ -- | Filters out 'Sig's and extract the wrapped values. filterLSig :: [LSigBindFamily] -> [LSig GhcPs] filterLSig =@@ -70,4 +88,28 @@   mapMaybe     (\case        (L l (Bind x)) -> Just $ L l x+       _ -> Nothing)++-- | Filters out 'TypeFamily's and extract the wrapped values.+filterLTypeFamily :: [LSigBindFamily] -> [LFamilyDecl GhcPs]+filterLTypeFamily =+  mapMaybe+    (\case+       (L l (TypeFamily x)) -> Just $ L l x+       _ -> Nothing)++-- | Filters out 'TyFamInst's and extract the wrapped values.+filterLTyFamInst :: [LSigBindFamily] -> [LTyFamInstDecl GhcPs]+filterLTyFamInst =+  mapMaybe+    (\case+       (L l (TyFamInst x)) -> Just $ L l x+       _ -> Nothing)++-- | Filters out 'DataFamInst's and extract the wrapped values.+filterLDataFamInst :: [LSigBindFamily] -> [LDataFamInstDecl GhcPs]+filterLDataFamInst =+  mapMaybe+    (\case+       (L l (DataFamInst x)) -> Just $ L l x        _ -> Nothing)

@@ -45,6 +45,7 @@   , ListComprehension(..)   , DoExpression(..)   , DoOrMdo(..)+  , QualifiedDo(..)   , LetIn(..)   , NodeComments(..)   , GRHSExprType(..)@@ -57,9 +58,10 @@  import GHC.Hs import GHC.Types.Name.Reader-import GHC.Unit import GHC.Unit.Module.Warnings-+#if !MIN_VERSION_ghc_lib_parser(9,6,1)+import GHC.Unit+#endif -- | `LHsExpr` used as a infix operator newtype InfixExpr =   InfixExpr (LHsExpr GhcPs)@@ -277,7 +279,7 @@ -- | Use this type to pretty-print a do expression. data DoExpression = DoExpression   { doStmts :: [ExprLStmt GhcPs]-  , doOrMdo :: DoOrMdo+  , qualifiedDo :: QualifiedDo   }  -- | Use this type to pretty-print a @let ... in ...@ expression.@@ -293,10 +295,23 @@   , commentsAfter :: [LEpaComment]   } +instance Semigroup NodeComments where+  x <> y =+    NodeComments+      { commentsBefore = commentsBefore x <> commentsBefore y+      , commentsOnSameLine = commentsOnSameLine x <> commentsOnSameLine y+      , commentsAfter = commentsAfter x <> commentsAfter y+      }+ -- | Values indicating whether `do` or `mdo` is used. data DoOrMdo   = Do   | Mdo++-- | Values indicating whether the `do` is qualified with a module name (and+-- whether `do` or `mdo` is used)+data QualifiedDo =+  QualifiedDo (Maybe ModuleName) DoOrMdo  -- | Values indicating in which context a RHS is located. data GRHSExprType

@@ -13,15 +13,13 @@ import Control.Applicative import Control.Monad import Control.Monad.State.Strict (MonadState(..), StateT)-import Control.Monad.Trans.Maybe import Data.ByteString.Builder-import Data.Functor.Identity import Data.Int (Int64) import HIndent.Config  -- | A pretty printing monad. newtype Printer a = Printer-  { runPrinter :: StateT PrintState (MaybeT Identity) a+  { runPrinter :: StateT PrintState Maybe a   } deriving ( Applicative              , Monad              , Functor

@@ -7,7 +7,6 @@ import Data.Algorithm.Diff import Data.Algorithm.DiffOutput import qualified Data.ByteString as S-import qualified Data.ByteString.Builder as S import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8@@ -16,10 +15,8 @@ import Data.Function import Data.Version import qualified HIndent-import HIndent.CodeBlock-import HIndent.Config+import HIndent (Config(..)) import HIndent.Internal.Test.Markdone-import qualified HIndent.LanguageExtension as HIndent import qualified System.Info import Test.Hspec import Text.Read@@ -31,39 +28,38 @@   bytes <- S.readFile "TESTS.md"   forest <- parse (tokenize bytes)   hspec $ do-    codeBlocksSpec     markdoneSpec     toSpec forest  reformat :: Config -> S.ByteString -> ByteString reformat cfg code =-  either (("-- " <>) . L8.pack) S.toLazyByteString $-  HIndent.reformat cfg (Just HIndent.defaultExtensions) Nothing code+  either (("-- " <>) . L8.pack . HIndent.prettyParseError) L.fromStrict+    $ HIndent.reformat cfg [] Nothing code  -- | Convert the Markdone document to Spec benchmarks. toSpec :: [Markdone] -> Spec toSpec = go   where-    cfg = HIndent.Config.defaultConfig {configTrailingNewline = False}+    cfg = HIndent.defaultConfig {configTrailingNewline = False}     go (Section name children:next) = do       describe (UTF8.toString name) (go children)       go next     go (PlainText desc:CodeFence lang code:next) =       case lang of         "haskell" -> do-          it (UTF8.toString desc) $-            shouldBeReadable (reformat cfg code) (L.fromStrict code)+          it (UTF8.toString desc)+            $ shouldBeReadable (reformat cfg code) (L.fromStrict code)           go next         "haskell 4" -> do           let cfg' = cfg {configIndentSpaces = 4}-          it (UTF8.toString desc) $-            shouldBeReadable (reformat cfg' code) (L.fromStrict code)+          it (UTF8.toString desc)+            $ shouldBeReadable (reformat cfg' code) (L.fromStrict code)           go next         "haskell given" ->           case skipEmptyLines next of             CodeFence "haskell expect" codeExpect:next' -> do-              it (UTF8.toString desc) $-                shouldBeReadable (reformat cfg code) (L.fromStrict codeExpect)+              it (UTF8.toString desc)+                $ shouldBeReadable (reformat cfg code) (L.fromStrict codeExpect)               go next'             _ ->               error@@ -75,8 +71,8 @@           | Just from <- fromVersion $ UTF8.toString s ->             if compilerVersion >= from               then do-                it (UTF8.toString desc) $-                  shouldBeReadable (reformat cfg code) (L.fromStrict code)+                it (UTF8.toString desc)+                  $ shouldBeReadable (reformat cfg code) (L.fromStrict code)                 go next               else do                 it@@ -88,9 +84,11 @@     go (CodeFence {}:next) = go next     go [] = return ()     pendingForVersionMsg from =-      "The test is for GHC versions since " ++-      showVersion from ++-      " but you are using GHC version " ++ showVersion compilerVersion ++ "."+      "The test is for GHC versions since "+        ++ showVersion from+        ++ " but you are using GHC version "+        ++ showVersion compilerVersion+        ++ "."     fromVersion :: String -> Maybe Version     fromVersion s       | (_, _, _, [x, y, z]) <-@@ -118,11 +116,11 @@  instance Show Readable where   show (Readable x d') =-    "\n" ++-    LUTF8.toString x ++-    (case d' of-       Just d -> "\nThe diff:\n" ++ d-       Nothing -> "")+    "\n"+      ++ LUTF8.toString x+      ++ (case d' of+            Just d -> "\nThe diff:\n" ++ d+            Nothing -> "")  -- | A diff display. diff :: ByteString -> ByteString -> String@@ -132,66 +130,36 @@ skipEmptyLines (PlainText "":rest) = rest skipEmptyLines other = other -codeBlocksSpec :: Spec-codeBlocksSpec =-  describe "splitting source into code blocks" $ do-    it "should put just Haskell code in its own block" $ do-      let input = "this is totally haskell code\n\nit deserves its own block!\n"-      cppSplitBlocks input `shouldBe` [HaskellSource 0 input]-    it "should put #if/#endif and Haskell code into separate blocks" $ do-      cppSplitBlocks-        "haskell code\n#if DEBUG\ndebug code\n#endif\nmore haskell code\n" `shouldBe`-        [ HaskellSource 0 "haskell code"-        , CPPDirectives "#if DEBUG"-        , HaskellSource 2 "debug code"-        , CPPDirectives "#endif"-        , HaskellSource 4 "more haskell code\n"-        ]-    it "should put the shebang line into its own block" $ do-      cppSplitBlocks-        "#!/usr/bin/env runhaskell\n{-# LANGUAGE OverloadedStrings #-}\n" `shouldBe`-        [ Shebang "#!/usr/bin/env runhaskell"-        , HaskellSource 1 "{-# LANGUAGE OverloadedStrings #-}\n"-        ]-    it "should put a multi-line #define into its own block" $ do-      let input = "#define A \\\n  macro contents \\\n  go here\nhaskell code\n"-      cppSplitBlocks input `shouldBe`-        [ CPPDirectives "#define A \\\n  macro contents \\\n  go here"-        , HaskellSource 3 "haskell code\n"-        ]-    it "should put an unterminated multi-line #define into its own block" $ do-      cppSplitBlocks "#define A \\" `shouldBe` [CPPDirectives "#define A \\"]-      cppSplitBlocks "#define A \\\n" `shouldBe` [CPPDirectives "#define A \\"]-      cppSplitBlocks "#define A \\\n.\\" `shouldBe`-        [CPPDirectives "#define A \\\n.\\"]- markdoneSpec :: Spec markdoneSpec = do   describe "markdown tokenizer" $ do     it "should tokenize plain text" $ do       let input =             "this is a line\nthis is another line\n\nthis is a new paragraph\n"-      tokenize input `shouldBe`-        [ PlainLine "this is a line"-        , PlainLine "this is another line"-        , PlainLine ""-        , PlainLine "this is a new paragraph"-        ]+      tokenize input+        `shouldBe` [ PlainLine "this is a line"+                   , PlainLine "this is another line"+                   , PlainLine ""+                   , PlainLine "this is a new paragraph"+                   ]     it "should tokenize headings" $ do       tokenize "# Heading" `shouldBe` [Heading 1 "Heading"]     it "should tokenize code fence beginnings with labels" $ do       tokenize "``` haskell\n" `shouldBe` [BeginFence "haskell"]       tokenize "```haskell expect\n" `shouldBe` [BeginFence "haskell expect"]-      tokenize "before\n```code\nafter\n" `shouldBe`-        [PlainLine "before", BeginFence "code", PlainLine "after"]+      tokenize "before\n```code\nafter\n"+        `shouldBe` [PlainLine "before", BeginFence "code", PlainLine "after"]     it "should tokenize full code fences" $ do-      tokenize "```haskell\ncode goes here\n```" `shouldBe`-        [BeginFence "haskell", PlainLine "code goes here", EndFence]+      tokenize "```haskell\ncode goes here\n```"+        `shouldBe` [BeginFence "haskell", PlainLine "code goes here", EndFence]     it "should tokenize lines inside code fences as plain text" $ do-      tokenize "```haskell\n#!/usr/bin/env stack\n```" `shouldBe`-        [BeginFence "haskell", PlainLine "#!/usr/bin/env stack", EndFence]-      tokenize "```haskell\n# not a heading\n```" `shouldBe`-        [BeginFence "haskell", PlainLine "# not a heading", EndFence]+      tokenize "```haskell\n#!/usr/bin/env stack\n```"+        `shouldBe` [ BeginFence "haskell"+                   , PlainLine "#!/usr/bin/env stack"+                   , EndFence+                   ]+      tokenize "```haskell\n# not a heading\n```"+        `shouldBe` [BeginFence "haskell", PlainLine "# not a heading", EndFence]   describe "markdown parser" $ do     it "should parse a heading followed by text as a section" $ do       let input =@@ -200,11 +168,11 @@             , PlainLine "split across two lines."             ]       output <- parse input-      output `shouldBe`-        [ Section-            "This is a heading"-            [PlainText "This is plain text\nsplit across two lines."]-        ]+      output+        `shouldBe` [ Section+                       "This is a heading"+                       [PlainText "This is plain text\nsplit across two lines."]+                   ]  -- | Returns the version of the compiler used to build this program. --