Deal with non-zero indentation in region formatting

Improved region formatting so that indented fragments can also be processed
correctly.

CHANGELOG.md

@@ -25,6 +25,10 @@
 * Fixed the bug when type applications glued to TH splices that followed
   them. [Issue 613](https://github.com/tweag/ormolu/issues/613).
 
+* Improved region formatting so that indented fragments—such as definitions
+  inside of `where` clauses—can be formatted. [Issue
+  572](https://github.com/tweag/ormolu/issues/572).
+
 ## Ormolu 0.1.0.0
 
 * Fixed rendering of type signatures concerning several identifiers. [Issue

default.nix

@@ -132,17 +132,19 @@ in {
       cp src.hs result-all-implicit.hs
       ormolu --check-idempotence --mode inplace result-all-implicit.hs
       cp src.hs result-all-explicit.hs
-      ormolu --check-idempotence --mode inplace --start-line 1 --end-line 13 result-all-explicit.hs
+      ormolu --check-idempotence --mode inplace --start-line 1 --end-line 18 result-all-explicit.hs
       cp src.hs result-only-start.hs
       ormolu --check-idempotence --mode inplace --start-line 1 result-only-start.hs
       cp src.hs result-only-end.hs
-      ormolu --check-idempotence --mode inplace --end-line 13 result-only-end.hs
+      ormolu --check-idempotence --mode inplace --end-line 18 result-only-end.hs
       cp src.hs result-6-7.hs
       ormolu --check-idempotence --mode inplace --start-line 6 --end-line 7 result-6-7.hs
       cp src.hs result-6-8.hs
       ormolu --check-idempotence --mode inplace --start-line 6 --end-line 8 result-6-8.hs
-      cp src.hs result-9-13.hs
+      cp src.hs result-9-12.hs
-      ormolu --check-idempotence --mode inplace --start-line 9 --end-line 13 result-9-13.hs
+      ormolu --check-idempotence --mode inplace --start-line 9 --end-line 12 result-9-12.hs
+      cp src.hs result-17-18.hs
+      ormolu --check-idempotence --mode inplace --start-line 17 --end-line 18 result-17-18.hs
     '';
     checkPhase = ''
       echo result-all-implicit.hs
@@ -157,8 +159,10 @@ in {
       diff --color=always expected-result-6-7.hs result-6-7.hs
       echo result-6-8.hs
       diff --color=always expected-result-6-8.hs result-6-8.hs
-      echo result-9-13.hs
+      echo result-9-12.hs
-      diff --color=always expected-result-9-13.hs result-9-13.hs
+      diff --color=always expected-result-9-12.hs result-9-12.hs
+      echo result-17-18.hs
+      diff --color=always expected-result-17-18.hs result-17-18.hs
     '';
     installPhase = ''
       mkdir "$out"

region-tests/expected-result-17-18.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Foo (
+  foo, bar, baz) where
+
+foo :: Int
+foo  =  5
+
+bar :: Int -> Int
+bar = \case
+         0 -> foo
+         x -> x   -   foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1 + 2

region-tests/expected-result-6-7.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Foo (
-  foo, bar) where
+  foo, bar, baz) where
 
 foo :: Int
 foo = 5
@@ -10,3 +10,8 @@ bar :: Int -> Int
 bar = \case
          0 -> foo
          x -> x   -   foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1   + 2

region-tests/expected-result-6-8.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Foo (
-  foo, bar) where
+  foo, bar, baz) where
 
 foo :: Int
 foo = 5
@@ -9,3 +9,8 @@ bar :: Int -> Int
 bar = \case
          0 -> foo
          x -> x   -   foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1   + 2

region-tests/expected-result-9-12.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Foo (
-  foo, bar) where
+  foo, bar, baz) where
 
 foo :: Int
 foo  =  5
@@ -10,3 +10,8 @@ bar :: Int -> Int
 bar = \case
   0 -> foo
   x -> x - foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1   + 2

region-tests/expected-result-all.hs

@@ -3,6 +3,7 @@
 module Foo
   ( foo,
     bar,
+    baz,
   )
 where
 
@@ -13,3 +14,8 @@ bar :: Int -> Int
 bar = \case
   0 -> foo
   x -> x - foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1 + 2

region-tests/src.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Foo (
-  foo, bar) where
+  foo, bar, baz) where
 
 foo :: Int
 foo  =  5
@@ -10,3 +10,8 @@ bar :: Int -> Int
 bar = \case
          0 -> foo
          x -> x   -   foo
+
+baz :: Int -> Int
+baz = gege
+  where
+    gege = 1   + 2

src/Ormolu/Parser.hs

@@ -32,7 +32,7 @@ import Ormolu.Parser.Anns
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
 import Ormolu.Processing.Preprocess (preprocess)
-import Ormolu.Utils (incSpanLine)
+import Ormolu.Utils (incSpanLine, removeIndentation)
 import qualified Panic as GHC
 import qualified Parser as GHC
 import qualified StringBuffer as GHC
@@ -51,8 +51,9 @@ parseModule ::
       Either (SrcSpan, String) ParseResult
     )
 parseModule Config {..} path rawInput = liftIO $ do
-  let (literalPrefix, input, literalSuffix, extraComments) =
+  let (literalPrefix, indentedInput, literalSuffix, extraComments) =
         preprocess path rawInput cfgRegion
+      (input, indent) = removeIndentation indentedInput
   -- It's important that 'setDefaultExts' is done before
   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an
   -- extension that was explicitly disabled in the file.
@@ -110,7 +111,8 @@ parseModule Config {..} path rawInput = liftIO $ do
                         prImportQualifiedPost =
                           GHC.xopt ImportQualifiedPost dynFlags,
                         prLiteralPrefix = T.pack literalPrefix,
-                        prLiteralSuffix = T.pack literalSuffix
+                        prLiteralSuffix = T.pack literalSuffix,
+                        prIndent = indent
                       }
   return (warnings, r)
 

src/Ormolu/Parser/Result.hs

@@ -35,7 +35,9 @@ data ParseResult = ParseResult
     -- | Literal prefix
     prLiteralPrefix :: Text,
     -- | Literal suffix
-    prLiteralSuffix :: Text
+    prLiteralSuffix :: Text,
+    -- | Indentation level, can be non-zero in case of region formatting
+    prIndent :: Int
   }
 
 -- | Pretty-print a 'ParseResult'.

src/Ormolu/Printer.hs

@@ -23,7 +23,7 @@ printModule ParseResult {..} =
   prLiteralPrefix <> region <> prLiteralSuffix
   where
     region =
-      postprocess $
+      postprocess prIndent $
         runR
           ( p_hsModule
               prStackHeader

src/Ormolu/Processing/Postprocess.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
 
 -- | Postprocessing for the results of printing.
@@ -12,12 +13,19 @@ import Ormolu.Processing.Common
 import qualified Ormolu.Processing.Cpp as Cpp
 
 -- | Postprocess output of the formatter.
-postprocess :: Text -> Text
+postprocess ::
-postprocess =
+  -- | Desired indentation level
+  Int ->
+  -- | Input to process
+  Text ->
+  Text
+postprocess indent =
   T.unlines
+    . fmap indentLine
     . fmap Cpp.unmaskLine
     . filter (not . magicComment)
     . T.lines
   where
     magicComment (T.stripStart -> x) =
       x == startDisabling || x == endDisabling
+    indentLine x = T.replicate indent " " <> x

src/Ormolu/Utils.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Random utilities used by the code.
 module Ormolu.Utils
@@ -15,9 +16,11 @@ module Ormolu.Utils
     separatedByBlank,
     separatedByBlankNE,
     onTheSameLine,
+    removeIndentation,
   )
 where
 
+import Data.Char (isSpace)
 import Data.List (dropWhileEnd)
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty (..))
@@ -139,3 +142,14 @@ separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)
 onTheSameLine :: SrcSpan -> SrcSpan -> Bool
 onTheSameLine a b =
   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))
+
+-- | Remove indentation from a given 'String'. Return the input with
+-- indentation removed and the detected indentation level.
+removeIndentation :: String -> (String, Int)
+removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)
+  where
+    n = minimum (getIndent <$> xs)
+    getIndent y =
+      if all isSpace y
+        then 0
+        else length (takeWhile isSpace y)