ormolu 0.0.4.0 → 0.0.5.0

raw patch · 51 files changed

+920/−389 lines, 51 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• README.md +25/−1
• app/Main.hs +14/−12
• data/examples/declaration/annotation/annotation-out.hs +1/−0
• data/examples/declaration/splice/grouped-splices-out.hs +3/−0
• data/examples/declaration/splice/grouped-splices.hs +3/−0
• data/examples/declaration/splice/splice-decl.hs +0/−1
• data/examples/declaration/value/function/do/blocks-out.hs +1/−0
• data/examples/declaration/value/function/do/comment-alignment-out.hs +9/−0
• data/examples/declaration/value/function/do/comment-alignment.hs +9/−0
• data/examples/declaration/value/function/do/comment-spacing-out.hs +7/−0
• data/examples/declaration/value/function/do/comment-spacing.hs +7/−0
• data/examples/declaration/value/function/do/recursive-do-rec-out.hs +5/−0
• data/examples/declaration/value/function/let-single-line-out.hs +0/−1
• data/examples/module-header/double-dot-with-names-out.hs +1/−6
• data/examples/module-header/multiline2.hs +2/−2
• data/examples/module-header/preceding-comment-with-haddock-out.hs +1/−4
• data/examples/module-header/singleline-empty-out.hs +1/−4
• data/examples/module-header/stack-header-0-out.hs +1/−0
• data/examples/module-header/stack-header-1-out.hs +1/−0
• data/examples/module-header/warning-pragma-multiline-out.hs +1/−4
• data/examples/module-header/warning-pragma-out.hs +3/−1
• data/examples/other/pragma-comments-out.hs +8/−0
• data/examples/other/pragma-comments.hs +11/−0
• data/examples/other/pragma-out.hs +1/−4
• data/examples/other/pragma-sorting-out.hs +1/−2
• ormolu.cabal +6/−1
• src/Ormolu.hs +8/−5
• src/Ormolu/Config.hs +52/−11
• src/Ormolu/Exception.hs +4/−11
• src/Ormolu/Parser.hs +48/−98
• src/Ormolu/Parser/CommentStream.hs +49/−29
• src/Ormolu/Parser/Result.hs +13/−5
• src/Ormolu/Parser/Shebang.hs +27/−0
• src/Ormolu/Printer.hs +17/−11
• src/Ormolu/Printer/Combinators.hs +5/−3
• src/Ormolu/Printer/Comments.hs +38/−42
• src/Ormolu/Printer/Internal.hs +38/−16
• src/Ormolu/Printer/Meat/Common.hs +6/−4
• src/Ormolu/Printer/Meat/Declaration.hs +50/−43
• src/Ormolu/Printer/Meat/Declaration/Value.hs +35/−10
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +1/−3
• src/Ormolu/Printer/Meat/ImportExport.hs +22/−15
• src/Ormolu/Printer/Meat/Module.hs +20/−17
• src/Ormolu/Printer/Meat/Pragma.hs +22/−12
• src/Ormolu/Processing/Common.hs +27/−0
• src/Ormolu/Processing/Cpp.hs +70/−0
• src/Ormolu/Processing/Postprocess.hs +21/−0
• src/Ormolu/Processing/Preprocess.hs +149/−0
• src/Ormolu/Utils.hs +51/−7
• tests/Ormolu/PrinterSpec.hs +1/−4

@@ -1,3 +1,27 @@+## Ormolu 0.0.5.0++* Grouping of statements in `do`-blocks is now preserved. [Issue+  74](https://github.com/tweag/ormolu/issues/74).++* Grouping of TH splices is now preserved. [Issue+  507](https://github.com/tweag/ormolu/issues/507).++* Comments on pragmas are now preserved. [Issue+  216](https://github.com/tweag/ormolu/issues/216).++* Ormolu can now be enabled and disabled via special comments. [Issue+  435](https://github.com/tweag/ormolu/issues/435).++* Added experimental support for simple CPP. [Issue+  415](https://github.com/tweag/ormolu/issues/415).++* Added two new options `--start-line` and `--end-line` that allow us to+  select a region to format. [Issue+  516](https://github.com/tweag/ormolu/issues/516).++* Fixed rendering of module headers in the presence of preceding comments or+  Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561).+ ## Ormolu 0.0.4.0  * When given several files to format, Ormolu does not stop on the first

@@ -91,9 +91,33 @@ $ ormolu --mode inplace Module.hs ``` +## Magic comments++Ormolu understands two magic comments:++```haskell+{- ORMOLU_DISABLE -}+```++and++```haskell+{- ORMOLU_ENABLE -}+```++This allows us to disable formatting selectively for code between these+markers or disable it for the entire file. To achieve the latter, just put+`{- ORMOLU_DISABLE -}` at the very top. Note that the source code should+still be parseable even without the “excluded” part. Because of that the+magic comments cannot be placed arbitrary, but should rather enclose+independent top-level definitions.+ ## Current limitations -* Does not handle CPP (wontfix, see [the design document][design]).+* CPP support is experimental. CPP is virtually impossible to handle+  correctly, so we process them as a sort of unchangeable snippets. This+  works only in simple cases when CPP conditionals are self-contained. Use+  Ormolu with CPP at your own risk. * Input modules should be parsable by Haddock, which is a bit stricter   criterion than just being valid Haskell modules. * Various minor idempotence issues, most of them are related to comments.

@@ -4,10 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -module Main-  ( main,-  )-where+module Main (main) where  import Control.Exception (SomeException, displayException, try) import Control.Monad@@ -47,7 +44,7 @@   -- | Mode of operation   Mode ->   -- | Configuration-  Config ->+  Config RegionIndices ->   -- | File to format or stdin as 'Nothing'   Maybe FilePath ->   IO ()@@ -84,7 +81,7 @@   { -- | Mode of operation     optMode :: !Mode,     -- | Ormolu 'Config'-    optConfig :: !Config,+    optConfig :: !(Config RegionIndices),     -- | Haskell source files to format or stdin (when the list is empty)     optInputFiles :: ![FilePath]   }@@ -150,7 +147,7 @@         help "Haskell source files to format or stdin (default)"       ] -configParser :: Parser Config+configParser :: Parser (Config RegionIndices) configParser =   Config     <$> (fmap (fmap DynOption) . many . strOption . mconcat)@@ -170,15 +167,20 @@         help "Output information useful for debugging"       ]     <*> (switch . mconcat)-      [ long "tolerate-cpp",-        short 'p',-        help "Do not fail if CPP pragma is present"-      ]-    <*> (switch . mconcat)       [ long "check-idempotency",         short 'c',         help "Fail if formatting is not idempotent"       ]+    <*> ( RegionIndices+            <$> (optional . option auto . mconcat)+              [ long "start-line",+                help "Start line of the region to format (lines start from 1)"+              ]+            <*> (optional . option auto . mconcat)+              [ long "end-line",+                help "End line of the region to format (inclusive)"+              ]+        )  ---------------------------------------------------------------------------- -- Helpers

@@ -18,4 +18,5 @@  data Foo = Foo Int {-# ANN type Foo ("HLint: ignore") #-}+ {- Comment -}

@@ -0,0 +1,3 @@+$(deriveJSON fieldLabelMod ''A)+$(deriveJSON fieldLabelMod ''B)+$(deriveJSON fieldLabelMod ''C)

@@ -0,0 +1,3 @@+$(deriveJSON fieldLabelMod ''A)+$(deriveJSON fieldLabelMod ''B)+$(deriveJSON fieldLabelMod ''C)

@@ -15,4 +15,3 @@ -- TemplateHaskell allows Q () at the top level do   pure []-

@@ -15,4 +15,5 @@     <|> do       optional g_Semi       void allspacing+   return things

@@ -0,0 +1,9 @@+main = do+  case blah of+    Nothing -> return ()+    Just xs -> do+      forM_ xs foo+      bar+  -- and here it goes+  unless bobla $+    quux

@@ -0,0 +1,9 @@+main = do+  case blah of+    Nothing -> return ()+    Just xs -> do+      forM_ xs foo+      bar+  -- and here it goes+  unless bobla $+    quux

@@ -0,0 +1,7 @@+foo = do+  bar+  -- foo+  baz++  -- foo+  quux

@@ -0,0 +1,7 @@+foo = do+  bar+  -- foo+  baz++  -- foo+  quux

@@ -2,13 +2,18 @@  foo = do   rec a <- b + 5+       let d = c+       b <- a * 5+       something+       c <- a + b   print c   rec something $ do         x <- a         print x+         y <- c         print y

@@ -5,7 +5,6 @@ foo x = let g :: Int -> Int; g = id in ()  let a = b; c = do { foo; bar }; d = baz in b- let a = case True of { True -> foo; False -> bar }; b = foo a in b  foo x = let ?g = id; ?f = g in x

@@ -1,11 +1,6 @@ {-# LANGUAGE PatternSynonyms #-} -module ExportSyntax-  ( A (.., NoA),-    Q (F, ..),-    G (T, .., U),-  )-where+module ExportSyntax (A (.., NoA), Q (F, ..), G (T, .., U)) where  data A = A | B 

@@ -1,2 +1,2 @@-module Foo-  (foo, bar, baz) where+module Foo (+  foo, bar, baz) where

@@ -3,9 +3,6 @@ -}  -- | This is the module's Haddock.-module Main-  ( main,-  )-where+module Main (main) where  main = return ()

@@ -1,5 +1,2 @@ -- | This demonstrates a BUG.-module Foo-  (-  )-where+module Foo () where

@@ -3,4 +3,5 @@ {-# LANGUAGE OverloadedStrings #-}  main = return ()+ -- stack runhaskell

@@ -4,4 +4,5 @@ {-# LANGUAGE OverloadedStrings #-}  main = return ()+ -- stack runhaskell

@@ -1,9 +1,6 @@ module Test   {-# DEPRECATED "This module is unstable" #-}-  ( foo,-    bar,-    baz,-  )+  (foo, bar, baz) where  import Blah

@@ -1,3 +1,5 @@ module Test-  {-# WARNING "This module is very internal" #-}+  {-# WARNING+    "This module is very internal"+    #-} where

@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+-- TODO This extension is probably too dangerous, remove it.+{-# LANGUAGE RecordWildCards #-}+-- Avoid warning produced by TH.+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}++-- | Header comment.+module Foo () where

@@ -0,0 +1,11 @@+-- | Header comment.++{-# LANGUAGE OverloadedStrings #-}++-- Avoid warning produced by TH.+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}++-- TODO This extension is probably too dangerous, remove it.+{-# LANGUAGE RecordWildCards #-}++module Foo () where

@@ -9,7 +9,4 @@ {-# OPTIONS_HADDOCK prune, show-extensions #-}  -- | Header comment.-module Foo-  (-  )-where+module Foo () where

@@ -1,10 +1,9 @@ {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE NoMonoLocalBinds #-}- -- This gap is necessary for stylish Haskell not to re-arrange -- NoMonoLocalBinds before TypeFamilies+{-# LANGUAGE NoMonoLocalBinds #-}  module Foo   ( bar,

@@ -1,5 +1,5 @@ name:                 ormolu-version:              0.0.4.0+version:              0.0.5.0 cabal-version:        1.18 tested-with:          GHC==8.6.5, GHC==8.8.3, GHC==8.10.1 license:              BSD3@@ -82,6 +82,7 @@                     , Ormolu.Parser.CommentStream                     , Ormolu.Parser.Pragma                     , Ormolu.Parser.Result+                    , Ormolu.Parser.Shebang                     , Ormolu.Printer                     , Ormolu.Printer.Combinators                     , Ormolu.Printer.Comments@@ -108,6 +109,10 @@                     , Ormolu.Printer.Meat.Type                     , Ormolu.Printer.Operators                     , Ormolu.Printer.SpanStream+                    , Ormolu.Processing.Common+                    , Ormolu.Processing.Cpp+                    , Ormolu.Processing.Postprocess+                    , Ormolu.Processing.Preprocess                     , Ormolu.Utils   other-modules:      GHC                     , GHC.DynFlags

@@ -6,6 +6,7 @@     ormoluFile,     ormoluStdin,     Config (..),+    RegionIndices (..),     defaultConfig,     DynOption (..),     OrmoluException (..),@@ -42,13 +43,15 @@ ormolu ::   MonadIO m =>   -- | Ormolu configuration-  Config ->+  Config RegionIndices ->   -- | Location of source file   FilePath ->   -- | Input to format   String ->   m Text-ormolu cfg path str = do+ormolu cfgWithIndices path str = do+  let totalLines = length (lines str)+      cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices   (warnings, result0) <-     parseModule' cfg OrmoluParsingFailed path str   when (cfgDebug cfg) $ do@@ -93,7 +96,7 @@ ormoluFile ::   MonadIO m =>   -- | Ormolu configuration-  Config ->+  Config RegionIndices ->   -- | Location of source file   FilePath ->   -- | Resulting rendition@@ -108,7 +111,7 @@ ormoluStdin ::   MonadIO m =>   -- | Ormolu configuration-  Config ->+  Config RegionIndices ->   -- | Resulting rendition   m Text ormoluStdin cfg =@@ -121,7 +124,7 @@ parseModule' ::   MonadIO m =>   -- | Ormolu configuration-  Config ->+  Config RegionDeltas ->   -- | How to obtain 'OrmoluException' to throw when parsing fails   (GHC.SrcSpan -> String -> OrmoluException) ->   -- | File name to use in errors

@@ -1,7 +1,13 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecordWildCards #-}+ -- | Configuration options used by the tool. module Ormolu.Config   ( Config (..),+    RegionIndices (..),+    RegionDeltas (..),     defaultConfig,+    regionIndicesToDeltas,     DynOption (..),     dynOptionToLocatedStr,   )@@ -10,31 +16,66 @@ import qualified SrcLoc as GHC  -- | Ormolu configuration.-data Config = Config+data Config region = Config   { -- | Dynamic options to pass to GHC parser     cfgDynOptions :: ![DynOption],     -- | Do formatting faster but without automatic detection of defects     cfgUnsafe :: !Bool,     -- | Output information useful for debugging     cfgDebug :: !Bool,-    -- | Do not fail if CPP pragma is present (still doesn't handle CPP but-    -- useful for formatting of files that enable the extension without-    -- actually containing CPP macros)-    cfgTolerateCpp :: !Bool,-    -- | Checks if re-formatting the result is idempotent.-    cfgCheckIdempotency :: !Bool+    -- | Checks if re-formatting the result is idempotent+    cfgCheckIdempotency :: !Bool,+    -- | Region selection+    cfgRegion :: !region   }+  deriving (Eq, Show, Functor)++-- | Region selection as the combination of start and end line numbers.+data RegionIndices = RegionIndices+  { -- | Start line of the region to format+    regionStartLine :: !(Maybe Int),+    -- | End line of the region to format+    regionEndLine :: !(Maybe Int)+  }   deriving (Eq, Show) --- | Default 'Config'.-defaultConfig :: Config+-- | Region selection as the length of the literal prefix and the literal+-- suffix.+data RegionDeltas = RegionDeltas+  { -- | Prefix length in number of lines+    regionPrefixLength :: !Int,+    -- | Suffix length in number of lines+    regionSuffixLength :: !Int+  }+  deriving (Eq, Show)++-- | Default @'Config' 'RegionIndices'@.+defaultConfig :: Config RegionIndices defaultConfig =   Config     { cfgDynOptions = [],       cfgUnsafe = False,       cfgDebug = False,-      cfgTolerateCpp = False,-      cfgCheckIdempotency = False+      cfgCheckIdempotency = False,+      cfgRegion =+        RegionIndices+          { regionStartLine = Nothing,+            regionEndLine = Nothing+          }+    }++-- | Convert 'RegionIndices' into 'RegionDeltas'.+regionIndicesToDeltas ::+  -- | Total number of lines in the input+  Int ->+  -- | Region indices+  RegionIndices ->+  -- | Region deltas+  RegionDeltas+regionIndicesToDeltas total RegionIndices {..} =+  RegionDeltas+    { regionPrefixLength = maybe 0 (subtract 1) regionStartLine,+      regionSuffixLength = maybe 0 (total -) regionEndLine     }  -- | A wrapper for dynamic options.

@@ -19,9 +19,7 @@  -- | Ormolu exception representing all cases when Ormolu can fail. data OrmoluException-  = -- | Ormolu does not work with source files that use CPP-    OrmoluCppEnabled FilePath-  | -- | Parsing of original source code failed+  = -- | Parsing of original source code failed     OrmoluParsingFailed GHC.SrcSpan String   | -- | Parsing of formatted source code failed     OrmoluOutputParsingFailed GHC.SrcSpan String@@ -35,13 +33,8 @@  instance Exception OrmoluException where   displayException = \case-    OrmoluCppEnabled path ->-      unlines-        [ "CPP is not supported:",-          withIndent path-        ]     OrmoluParsingFailed s e ->-      showParsingErr "Parsing of source code failed:" s [e]+      showParsingErr "The GHC parser (in Haddock mode) failed:" s [e]     OrmoluOutputParsingFailed s e ->       showParsingErr "Parsing of formatted code failed:" s [e]         ++ "Please, consider reporting the bug.\n"@@ -81,8 +74,8 @@       hPutStrLn stderr (displayException e)       exitWith . ExitFailure $         case e of-          -- Error code 1 is for `error` or `notImplemented`-          OrmoluCppEnabled {} -> 2+          -- Error code 1 is for 'error' or 'notImplemented'+          -- 2 used to be for erroring out on CPP           OrmoluParsingFailed {} -> 3           OrmoluOutputParsingFailed {} -> 4           OrmoluASTDiffers {} -> 5

@@ -12,12 +12,11 @@ import Bag (bagToList) import qualified CmdLineParser as GHC import Control.Exception-import Control.Monad import Control.Monad.IO.Class-import Data.List ((\\), foldl', isPrefixOf, sortOn)+import qualified Data.List as L import qualified Data.List.NonEmpty as NE-import Data.Maybe (catMaybes) import Data.Ord (Down (Down))+import qualified Data.Text as T import DynFlags as GHC import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan) import qualified FastString as GHC@@ -32,6 +31,8 @@ import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Result+import Ormolu.Processing.Preprocess (preprocess)+import Ormolu.Utils (incSpanLine) import qualified Panic as GHC import qualified Parser as GHC import qualified StringBuffer as GHC@@ -40,7 +41,7 @@ parseModule ::   MonadIO m =>   -- | Ormolu configuration-  Config ->+  Config RegionDeltas ->   -- | File name (only for source location annotations)   FilePath ->   -- | Input for parser@@ -49,8 +50,9 @@     ( [GHC.Warn],       Either (SrcSpan, String) ParseResult     )-parseModule Config {..} path input' = liftIO $ do-  let (input, extraComments) = extractCommentsFromLines path input'+parseModule Config {..} path rawInput = liftIO $ do+  let (literalPrefix, input, literalSuffix, extraComments) =+        preprocess path rawInput cfgRegion   -- It's important that 'setDefaultExts' is done before   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an   -- extension that was explicitly disabled in the file.@@ -60,7 +62,7 @@           (setDefaultExts baseDynFlags)       extraOpts = dynOptionToLocatedStr <$> cfgDynOptions   (warnings, dynFlags) <--    parsePragmasIntoDynFlags baseFlags extraOpts path input' >>= \case+    parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case       Right res -> pure res       Left err ->         let loc =@@ -68,8 +70,6 @@                 (mkSrcLoc (GHC.mkFastString path) 1 1)                 (mkSrcLoc (GHC.mkFastString path) 1 1)          in throwIO (OrmoluParsingFailed loc err)-  when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $-    throwIO (OrmoluCppEnabled path)   let useRecordDot =         "record-dot-preprocessor" == pgm_F dynFlags           || any@@ -77,14 +77,17 @@             (pluginModNames dynFlags)       pStateErrors = \pstate ->         let errs = bagToList $ GHC.getErrorMessages pstate dynFlags-         in case sortOn (Down . SeverityOrd . errMsgSeverity) errs of+            fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)+         in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of               [] -> Nothing-              err : _ -> Just (errMsgSpan err, show err) -- Show instance returns a short error message+              err : _ ->+                -- Show instance returns a short error message+                Just (fixupErrSpan (errMsgSpan err), show err)       r = case runParser GHC.parseModule dynFlags path input of         GHC.PFailed pstate ->           case pStateErrors pstate of             Just err -> Left err-            Nothing -> error "invariant violation: PFailed does not have an error"+            Nothing -> error "PFailed does not have an error"         GHC.POk pstate pmod ->           case pStateErrors pstate of             -- Some parse errors (pattern/arrow syntax in expr context)@@ -93,20 +96,32 @@             -- later stages; but we fail in those cases.             Just err -> Left err             Nothing ->-              let (comments, exts, shebangs) = mkCommentStream extraComments pstate+              let (stackHeader, shebangs, pragmas, comments) =+                    mkCommentStream extraComments pstate                in Right                     ParseResult                       { prParsedSource = pmod,                         prAnns = mkAnns pstate,-                        prCommentStream = comments,-                        prExtensions = exts,+                        prStackHeader = stackHeader,                         prShebangs = shebangs,+                        prPragmas = pragmas,+                        prCommentStream = comments,                         prUseRecordDot = useRecordDot,                         prImportQualifiedPost =-                          GHC.xopt ImportQualifiedPost dynFlags+                          GHC.xopt ImportQualifiedPost dynFlags,+                        prLiteralPrefix = T.pack literalPrefix,+                        prLiteralSuffix = T.pack literalSuffix                       }   return (warnings, r) +-- | Enable all language extensions that we think should be enabled by+-- default for ease of use.+setDefaultExts :: DynFlags -> DynFlags+setDefaultExts flags = L.foldl' xopt_set flags autoExts+  where+    autoExts = allExts L.\\ manualExts+    allExts = [minBound .. maxBound]+ -- | Extensions that are not enabled automatically and should be activated -- by user. manualExts :: [Extension]@@ -133,9 +148,6 @@     -- decision of enabling this style is left to the user   ] -------------------------------------------------------------------------------- Helpers (taken from ghc-exactprint)- -- | Run a 'GHC.P' computation. runParser ::   -- | Computation to run@@ -154,67 +166,27 @@     buffer = GHC.stringToStringBuffer input     parseState = GHC.mkPState flags buffer location --- | Transform given lines possibly returning comments extracted from them.--- This handles LINE pragmas and shebangs.-extractCommentsFromLines ::-  -- | File name, just to use in the spans-  FilePath ->-  -- | List of lines from that file-  String ->-  -- | Adjusted lines together with comments extracted from them-  (String, [Located String])-extractCommentsFromLines path =-  unlines' . unzip . zipWith (extractCommentFromLine path) [1 ..] . lines-  where-    unlines' (a, b) = (unlines a, catMaybes b)---- | Transform a given line possibly returning a comment extracted from it.-extractCommentFromLine ::-  -- | File name, just to use in the spans-  FilePath ->-  -- | Line number of this line-  Int ->-  -- | The actual line-  String ->-  -- | Adjusted line and possibly a comment extracted from it-  (String, Maybe (Located String))-extractCommentFromLine path line s-  | "{-# LINE" `isPrefixOf` s =-    let (pragma, res) = getPragma s-        size = length pragma-        ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))-     in (res, Just $ L ss pragma)-  | isShebang s =-    let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length s))-     in ("", Just $ L ss s)-  | otherwise = (s, Nothing)-  where-    mkSrcLoc' = mkSrcLoc (GHC.mkFastString path) line+-- | Wrap GHC's 'Severity' to add 'Ord' instance.+newtype SeverityOrd = SeverityOrd Severity --- | Take a line pragma and output its replacement (where line pragma is--- replaced with spaces) and the contents of the pragma itself.-getPragma ::-  -- | Pragma line to analyze-  String ->-  -- | Contents of the pragma and its replacement line-  (String, String)-getPragma [] = error "Ormolu.Parser.getPragma: input must not be empty"-getPragma s@(x : xs)-  | "#-}" `isPrefixOf` s = ("#-}", "   " ++ drop 3 s)-  | otherwise =-    let (prag, remline) = getPragma xs-     in (x : prag, ' ' : remline)+instance Eq SeverityOrd where+  s1 == s2 = compare s1 s2 == EQ --- | Enable all language extensions that we think should be enabled by--- default for ease of use.-setDefaultExts :: DynFlags -> DynFlags-setDefaultExts flags = foldl' GHC.xopt_set flags autoExts-  where-    autoExts = allExts \\ manualExts-    allExts = [minBound .. maxBound]+instance Ord SeverityOrd where+  compare (SeverityOrd s1) (SeverityOrd s2) =+    compare (f s1) (f s2)+    where+      f :: Severity -> Int+      f SevOutput = 1+      f SevFatal = 2+      f SevInteractive = 3+      f SevDump = 4+      f SevInfo = 5+      f SevWarning = 6+      f SevError = 7  ------------------------------------------------------------------------------- More helpers (taken from HLint)+-- Helpers taken from HLint  parsePragmasIntoDynFlags ::   -- | Pre-set 'DynFlags'@@ -243,25 +215,3 @@         reportErr         (GHC.handleSourceError reportErr act)     reportErr e = return $ Left (show e)--------------------------------------------------------------------------------- Even more helpers---- Wrap GHC's ErrUtils.Severity to add Ord instance-newtype SeverityOrd = SeverityOrd Severity--instance Eq SeverityOrd where-  s1 == s2 = compare s1 s2 == EQ--instance Ord SeverityOrd where-  compare (SeverityOrd s1) (SeverityOrd s2) =-    compare (f s1) (f s2)-    where-      f :: Severity -> Int-      f SevOutput = 1-      f SevFatal = 2-      f SevInteractive = 3-      f SevDump = 4-      f SevInfo = 5-      f SevWarning = 6-      f SevError = 7

@@ -7,7 +7,6 @@   ( CommentStream (..),     Comment (..),     mkCommentStream,-    isShebang,     isPrevHaddock,     isMultilineComment,     showCommentStream,@@ -16,14 +15,14 @@  import Data.Char (isSpace) import Data.Data (Data)-import Data.Either (partitionEithers)-import Data.List (dropWhileEnd, isPrefixOf, sortOn)+import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe) import qualified GHC import qualified Lexer as GHC import Ormolu.Parser.Pragma+import Ormolu.Parser.Shebang import Ormolu.Utils (showOutputable) import SrcLoc @@ -45,37 +44,38 @@   [Located String] ->   -- | Parser state to use for comment extraction   GHC.PState ->-  -- | Comment stream, a set of extracted pragmas, and extracted shebangs-  (CommentStream, [Pragma], [Located String])+  -- | Stack header, shebangs, pragmas, and comment stream+  ( Maybe (RealLocated Comment),+    [Shebang],+    [([RealLocated Comment], Pragma)],+    CommentStream+  ) mkCommentStream extraComments pstate =-  ( CommentStream $-      mkComment <$> sortOn (realSrcSpanStart . getRealSrcSpan) comments,+  ( mstackHeader,+    shebangs,     pragmas,-    shebangs+    CommentStream comments   )   where-    (comments, pragmas) = partitionEithers (partitionComments <$> rawComments)-    rawComments =-      mapMaybe toRealSpan $+    (comments, pragmas) = extractPragmas rawComments1+    (rawComments1, mstackHeader) = extractStackHeader rawComments0+    rawComments0 =+      L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $         otherExtraComments           ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)           ++ concatMap             (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)             (GHC.annotations_comments pstate)-    (shebangs, otherExtraComments) = span (isShebang . unLoc) extraComments---- | Return 'True' if given 'String' is a shebang.-isShebang :: String -> Bool-isShebang str = "#!" `isPrefixOf` str+    (shebangs, otherExtraComments) = extractShebangs extraComments  -- | Test whether a 'Comment' looks like a Haddock following a definition, -- i.e. something starting with @-- ^@. isPrevHaddock :: Comment -> Bool-isPrevHaddock (Comment (x :| _)) = "-- ^" `isPrefixOf` x+isPrevHaddock (Comment (x :| _)) = "-- ^" `L.isPrefixOf` x  -- | Is this comment multiline-style? isMultilineComment :: Comment -> Bool-isMultilineComment (Comment (x :| _)) = "{-" `isPrefixOf` x+isMultilineComment (Comment (x :| _)) = "{-" `L.isPrefixOf` x  -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String@@ -94,7 +94,7 @@ mkComment :: RealLocated String -> RealLocated Comment mkComment (L l s) =   L l . Comment . fmap dropTrailing $-    if "{-" `isPrefixOf` s+    if "{-" `L.isPrefixOf` s       then case NE.nonEmpty (lines s) of         Nothing -> s :| []         Just (x :| xs) ->@@ -106,7 +106,7 @@            in x :| (drop n <$> xs)       else s :| []   where-    dropTrailing = dropWhileEnd isSpace+    dropTrailing = L.dropWhileEnd isSpace     startIndent = srcSpanStartCol l - 1  -- | Get a 'String' from 'GHC.AnnotationComment'.@@ -129,12 +129,32 @@ toRealSpan (L (RealSrcSpan l) a) = Just (L l a) toRealSpan _ = Nothing --- | If a given comment is a pragma, return it in parsed form in 'Right'.--- Otherwise return the original comment unchanged.-partitionComments ::-  RealLocated String ->-  Either (RealLocated String) Pragma-partitionComments input =-  case parsePragma (unRealSrcSpan input) of-    Nothing -> Left input-    Just pragma -> Right pragma+-- | Detect and extract stack header if it is present.+extractStackHeader ::+  [RealLocated String] ->+  ([RealLocated String], Maybe (RealLocated Comment))+extractStackHeader = \case+  [] -> ([], Nothing)+  (x : xs) ->+    let comment = mkComment x+     in if isStackHeader (unRealSrcSpan comment)+          then (xs, Just comment)+          else (x : xs, Nothing)+  where+    isStackHeader (Comment (x :| _)) =+      "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x)++-- | Extract pragmas and their associated comments.+extractPragmas ::+  [RealLocated String] ->+  ([RealLocated Comment], [([RealLocated Comment], Pragma)])+extractPragmas = go id id+  where+    go csSoFar pragmasSoFar = \case+      [] -> (csSoFar [], pragmasSoFar [])+      (x : xs) ->+        case parsePragma (unRealSrcSpan x) of+          Nothing -> go (csSoFar . (mkComment x :)) pragmasSoFar xs+          Just pragma ->+            let combined = (csSoFar [], pragma)+             in go id (pragmasSoFar . (combined :)) xs

@@ -7,10 +7,12 @@   ) where +import Data.Text (Text) import GHC import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma)+import Ormolu.Parser.Shebang (Shebang)  -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult@@ -18,16 +20,22 @@     prParsedSource :: ParsedSource,     -- | Ormolu-specfic representation of annotations     prAnns :: Anns,+    -- | Stack header+    prStackHeader :: Maybe (RealLocated Comment),+    -- | Shebangs found in the input+    prShebangs :: [Shebang],+    -- | Pragmas and the associated comments+    prPragmas :: [([RealLocated Comment], Pragma)],     -- | Comment stream     prCommentStream :: CommentStream,-    -- | Extensions enabled in that module-    prExtensions :: [Pragma],-    -- | Shebangs found in the input-    prShebangs :: [Located String],     -- | Whether or not record dot syntax is enabled     prUseRecordDot :: Bool,     -- | Whether or not ImportQualifiedPost is enabled-    prImportQualifiedPost :: Bool+    prImportQualifiedPost :: Bool,+    -- | Literal prefix+    prLiteralPrefix :: Text,+    -- | Literal suffix+    prLiteralSuffix :: Text   }  -- | Pretty-print a 'ParseResult'.

@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | A module for dealing with shebangs.+module Ormolu.Parser.Shebang+  ( Shebang (..),+    extractShebangs,+    isShebang,+  )+where++import Data.Data (Data)+import qualified Data.List as L+import SrcLoc++-- | A wrapper for a shebang.+newtype Shebang = Shebang (Located String)+  deriving (Eq, Data)++-- | Extract shebangs from the beginning of a comment stream.+extractShebangs :: [Located String] -> ([Shebang], [Located String])+extractShebangs comments = (Shebang <$> shebangs, rest)+  where+    (shebangs, rest) = span (isShebang . unLoc) comments++-- | Return 'True' if given 'String' is a shebang.+isShebang :: String -> Bool+isShebang str = "#!" `L.isPrefixOf` str

@@ -11,6 +11,7 @@ import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Module import Ormolu.Printer.SpanStream+import Ormolu.Processing.Postprocess (postprocess)  -- | Render a module. printModule ::@@ -19,14 +20,19 @@   -- | Resulting rendition   Text printModule ParseResult {..} =-  runR-    ( p_hsModule-        prShebangs-        prExtensions-        prImportQualifiedPost-        prParsedSource-    )-    (mkSpanStream prParsedSource)-    prCommentStream-    prAnns-    prUseRecordDot+  prLiteralPrefix <> region <> prLiteralSuffix+  where+    region =+      postprocess $+        runR+          ( p_hsModule+              prStackHeader+              prShebangs+              prPragmas+              prImportQualifiedPost+              prParsedSource+          )+          (mkSpanStream prParsedSource)+          prCommentStream+          prAnns+          prUseRecordDot

@@ -52,10 +52,12 @@     -- ** Literals     comma, -    -- ** Comments+    -- ** Stateful markers+    SpanMark (..),+    spanMarkSpan,     HaddockStyle (..),-    setLastCommentSpan,-    getLastCommentSpan,+    setSpanMark,+    getSpanMark,   ) where 

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  -- | Helpers for formatting of comments. This is low-level code, use@@ -6,17 +7,15 @@   ( spitPrecedingComments,     spitFollowingComments,     spitRemainingComments,-    spitStackHeader,+    spitCommentNow,+    spitCommentPending,   ) where  import Control.Monad-import Data.Char (isSpace) import Data.Coerce (coerce) import Data.Data (Data)-import Data.List (isPrefixOf) import qualified Data.List.NonEmpty as NE-import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Text as T import Ormolu.Parser.CommentStream import Ormolu.Printer.Internal@@ -35,10 +34,10 @@ spitPrecedingComments ref = do   gotSome <- handleCommentSeries (spitPrecedingComment ref)   when gotSome $ do+    lastMark <- getSpanMark     -- Insert a blank line between the preceding comments and the thing     -- after them if there was a blank line in the input.-    lastSpn <- fmap snd <$> getLastCommentSpan-    when (needsNewlineBefore (getRealSrcSpan ref) lastSpn) newline+    when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline  -- | Output all comments following an element at given location. spitFollowingComments ::@@ -52,17 +51,11 @@  -- | Output all remaining comments in the comment stream. spitRemainingComments :: R ()-spitRemainingComments = void $ handleCommentSeries spitRemainingComment---- | If there is a stack header in the comment stream, print it.-spitStackHeader :: R ()-spitStackHeader = do-  let isStackHeader (Comment (x :| _)) =-        "stack" `isPrefixOf` dropWhile isSpace (drop 2 x)-  mstackHeader <- popComment (isStackHeader . unRealSrcSpan)-  forM_ mstackHeader $ \(L spn x) -> do-    spitCommentNow spn x-    newline+spitRemainingComments = do+  -- Make sure we have a blank a line between the last definition and the+  -- trailing comments.+  newline+  void $ handleCommentSeries spitRemainingComment  ---------------------------------------------------------------------------- -- Single-comment functions@@ -73,14 +66,14 @@   -- | AST element to attach comments to   RealLocated a ->   -- | Location of last comment in the series-  Maybe RealSrcSpan ->+  Maybe SpanMark ->   -- | Are we done?   R Bool-spitPrecedingComment (L ref a) mlastSpn = do+spitPrecedingComment (L ref a) mlastMark = do   let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref   withPoppedComment p $ \l comment -> do     dirtyLine <--      case mlastSpn of+      case mlastMark of         -- When the current line is dirty it means that something that can         -- have comments attached to it is already on the line. To avoid         -- problems with idempotence we cannot output the first comment@@ -89,7 +82,7 @@         -- an extra 'newline' in this case.         Nothing -> isLineDirty -- only for very first preceding comment         Just _ -> return False-    when (dirtyLine || needsNewlineBefore l mlastSpn) newline+    when (dirtyLine || needsNewlineBefore l mlastMark) newline     spitCommentNow l comment     if theSameLinePre l ref && not (isModule a)       then space@@ -102,34 +95,34 @@   -- | AST element to attach comments to   RealLocated a ->   -- | Location of last comment in the series-  Maybe RealSrcSpan ->+  Maybe SpanMark ->   -- | Are we done?   R Bool-spitFollowingComment (L ref a) mlastSpn = do+spitFollowingComment (L ref a) mlastMark = do   mnSpn <- nextEltSpan   -- Get first enclosing span that is not equal to reference span, i.e. it's   -- truly something enclosing the AST element.   meSpn <- getEnclosingSpan (/= ref)-  withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastSpn) $ \l comment ->+  withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->     if theSameLinePost l ref && not (isModule a)       then         if isMultilineComment comment           then space >> spitCommentNow l comment           else spitCommentPending OnTheSameLine l comment       else do-        when (needsNewlineBefore l mlastSpn) $+        when (needsNewlineBefore l mlastMark) $           registerPendingCommentLine OnNextLine ""         spitCommentPending OnNextLine l comment  -- | Output a single remaining comment from the comment stream. spitRemainingComment ::   -- | Location of last comment in the series-  Maybe RealSrcSpan ->+  Maybe SpanMark ->   -- | Are we done?   R Bool-spitRemainingComment mlastSpn =+spitRemainingComment mlastMark =   withPoppedComment (const True) $ \l comment -> do-    when (needsNewlineBefore l mlastSpn) newline+    when (needsNewlineBefore l mlastMark) newline     spitCommentNow l comment     newline @@ -140,13 +133,13 @@ handleCommentSeries ::   -- | Given location of previous comment, output the next comment   -- returning 'True' if we're done-  (Maybe RealSrcSpan -> R Bool) ->+  (Maybe SpanMark -> R Bool) ->   -- | Whether we printed any comments   R Bool handleCommentSeries f = go False   where     go gotSome = do-      done <- getLastCommentSpan >>= f . fmap snd+      done <- getSpanMark >>= f       if done         then return gotSome         else go True@@ -172,13 +165,13 @@   -- | Current comment span   RealSrcSpan ->   -- | Last printed comment span-  Maybe RealSrcSpan ->+  Maybe SpanMark ->   Bool-needsNewlineBefore l mlastSpn =-  case mlastSpn of+needsNewlineBefore l mlastMark =+  case spanMarkSpan <$> mlastMark of     Nothing -> False-    Just lastSpn ->-      srcSpanStartLine l > srcSpanEndLine lastSpn + 1+    Just lastMark ->+      srcSpanStartLine l > srcSpanEndLine lastMark + 1  -- | Is the preceding comment and AST element are on the same line? theSameLinePre ::@@ -209,11 +202,11 @@   -- | Location of enclosing AST element   Maybe RealSrcSpan ->   -- | Location of last comment in the series-  Maybe RealSrcSpan ->+  Maybe SpanMark ->   -- | Comment to test   RealLocated Comment ->   Bool-commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =+commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =   -- A comment follows a AST element if all 4 conditions are satisfied:   goesAfter     && logicallyFollows@@ -255,9 +248,12 @@                        >= abs (startColumn ref - startColumn l)                    )     continuation =-      case mlastSpn of-        Nothing -> False-        Just spn -> srcSpanEndLine spn + 1 == srcSpanStartLine l+      case mlastMark of+        Just (HaddockSpan _ spn) ->+          srcSpanEndLine spn + 1 == srcSpanStartLine l+        Just (CommentSpan spn) ->+          srcSpanEndLine spn + 1 == srcSpanStartLine l+        _ -> False     lastInEnclosing =       case meSpn of         -- When there is no enclosing element, return false@@ -281,7 +277,7 @@     . fmap (txt . T.pack)     . coerce     $ comment-  setLastCommentSpan Nothing spn+  setSpanMark (CommentSpan spn)  -- | Output a 'Comment' at the end of correct line or after it depending on -- 'CommentPosition'. Used for comments that may potentially follow on the@@ -297,4 +293,4 @@     . fmap (registerPendingCommentLine position . T.pack)     . coerce     $ comment-  setLastCommentSpan Nothing spn+  setSpanMark (CommentSpan spn)

@@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} @@ -38,9 +39,13 @@     popComment,     getEnclosingSpan,     withEnclosingSpan,++    -- * Stateful markers+    SpanMark (..),+    spanMarkSpan,     HaddockStyle (..),-    setLastCommentSpan,-    getLastCommentSpan,+    setSpanMark,+    getSpanMark,      -- * Annotations     getAnns,@@ -107,8 +112,8 @@     scDirtyLine :: !Bool,     -- | Whether to output a space before the next output     scRequestedDelimiter :: !RequestedDelimiter,-    -- | Span of last output comment-    scLastCommentSpan :: !(Maybe (Maybe HaddockStyle, RealSrcSpan))+    -- | An auxiliary marker for keeping track of last output element+    scSpanMark :: !(Maybe SpanMark)   }  -- | Make sure next output is delimited by one of the following.@@ -176,7 +181,7 @@           scPendingComments = [],           scDirtyLine = False,           scRequestedDelimiter = VeryBeginning,-          scLastCommentSpan = Nothing+          scSpanMark = Nothing         }  ----------------------------------------------------------------------------@@ -239,11 +244,11 @@           scColumn = scColumn sc + T.length indentedTxt,           scDirtyLine = scDirtyLine sc || dirty,           scRequestedDelimiter = RequestedNothing,-          scLastCommentSpan =+          scSpanMark =             -- If there are pending comments, do not reset last comment             -- location.             if printingComments || (not . null . scPendingComments) sc-              then scLastCommentSpan sc+              then scSpanMark sc               else Nothing         } @@ -463,6 +468,25 @@         { rcEnclosingSpans = spn : rcEnclosingSpans rc         } +----------------------------------------------------------------------------+-- Stateful markers++-- | An auxiliary marker for keeping track of last output element.+data SpanMark+  = -- | Haddock comment+    HaddockSpan HaddockStyle RealSrcSpan+  | -- | Non-haddock comment+    CommentSpan RealSrcSpan+  | -- | Non-comment span+    OtherSpan RealSrcSpan++-- | Project 'RealSrcSpan' from 'SpanMark'.+spanMarkSpan :: SpanMark -> RealSrcSpan+spanMarkSpan = \case+  HaddockSpan _ s -> s+  CommentSpan s -> s+  OtherSpan s -> s+ -- | Haddock string style. data HaddockStyle   = -- | @-- |@@@ -475,20 +499,18 @@     Named String  -- | Set span of last output comment.-setLastCommentSpan ::-  -- | 'HaddockStyle' or 'Nothing' if it's a non-Haddock comment-  Maybe HaddockStyle ->-  -- | Location of last printed comment-  RealSrcSpan ->+setSpanMark ::+  -- | Span mark to set+  SpanMark ->   R ()-setLastCommentSpan mhStyle spn = R . modify $ \sc ->+setSpanMark spnMark = R . modify $ \sc ->   sc-    { scLastCommentSpan = Just (mhStyle, spn)+    { scSpanMark = Just spnMark     }  -- | Get span of last output comment.-getLastCommentSpan :: R (Maybe (Maybe HaddockStyle, RealSrcSpan))-getLastCommentSpan = R (gets scLastCommentSpan)+getSpanMark :: R (Maybe SpanMark)+getSpanMark = R (gets scSpanMark)  ---------------------------------------------------------------------------- -- Annotations

@@ -17,7 +17,6 @@  import Control.Monad import Data.List (isPrefixOf)-import Data.Maybe (isJust) import qualified Data.Text as T import GHC hiding (GhcPs, IE) import Name (nameStableString)@@ -155,7 +154,10 @@   LHsDocString ->   R () p_hsDocString hstyle needsNewline (L l str) = do-  goesAfterComment <- isJust <$> getLastCommentSpan+  goesAfterComment <- getSpanMark >>= \case+    Just (HaddockSpan _ _) -> return True+    Just (CommentSpan _) -> return True+    _ -> return False   -- Make sure the Haddock is separated by a newline from other comments.   when goesAfterComment newline   forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do@@ -174,8 +176,8 @@       -- It's often the case that the comment itself doesn't have a span       -- attached to it and instead its location can be obtained from       -- nearest enclosing span.-      getEnclosingSpan (const True) >>= mapM_ (setLastCommentSpan (Just hstyle))-    RealSrcSpan spn -> setLastCommentSpan (Just hstyle) spn+      getEnclosingSpan (const True) >>= mapM_ (setSpanMark . HaddockSpan hstyle)+    RealSrcSpan spn -> setSpanMark (HaddockSpan hstyle spn)  -- | Print anchor of named doc section. p_hsDocName :: String -> R ()

@@ -65,14 +65,15 @@     renderGroupWithPrev prev curr =       -- We can omit a blank line when the user didn't add one, but we must       -- ensure we always add blank lines around documented declarations-      if or-        [ grouping == Disregard,-          separatedByBlank getLoc prev curr,-          isDocumented prev,-          isDocumented curr-        ]-        then breakpoint : renderGroup curr-        else renderGroup curr+      case grouping of+        Disregard ->+          breakpoint : renderGroup curr+        Respect ->+          if separatedByBlankNE getLoc prev curr+            || isDocumented prev+            || isDocumented curr+            then breakpoint : renderGroup curr+            else renderGroup curr  -- | Is a declaration group documented? isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool@@ -85,7 +86,7 @@ -- | Group relevant declarations together. -- -- Add a declaration to a group iff it is relevant to either the first or--- the last declaration of the group.+-- the preceding declaration in the group. groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)] groupDecls [] = [] groupDecls (l@(L _ DocNext) : xs) =@@ -94,18 +95,12 @@   case groupDecls xs of     [] -> [l :| []]     (x : xs') -> (l <| x) : xs'-groupDecls (lhdr : xs) =-  let -- Pick the first decl as the group header-      hdr = unLoc lhdr-      -- Zip rest of the decls with their previous decl-      zipped = zip (lhdr : xs) xs-      -- Pick decls from the tail if they are relevant to the group header-      -- or the previous decl.-      (grp, rest) = flip span zipped $ \(L _ prev, L _ cur) ->-        let relevantToHdr = groupedDecls hdr cur-            relevantToPrev = groupedDecls prev cur+groupDecls (header : xs) =+  let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->+        let relevantToHdr = groupedDecls header current+            relevantToPrev = groupedDecls previous current          in relevantToHdr || relevantToPrev-   in (lhdr :| map snd grp) : groupDecls (map snd rest)+   in (header :| map snd grp) : groupDecls (map snd rest)  p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R () p_hsDecl style = \case@@ -169,30 +164,37 @@  -- | Determine if these declarations should be grouped together. groupedDecls ::-  HsDecl GhcPs ->-  HsDecl GhcPs ->+  LHsDecl GhcPs ->+  LHsDecl GhcPs ->   Bool-groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'-groupedDecls (TypeSignature ns) (DefaultSignature ns') = ns `intersects` ns'-groupedDecls (DefaultSignature ns) (TypeSignature ns') = ns `intersects` ns'-groupedDecls (DefaultSignature ns) (FunctionBody ns') = ns `intersects` ns'-groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns'-groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns'-groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns-groupedDecls (DataDeclaration n) x-  | Just ns <- isPragma x =-    let f = occNameFS . rdrNameOcc in f n `elem` map f ns-groupedDecls x y | Just ns <- isPragma x, Just ns' <- isPragma y = ns `intersects` ns'-groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'-groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'-groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns-groupedDecls (KindSignature n) (DataDeclaration n') = n == n'-groupedDecls (KindSignature n) (ClassDeclaration n') = n == n'-groupedDecls (KindSignature n) (FamilyDeclaration n') = n == n'--- This looks only at Haddocks, normal comments are handled elsewhere-groupedDecls DocNext _ = True-groupedDecls _ DocPrev = True-groupedDecls _ _ = False+groupedDecls (L l_x x') (L l_y y') =+  case (x', y') of+    (TypeSignature ns, FunctionBody ns') -> ns `intersects` ns'+    (TypeSignature ns, DefaultSignature ns') -> ns `intersects` ns'+    (DefaultSignature ns, TypeSignature ns') -> ns `intersects` ns'+    (DefaultSignature ns, FunctionBody ns') -> ns `intersects` ns'+    (x, FunctionBody ns) | Just ns' <- isPragma x -> ns `intersects` ns'+    (FunctionBody ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'+    (x, DataDeclaration n) | Just ns <- isPragma x -> n `elem` ns+    (DataDeclaration n, x)+      | Just ns <- isPragma x ->+        let f = occNameFS . rdrNameOcc in f n `elem` map f ns+    (x, y)+      | Just ns <- isPragma x,+        Just ns' <- isPragma y ->+        ns `intersects` ns'+    (x, TypeSignature ns) | Just ns' <- isPragma x -> ns `intersects` ns'+    (TypeSignature ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'+    (PatternSignature ns, Pattern n) -> n `elem` ns+    (KindSignature n, DataDeclaration n') -> n == n'+    (KindSignature n, ClassDeclaration n') -> n == n'+    (KindSignature n, FamilyDeclaration n') -> n == n'+    -- Special case for TH splices, we look at locations+    (Splice, Splice) -> not (separatedByBlank id l_x l_y)+    -- This looks only at Haddocks, normal comments are handled elsewhere+    (DocNext, _) -> True+    (_, DocPrev) -> True+    _ -> False  intersects :: Ord a => [a] -> [a] -> Bool intersects a b = go (sort a) (sort b)@@ -216,6 +218,11 @@   AnnValuePragma n -> Just [n]   WarningPragma n -> Just n   _ -> Nothing++-- Declarations that do not refer to names++pattern Splice :: HsDecl GhcPs+pattern Splice <- SpliceD NoExtField (SpliceDecl NoExtField _ _)  -- Declarations referring to a single name 

@@ -345,7 +345,7 @@     txt "do"     newline     inci . located es $-      sitcc . sep newline (located' (sitcc . p_stmt' cmdPlacement p_hsCmd))+      sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement p_hsCmd))   HsCmdWrap {} -> notImplemented "HsCmdWrap"   XCmd x -> noExtCon x @@ -354,6 +354,28 @@   HsCmdTop NoExtField cmd -> located cmd p_hsCmd   XCmdTop x -> noExtCon x +withSpacing :: Data a => (a -> R ()) -> Located a -> R ()+withSpacing f l = located l $ \x -> do+  case getLoc l of+    UnhelpfulSpan _ -> f x+    RealSrcSpan currentSpn -> do+      getSpanMark >>= \case+        -- Spacing before comments will be handled by the code+        -- that prints comments, so we just have to deal with+        -- blank lines between statements here.+        Just (OtherSpan lastSpn) ->+          if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1+            then newline+            else return ()+        _ -> return ()+      f x+      -- In some cases the (f x) expression may insert a new mark. We want+      -- to be careful not to override comment marks.+      getSpanMark >>= \case+        Just (HaddockSpan _ _) -> return ()+        Just (CommentSpan _) -> return ()+        _ -> setSpanMark (OtherSpan currentSpn)+ p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R () p_stmt = p_stmt' exprPlacement p_hsExpr @@ -425,7 +447,7 @@   RecStmt {..} -> do     txt "rec"     space-    sitcc $ sepSemi (located' (p_stmt' placer render)) recS_stmts+    sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts   XStmtLR c -> noExtCon c  gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]@@ -451,19 +473,22 @@           (Left <$> bagToList bag) ++ (Right <$> lsigs)         p_item (Left x) = located x p_valDecl         p_item (Right x) = located x p_sigDecl-        -- Assigns 'False' to the last element, 'True' to the rest.-        markInit :: [a] -> [(Bool, a)]-        markInit [] = []-        markInit [x] = [(False, x)]-        markInit (x : xs) = (True, x) : markInit xs     -- When in a single-line layout, there is a chance that the inner     -- elements will also contain semicolons and they will confuse the     -- parser. so we request braces around every element except the last.     br <- layoutToBraces <$> getLayout     sitcc $       sepSemi-        (\(m, i) -> (if m then br else id) $ p_item i)-        (markInit $ sortOn ssStart items)+        ( \(p, i) ->+            ( case p of+                SinglePos -> id+                FirstPos -> br+                MiddlePos -> br+                LastPos -> id+            )+              (p_item i)+        )+        (attachRelativePos $ sortOn ssStart items)   HsValBinds NoExtField _ -> notImplemented "HsValBinds"   HsIPBinds NoExtField (IPBinds NoExtField xs) ->     -- Second argument of IPBind is always Left before type-checking.@@ -647,7 +672,7 @@           ub <- layoutToBraces <$> getLayout           inci $             sepSemi-              (located' (ub . p_stmt' exprPlacement (p_hsExpr' S)))+              (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))               (unLoc es)         compBody = brackets N $ located es $ \xs -> do           let p_parBody =

@@ -27,9 +27,7 @@ p_moduleWarning :: WarningTxt -> R () p_moduleWarning wtxt = do   let (pragmaText, lits) = warningText wtxt-  switchLayout (getLoc <$> lits)-    $ inci-    $ pragma pragmaText (inci $ p_lits lits)+  inci $ pragma pragmaText $ inci $ p_lits lits  p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () p_topLevelWarning fnames wtxt = do

@@ -13,6 +13,7 @@ import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common+import Ormolu.Utils (RelativePos (..), attachRelativePos)  p_hsmodExports :: [LIE GhcPs] -> R () p_hsmodExports [] = do@@ -22,7 +23,10 @@ p_hsmodExports xs =   parens N . sitcc $ do     layout <- getLayout-    sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)+    sep+      breakpoint+      (\(p, l) -> sitcc (located l (p_lie layout p)))+      (attachRelativePos xs)  p_hsmodImport :: Bool -> ImportDecl GhcPs -> R () p_hsmodImport useQualifiedPost ImportDecl {..} = do@@ -63,12 +67,15 @@         breakpoint         parens N . sitcc $ do           layout <- getLayout-          sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)+          sep+            breakpoint+            (\(p, l) -> sitcc (located l (p_lie layout p)))+            (attachRelativePos xs)     newline p_hsmodImport _ (XImportDecl x) = noExtCon x -p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()-p_lie encLayout (i, totalItems) = \case+p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()+p_lie encLayout relativePos = \case   IEVar NoExtField l1 -> do     located l1 p_ieWrappedName     p_comma@@ -98,7 +105,11 @@     located l1 p_hsmodName     p_comma   IEGroup NoExtField n str -> do-    unless (i == 0) newline+    case relativePos of+      SinglePos -> return ()+      FirstPos -> return ()+      MiddlePos -> newline+      LastPos -> newline     p_hsDocString (Asterisk n) False (noLoc str)   IEDoc NoExtField str ->     p_hsDocString Pipe False (noLoc str)@@ -107,14 +118,10 @@   where     p_comma =       case encLayout of-        SingleLine -> unless (i + 1 == totalItems) comma+        SingleLine ->+          case relativePos of+            SinglePos -> return ()+            FirstPos -> comma+            MiddlePos -> comma+            LastPos -> return ()         MultiLine -> comma---- | Attach positions to 'Located' things in a list.-attachPositions ::-  [Located a] ->-  [Located ((Int, Int), a)]-attachPositions xs =-  let f i (L l x) = L l ((i, n), x)-      n = length xs-   in zipWith f [0 ..] xs

@@ -12,7 +12,9 @@ import qualified Data.Text as T import GHC import Ormolu.Imports+import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma+import Ormolu.Parser.Shebang import Ormolu.Printer.Combinators import Ormolu.Printer.Comments import Ormolu.Printer.Meat.Common@@ -23,28 +25,28 @@  -- | Render a module. p_hsModule ::+  -- | Stack header+  Maybe (RealLocated Comment) ->   -- | Shebangs-  [Located String] ->-  -- | Pragmas-  [Pragma] ->+  [Shebang] ->+  -- | Pragmas and the associated comments+  [([RealLocated Comment], Pragma)] ->   -- | Whether to use postfix qualified imports   Bool ->   -- | AST to print   ParsedSource ->   R ()-p_hsModule shebangs pragmas qualifiedPost (L moduleSpan HsModule {..}) = do-  -- If span of exports in multiline, the whole thing is multiline. This is-  -- especially important because span of module itself always seems to have-  -- length zero, so it's not reliable for layout selection.-  let exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports-      deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage-      spans' = exportSpans ++ deprecSpan ++ [moduleSpan]-  switchLayout spans' $ do-    forM_ shebangs $ \x ->+p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do+  let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage+      exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports+  switchLayout (deprecSpan <> exportSpans) $ do+    forM_ shebangs $ \(Shebang x) ->       located x $ \shebang -> do         txt (T.pack shebang)         newline-    spitStackHeader+    forM_ mstackHeader $ \(L spn comment) -> do+      spitCommentNow spn comment+      newline     newline     p_pragmas pragmas     newline@@ -54,15 +56,16 @@         located hsmodName' $ \name -> do           forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)           p_hsmodName name+        breakpoint         forM_ hsmodDeprecMessage $ \w -> do-          breakpoint           located' p_moduleWarning w+          breakpoint         case hsmodExports of           Nothing -> return ()-          Just hsmodExports' -> do+          Just l -> do+            located l $ \exports -> do+              inci (p_hsmodExports exports)             breakpoint-            inci (p_hsmodExports (unLoc hsmodExports'))-        breakpoint         txt "where"         newline     newline

@@ -8,12 +8,16 @@   ) where +import Control.Monad import Data.Char (isUpper)+import qualified Data.List as L import Data.Maybe (listToMaybe)-import qualified Data.Set as S import qualified Data.Text as T+import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma (..)) import Ormolu.Printer.Combinators+import Ormolu.Printer.Comments+import SrcLoc  -- | Pragma classification. data PragmaTy@@ -42,25 +46,31 @@     Final   deriving (Eq, Ord) -p_pragmas :: [Pragma] -> R ()-p_pragmas ps =-  let prepare = concatMap $ \case-        PragmaLanguage xs ->-          let f x = (Language (classifyLanguagePragma x), x)+-- | Print a collection of 'Pragma's with their associated comments.+p_pragmas :: [([RealLocated Comment], Pragma)] -> R ()+p_pragmas ps = do+  let prepare = L.sortOn snd . L.nub . concatMap analyze+      analyze = \case+        (cs, PragmaLanguage xs) ->+          let f x = (cs, (Language (classifyLanguagePragma x), x))            in f <$> xs-        PragmaOptionsGHC x -> [(OptionsGHC, x)]-        PragmaOptionsHaddock x -> [(OptionsHaddock, x)]-   in mapM_ (uncurry p_pragma) (S.toAscList . S.fromList . prepare $ ps)+        (cs, PragmaOptionsGHC x) -> [(cs, (OptionsGHC, x))]+        (cs, PragmaOptionsHaddock x) -> [(cs, (OptionsHaddock, x))]+  forM_ (prepare ps) $ \(cs, (pragmaTy, x)) ->+    p_pragma cs pragmaTy x -p_pragma :: PragmaTy -> String -> R ()-p_pragma ty c = do+p_pragma :: [RealLocated Comment] -> PragmaTy -> String -> R ()+p_pragma comments ty x = do+  forM_ comments $ \(L l comment) -> do+    spitCommentNow l comment+    newline   txt "{-# "   txt $ case ty of     Language _ -> "LANGUAGE"     OptionsGHC -> "OPTIONS_GHC"     OptionsHaddock -> "OPTIONS_HADDOCK"   space-  txt (T.pack c)+  txt (T.pack x)   txt " #-}"   newline 

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Common definitions for pre- and post- processing.+module Ormolu.Processing.Common+  ( OrmoluState (..),+    startDisabling,+    endDisabling,+  )+where++import Data.String (IsString (..))++-- | Ormolu state.+data OrmoluState+  = -- | Enabled+    OrmoluEnabled+  | -- | Disabled+    OrmoluDisabled+  deriving (Eq, Show)++-- | Marker for the beginning of the region where Ormolu should be disabled.+startDisabling :: IsString s => s+startDisabling = "{- ORMOLU_DISABLING_START"++-- | Marker for the end of the region where Ormolu should be disabled.+endDisabling :: IsString s => s+endDisabling = "ORMOLU_DISABLE_END -}"

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Support for CPP.+module Ormolu.Processing.Cpp+  ( State (..),+    processLine,+    unmaskLine,+  )+where++import Control.Monad+import Data.Char (isSpace)+import qualified Data.List as L+import Data.Maybe (isJust)+import Data.String+import Data.Text (Text)+import qualified Data.Text as T++-- | State of the CPP processor.+data State+  = -- | Outside of CPP directives+    Outside+  | -- | In a conditional expression+    InConditional+  | -- | In a continuation (after @\\@)+    InContinuation+  deriving (Eq, Show)++-- | Automatically mask the line when needed and update the 'State'.+processLine :: String -> State -> (String, State)+processLine line state+  | for "define " = (masked, state')+  | for "include " = (masked, state')+  | for "undef " = (masked, state')+  | for "ifdef " = (masked, InConditional)+  | for "ifndef " = (masked, InConditional)+  | for "if " = (masked, InConditional)+  | for "else" = (masked, InConditional)+  | for "elif" = (masked, InConditional)+  | for "endif" = (masked, state')+  | otherwise =+    case state of+      Outside -> (line, Outside)+      InConditional -> (masked, InConditional)+      InContinuation -> (masked, state')+  where+    for directive = isJust $ do+      s <- dropWhile isSpace <$> L.stripPrefix "#" line+      void (L.stripPrefix directive s)+    masked = maskLine line+    state' =+      if "\\" `L.isSuffixOf` line+        then InContinuation+        else Outside++-- | Mask the given line.+maskLine :: String -> String+maskLine x = maskPrefix ++ x++-- | If the given line is masked, unmask it. Otherwise return the line+-- unchanged.+unmaskLine :: Text -> Text+unmaskLine x =+  case T.stripPrefix maskPrefix (T.stripStart x) of+    Nothing -> x+    Just x' -> x'++-- | Mask prefix for CPP.+maskPrefix :: IsString s => s+maskPrefix = "-- ORMOLU_CPP_MASK"

@@ -0,0 +1,21 @@+-- | Postprocessing for the results of printing.+module Ormolu.Processing.Postprocess+  ( postprocess,+  )+where++import Data.Text (Text)+import qualified Data.Text as T+import Ormolu.Processing.Common+import qualified Ormolu.Processing.Cpp as Cpp++-- | Postprocess output of the formatter.+postprocess :: Text -> Text+postprocess =+  T.unlines+    . fmap Cpp.unmaskLine+    . filter (not . magicComment)+    . T.lines+  where+    magicComment x =+      x == startDisabling || x == endDisabling

@@ -0,0 +1,149 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++-- | Preprocessing for input source code.+module Ormolu.Processing.Preprocess+  ( preprocess,+  )+where++import Control.Monad+import Data.Char (isSpace)+import qualified Data.List as L+import Data.Maybe (isJust)+import Data.Maybe (maybeToList)+import FastString+import Ormolu.Config (RegionDeltas (..))+import Ormolu.Parser.Shebang (isShebang)+import Ormolu.Processing.Common+import qualified Ormolu.Processing.Cpp as Cpp+import SrcLoc++-- | Transform given input possibly returning comments extracted from it.+-- This handles LINE pragmas, CPP, shebangs, and the magic comments for+-- enabling\/disabling of Ormolu.+preprocess ::+  -- | File name, just to use in the spans+  FilePath ->+  -- | Input to process+  String ->+  -- | Region deltas+  RegionDeltas ->+  -- | Literal prefix, pre-processed input, literal suffix, extra comments+  (String, String, String, [Located String])+preprocess path input RegionDeltas {..} =+  go 1 OrmoluEnabled Cpp.Outside id id regionLines+  where+    (prefixLines, otherLines) = splitAt regionPrefixLength (lines input)+    (regionLines, suffixLines) =+      let regionLength = length otherLines - regionSuffixLength+       in splitAt regionLength otherLines+    go !n ormoluState cppState inputSoFar csSoFar = \case+      [] ->+        let input' = unlines (inputSoFar [])+         in ( unlines prefixLines,+              case ormoluState of+                OrmoluEnabled -> input'+                OrmoluDisabled -> input' ++ endDisabling,+              unlines suffixLines,+              csSoFar []+            )+      (x : xs) ->+        let (x', ormoluState', cppState', cs) =+              processLine path n ormoluState cppState x+         in go+              (n + 1)+              ormoluState'+              cppState'+              (inputSoFar . (x' :))+              (csSoFar . (maybeToList cs ++))+              xs++-- | Transform a given line possibly returning a comment extracted from it.+processLine ::+  -- | File name, just to use in the spans+  FilePath ->+  -- | Line number of this line+  Int ->+  -- | Whether Ormolu is currently enabled+  OrmoluState ->+  -- | CPP state+  Cpp.State ->+  -- | The actual line+  String ->+  -- | Adjusted line and possibly a comment extracted from it+  (String, OrmoluState, Cpp.State, Maybe (Located String))+processLine path n ormoluState Cpp.Outside line+  | "{-# LINE" `L.isPrefixOf` line =+    let (pragma, res) = getPragma line+        size = length pragma+        ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))+     in (res, ormoluState, Cpp.Outside, Just (L ss pragma))+  | isOrmoluEnable line =+    case ormoluState of+      OrmoluEnabled ->+        (enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)+      OrmoluDisabled ->+        (endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)+  | isOrmoluDisable line =+    case ormoluState of+      OrmoluEnabled ->+        (disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing)+      OrmoluDisabled ->+        (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)+  | isShebang line =+    let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))+     in ("", ormoluState, Cpp.Outside, Just (L ss line))+  | otherwise =+    let (line', cppState') = Cpp.processLine line Cpp.Outside+     in (line', ormoluState, cppState', Nothing)+  where+    mkSrcLoc' = mkSrcLoc (mkFastString path) n+processLine _ _ ormoluState cppState line =+  let (line', cppState') = Cpp.processLine line cppState+   in (line', ormoluState, cppState', Nothing)++-- | Take a line pragma and output its replacement (where line pragma is+-- replaced with spaces) and the contents of the pragma itself.+getPragma ::+  -- | Pragma line to analyze+  String ->+  -- | Contents of the pragma and its replacement line+  (String, String)+getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"+getPragma s@(x : xs)+  | "#-}" `L.isPrefixOf` s = ("#-}", "   " ++ drop 3 s)+  | otherwise =+    let (prag, remline) = getPragma xs+     in (x : prag, ' ' : remline)++-- | Canonical enable marker.+enableMarker :: String+enableMarker = "{- ORMOLU_ENABLE -}"++-- | Canonical disable marker.+disableMarker :: String+disableMarker = "{- ORMOLU_DISABLE -}"++-- | Return 'True' if the given string is an enabling marker.+isOrmoluEnable :: String -> Bool+isOrmoluEnable = magicComment "ORMOLU_ENABLE"++-- | Return 'True' if the given string is a disabling marker.+isOrmoluDisable :: String -> Bool+isOrmoluDisable = magicComment "ORMOLU_DISABLE"++-- | Construct a function for whitespace-insensitive matching of string.+magicComment ::+  -- | What to expect+  String ->+  -- | String to test+  String ->+  -- | Whether or not the two strings watch+  Bool+magicComment expected s0 = isJust $ do+  s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0+  s2 <- dropWhile isSpace <$> L.stripPrefix expected s1+  s3 <- L.stripPrefix "-}" s2+  guard (all isSpace s3)

@@ -3,14 +3,18 @@  -- | Random utilities used by the code. module Ormolu.Utils-  ( combineSrcSpans',+  ( RelativePos (..),+    attachRelativePos,+    combineSrcSpans',     isModule,     notImplemented,     showOutputable,     splitDocString,     typeArgToType,     unSrcSpan,+    incSpanLine,     separatedByBlank,+    separatedByBlankNE,   ) where @@ -25,6 +29,25 @@ import GHC.DynFlags (baseDynFlags) import qualified Outputable as GHC +-- | Relative positions in a list.+data RelativePos+  = SinglePos+  | FirstPos+  | MiddlePos+  | LastPos+  deriving (Eq, Show)++-- | Attach 'RelativePos'es to elements of a given list.+attachRelativePos :: [a] -> [(RelativePos, a)]+attachRelativePos = \case+  [] -> []+  [x] -> [(SinglePos, x)]+  (x : xs) -> (FirstPos, x) : markLast xs+  where+    markLast [] = []+    markLast [x] = [(LastPos, x)]+    markLast (x : xs) = (MiddlePos, x) : markLast xs+ -- | Combine all source spans from the given list. combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs@@ -78,20 +101,41 @@                 then dropSpace <$> xs                 else xs +-- | Get 'LHsType' out of 'LHsTypeArg'. typeArgToType :: LHsTypeArg p -> LHsType p typeArgToType = \case   HsValArg tm -> tm   HsTypeArg _ ty -> ty   HsArgPar _ -> notImplemented "HsArgPar" +-- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”. unSrcSpan :: SrcSpan -> Maybe RealSrcSpan-unSrcSpan (RealSrcSpan r) = Just r-unSrcSpan (UnhelpfulSpan _) = Nothing+unSrcSpan = \case+  RealSrcSpan r -> Just r+  UnhelpfulSpan _ -> Nothing --- | Do two declaration groups have a blank between them?-separatedByBlank :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool+-- | Increment line number in a 'SrcSpan'.+incSpanLine :: Int -> SrcSpan -> SrcSpan+incSpanLine i = \case+  RealSrcSpan s ->+    let start = realSrcSpanStart s+        end = realSrcSpanEnd s+        incLine x =+          let file = srcLocFile x+              line = srcLocLine x+              col = srcLocCol x+           in mkRealSrcLoc file (line + i) col+     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end))+  UnhelpfulSpan x -> UnhelpfulSpan x++-- | Do two declarations have a blank between them?+separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool separatedByBlank loc a b =   fromMaybe False $ do-    endA <- srcSpanEndLine <$> unSrcSpan (loc $ NE.last a)-    startB <- srcSpanStartLine <$> unSrcSpan (loc $ NE.head b)+    endA <- srcSpanEndLine <$> unSrcSpan (loc a)+    startB <- srcSpanStartLine <$> unSrcSpan (loc b)     pure (startB - endA >= 2)++-- | Do two declaration groups have a blank between them?+separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool+separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)

@@ -1,9 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Ormolu.PrinterSpec-  ( spec,-  )-where+module Ormolu.PrinterSpec (spec) where  import Control.Exception import Control.Monad