mirror of
https://github.com/ilyakooo0/ormolu.git
synced 2024-10-27 03:28:33 +03:00
Allow selection of a region to format
This commit is contained in:
parent
39059761a5
commit
840acd908b
@ -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
|
||||
|
16
app/Main.hs
16
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
|
||||
|
45
default.nix
45
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 \;
|
||||
'';
|
||||
};
|
||||
}
|
||||
|
11
region-tests/expected-result-5-6.hs
Normal file
11
region-tests/expected-result-5-6.hs
Normal file
@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
foo :: Int
|
||||
foo = 5
|
||||
|
||||
bar :: Int -> Int
|
||||
bar = \case
|
||||
0 -> foo
|
||||
x -> x - foo
|
10
region-tests/expected-result-5-7.hs
Normal file
10
region-tests/expected-result-5-7.hs
Normal file
@ -0,0 +1,10 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
foo :: Int
|
||||
foo = 5
|
||||
bar :: Int -> Int
|
||||
bar = \case
|
||||
0 -> foo
|
||||
x -> x - foo
|
11
region-tests/expected-result-8-12.hs
Normal file
11
region-tests/expected-result-8-12.hs
Normal file
@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
foo :: Int
|
||||
foo = 5
|
||||
|
||||
bar :: Int -> Int
|
||||
bar = \case
|
||||
0 -> foo
|
||||
x -> x - foo
|
14
region-tests/expected-result-all.hs
Normal file
14
region-tests/expected-result-all.hs
Normal file
@ -0,0 +1,14 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Main
|
||||
( main,
|
||||
)
|
||||
where
|
||||
|
||||
foo :: Int
|
||||
foo = 5
|
||||
|
||||
bar :: Int -> Int
|
||||
bar = \case
|
||||
0 -> foo
|
||||
x -> x - foo
|
11
region-tests/src.hs
Normal file
11
region-tests/src.hs
Normal file
@ -0,0 +1,11 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
foo :: Int
|
||||
foo = 5
|
||||
|
||||
bar :: Int -> Int
|
||||
bar = \case
|
||||
0 -> foo
|
||||
x -> x - foo
|
@ -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
|
||||
|
@ -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.
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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'.
|
||||
|
@ -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
|
||||
|
@ -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) ->
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user