Allow selection of a region to format

CHANGELOG.md

@@ -15,6 +15,10 @@
 * 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).
+
 ## Ormolu 0.0.4.0
 
 * When given several files to format, Ormolu does not stop on the first

app/Main.hs

@@ -47,7 +47,7 @@ formatOne ::
   -- | Mode of operation
   Mode ->
   -- | Configuration
-  Config ->
+  Config RegionIndices ->
   -- | File to format or stdin as 'Nothing'
   Maybe FilePath ->
   IO ()
@@ -84,7 +84,7 @@ data Opts = Opts
   { -- | 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 +150,7 @@ optsParser =
         help "Haskell source files to format or stdin (default)"
       ]
 
-configParser :: Parser Config
+configParser :: Parser (Config RegionIndices)
 configParser =
   Config
     <$> (fmap (fmap DynOption) . many . strOption . mconcat)
@@ -174,6 +174,16 @@ configParser =
         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

default.nix

@@ -122,4 +122,49 @@ in {
     ];
     in listToAttrs (map (p: nameValuePair p (ormolizedPackages true).${p}) ps)
   );
+  regionTests = pkgs.stdenv.mkDerivation {
+    name = "ormolu-region-tests";
+    src = ./region-tests;
+    buildInputs = [
+      haskellPackages.ormolu
+      pkgs.diffutils
+    ];
+    doCheck = true;
+    buildPhase = ''
+      cp src.hs result-all-implicit.hs
+      ormolu --check-idempotency --mode inplace result-all-implicit.hs
+      cp src.hs result-all-explicit.hs
+      ormolu --check-idempotency --mode inplace --start-line 1 --end-line 12 result-all-explicit.hs
+      cp src.hs result-only-start.hs
+      ormolu --check-idempotency --mode inplace --start-line 1 result-only-start.hs
+      cp src.hs result-only-end.hs
+      ormolu --check-idempotency --mode inplace --end-line 12 result-only-end.hs
+      cp src.hs result-5-6.hs
+      ormolu --check-idempotency --mode inplace --start-line 5 --end-line 6 result-5-6.hs
+      cp src.hs result-5-7.hs
+      ormolu --check-idempotency --mode inplace --start-line 5 --end-line 7 result-5-7.hs
+      cp src.hs result-8-12.hs
+      ormolu --check-idempotency --mode inplace --start-line 8 --end-line 12 result-8-12.hs
+    '';
+    checkPhase = ''
+      echo result-all-implicit.hs
+      diff --color=always expected-result-all.hs result-all-implicit.hs
+      echo result-all-explicit.hs
+      diff --color=always expected-result-all.hs result-all-explicit.hs
+      echo result-only-start.hs
+      diff --color=always expected-result-all.hs result-only-start.hs
+      echo result-only-end.hs
+      diff --color=always expected-result-all.hs result-only-end.hs
+      echo result-5-6.hs
+      diff --color=always expected-result-5-6.hs result-5-6.hs
+      echo result-5-7.hs
+      diff --color=always expected-result-5-7.hs result-5-7.hs
+      echo result-8-12.hs
+      diff --color=always expected-result-8-12.hs result-8-12.hs
+    '';
+    installPhase = ''
+      mkdir "$out"
+      find . -name '*.hs' -exec cp --parents {} $out \;
+    '';
+  };
 }

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

@@ -0,0 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+foo :: Int
+foo = 5
+
+bar :: Int -> Int
+bar = \case
+         0 -> foo
+         x -> x   -   foo

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

@@ -0,0 +1,10 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+foo :: Int
+foo = 5
+bar :: Int -> Int
+bar = \case
+         0 -> foo
+         x -> x   -   foo

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

@@ -0,0 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+foo :: Int
+foo  =  5
+
+bar :: Int -> Int
+bar = \case
+  0 -> foo
+  x -> x - foo

region-tests/expected-result-all.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main
+  ( main,
+  )
+where
+
+foo :: Int
+foo = 5
+
+bar :: Int -> Int
+bar = \case
+  0 -> foo
+  x -> x - foo

region-tests/src.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+foo :: Int
+foo  =  5
+
+bar :: Int -> Int
+bar = \case
+         0 -> foo
+         x -> x   -   foo

src/Ormolu.hs

@@ -6,6 +6,7 @@ module Ormolu
     ormoluFile,
     ormoluStdin,
     Config (..),
+    RegionIndices (..),
     defaultConfig,
     DynOption (..),
     OrmoluException (..),
@@ -42,13 +43,15 @@ import qualified SrcLoc as GHC
 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 @@ ormolu cfg path str = do
 ormoluFile ::
   MonadIO m =>
   -- | Ormolu configuration
-  Config ->
+  Config RegionIndices ->
   -- | Location of source file
   FilePath ->
   -- | Resulting rendition
@@ -108,7 +111,7 @@ ormoluFile cfg path =
 ormoluStdin ::
   MonadIO m =>
   -- | Ormolu configuration
-  Config ->
+  Config RegionIndices ->
   -- | Resulting rendition
   m Text
 ormoluStdin cfg =
@@ -121,7 +124,7 @@ ormoluStdin cfg =
 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

src/Ormolu/Config.hs

@@ -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,26 +16,66 @@ where
 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,
-    -- | 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,
-      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.

src/Ormolu/Parser.hs

@@ -16,6 +16,7 @@ import Control.Monad.IO.Class
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 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
@@ -31,6 +32,7 @@ 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
@@ -39,7 +41,7 @@ import qualified StringBuffer as GHC
 parseModule ::
   MonadIO m =>
   -- | Ormolu configuration
-  Config ->
+  Config RegionDeltas ->
   -- | File name (only for source location annotations)
   FilePath ->
   -- | Input for parser
@@ -48,8 +50,9 @@ parseModule ::
     ( [GHC.Warn],
       Either (SrcSpan, String) ParseResult
     )
-parseModule Config {..} path input' = liftIO $ do
-  let (input, extraComments) = preprocess 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.
@@ -59,7 +62,7 @@ parseModule Config {..} path input' = liftIO $ do
           (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 =
@@ -74,14 +77,17 @@ parseModule Config {..} path input' = liftIO $ do
             (pluginModNames dynFlags)
       pStateErrors = \pstate ->
         let errs = bagToList $ GHC.getErrorMessages pstate dynFlags
+            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)
@@ -102,7 +108,9 @@ parseModule Config {..} path input' = liftIO $ do
                         prCommentStream = comments,
                         prUseRecordDot = useRecordDot,
                         prImportQualifiedPost =
-                          GHC.xopt ImportQualifiedPost dynFlags
+                          GHC.xopt ImportQualifiedPost dynFlags,
+                        prLiteralPrefix = T.pack literalPrefix,
+                        prLiteralSuffix = T.pack literalSuffix
                       }
   return (warnings, r)
 

src/Ormolu/Parser/Result.hs

@@ -7,6 +7,7 @@ module Ormolu.Parser.Result
   )
 where
 
+import Data.Text (Text)
 import GHC
 import Ormolu.Parser.Anns
 import Ormolu.Parser.CommentStream
@@ -30,7 +31,11 @@ data ParseResult = ParseResult
     -- | 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'.

src/Ormolu/Printer.hs

@@ -20,16 +20,19 @@ printModule ::
   -- | Resulting rendition
   Text
 printModule ParseResult {..} =
-  postprocess $
-    runR
-      ( p_hsModule
-          prStackHeader
-          prShebangs
-          prPragmas
-          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

src/Ormolu/Processing/Preprocess.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -- | Preprocessing for input source code.
 module Ormolu.Processing.Preprocess
@@ -13,6 +14,7 @@ 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
@@ -26,16 +28,25 @@ preprocess ::
   FilePath ->
   -- | Input to process
   String ->
-  -- | Adjusted input with comments extracted from it
-  (String, [Located String])
-preprocess path input = go 1 OrmoluEnabled Cpp.Outside id id (lines input)
+  -- | 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 ( case ormoluState of
+         in ( unlines prefixLines,
+              case ormoluState of
                 OrmoluEnabled -> input'
                 OrmoluDisabled -> input' ++ endDisabling,
+              unlines suffixLines,
               csSoFar []
             )
       (x : xs) ->

src/Ormolu/Utils.hs

@@ -12,6 +12,7 @@ module Ormolu.Utils
     splitDocString,
     typeArgToType,
     unSrcSpan,
+    incSpanLine,
     separatedByBlank,
     separatedByBlankNE,
   )
@@ -100,15 +101,32 @@ splitDocString docStr =
                 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
+
+-- | 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