diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,29 @@ +## Fourmolu 0.8.0.0 + +* Consolidate `import-export-comma-style` and `diff-friendly-import-export` into a new option `import-export-style` ([#201](https://github.com/fourmolu/fourmolu/pull/207)) +* Accept folders as input ([#213](https://github.com/fourmolu/fourmolu/issues/213)) + +### Upstream changes: + +#### Ormolu 0.5.0.1 + +* Fixed a bug in the diff printing functionality. [Issue + 886](https://github.com/tweag/ormolu/issues/886). + +* Indent closing bracket for list comprehensions in `do` blocks. + [Issue 893](https://github.com/tweag/ormolu/issues/893). + +* Fix `hs-source-dirs: .` resulting in failing to find a `.cabal` file for a + Haskell source file. [Issue 909](https://github.com/tweag/ormolu/issues/909). + +* Comments in closed type family declarations are now indented correctly. + [Issue 913](https://github.com/tweag/ormolu/issues/913). + +* Cache `.cabal` file parsing and processing when given multiple input files in + the same project. This results in dramatic speedups on projects which have + both huge `.cabal` files and a large number of individual modules. [Issue + 897](https://github.com/tweag/ormolu/issues/897). + ## Fourmolu 0.7.0.1 * Fix bad copy/paste where parsing errors for `haddock-style` would mention `CommaStyle` @@ -17,6 +43,8 @@ ``` * Fixed issue with `import-export-comma-style` for multiline import/export elements ([#187](https://github.com/fourmolu/fourmolu/pull/187)) * Multiline haddock comments with consecutive empty newlines will no longer report an "AST differs" error ([#172](https://github.com/fourmolu/fourmolu/issues/172)) + +### Upstream changes: #### Ormolu 0.5.0.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -45,10 +45,9 @@ |----------------------|---------------|-------------| | `indentation` | any integer | Number of spaces to use as indentation | | `comma-style` | `leading`, `trailing` | Where to put the comma in lists, tuples, etc. | -| `import-export-comma-style` | `leading`, `trailing` | Where to put the comma in import/export lists | +| `import-export-style` | `leading`, `trailing`, `diff-friendly` | How to format multiline import/export lists (`diff-friendly` lists have trailing commas but keep the open-parentheses on the same line as the `import` line) | | `indent-wheres` | `true`, `false` | `false` means save space by only half-indenting the `where` keyword | | `record-brace-space` | `true`, `false` | `rec {x = 1}` vs `rec{x = 1}` | -| `diff-friendly-import-export` | `true`, `false` | Make multiline import/export lists as diff-friendly as possible (keeping the open-parentheses on the same line as the `import` line or not) | | `respectful` | `true`, `false` | Whether to respect user-specified newlines, e.g. in import groupings | | `haddock-style` | `multi-line`, `single-line` | Whether multiline haddocks should use `{-` or `--` | | `newlines-between-decls` | any integer | number of newlines between top-level declarations | @@ -65,10 +64,9 @@ ```yaml indentation: 4 comma-style: leading -import-export-comma-style: leading +import-export-style: diff-friendly indent-wheres: false record-brace-space: false -diff-friendly-import-export: true respectful: true haddock-style: multi-line newlines-between-decls: 1 @@ -80,10 +78,9 @@ ```yaml indentation: 2 comma-style: trailing -import-export-comma-style: trailing +import-export-style: trailing indent-wheres: true record-brace-space: true -diff-friendly-import-export: false respectful: false haddock-style: single-line newlines-between-decls: 1 @@ -134,6 +131,11 @@ ```console $ fourmolu --mode inplace $(git ls-files '*.hs') +``` + +Or directly specify a directory (will recursively process all *.hs files) +```console +$ fourmolu -i src ``` To check if files are are already formatted (useful on CI): diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -14,7 +14,7 @@ import Control.Monad import Data.Bool (bool) import Data.Functor.Identity (Identity (..)) -import Data.List (intercalate, sort) +import Data.List (intercalate, isSuffixOf, sort) import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set @@ -38,7 +38,7 @@ ) import Ormolu.Utils.IO import Paths_fourmolu (version) -import System.Directory (getCurrentDirectory) +import System.Directory (doesDirectoryExist, getCurrentDirectory, listDirectory) import System.Exit (ExitCode (..), exitWith) import qualified System.FilePath as FP import System.IO (hPutStrLn, stderr) @@ -61,24 +61,40 @@ optSourceType cfg + getHaskellFiles input = do + isDir <- doesDirectoryExist input + if isDir + then filter (".hs" `isSuffixOf`) <$> listDirectoryRecursive input + else return [input] -- plain file + listDirectoryRecursive fp = fmap concat . mapM (go . (fp FP.)) =<< listDirectory fp + where + go child = do + isDir <- doesDirectoryExist child + if isDir + then listDirectoryRecursive child + else pure [child] + + selectFailure = \case + ExitSuccess -> Nothing + ExitFailure n -> Just n + + formatInputs inputs = do + files <- Set.toAscList . Set.fromList . concat <$> mapM getHaskellFiles inputs + errorCodes <- mapMaybe selectFailure <$> mapM (formatOne' . Just) files + return $ + if null errorCodes + then ExitSuccess + else + ExitFailure $ + if all (== 100) errorCodes + then 100 + else 102 + exitCode <- case optInputFiles of [] -> formatOne' Nothing ["-"] -> formatOne' Nothing - [x] -> formatOne' (Just x) - xs -> do - let selectFailure = \case - ExitSuccess -> Nothing - ExitFailure n -> Just n - errorCodes <- - mapMaybe selectFailure <$> mapM (formatOne' . Just) (sort xs) - return $ - if null errorCodes - then ExitSuccess - else - ExitFailure $ - if all (== 100) errorCodes - then 100 - else 102 + xs -> formatInputs xs + exitWith exitCode -- | Build the full config, by adding 'PrinterOpts' from a file, if found. diff --git a/data/cabal-tests/Bar.hs b/data/cabal-tests/Bar.hs new file mode 100644 --- /dev/null +++ b/data/cabal-tests/Bar.hs @@ -0,0 +1,3 @@ +module Foo where + +import Data.List qualified as List diff --git a/data/cabal-tests/Foo.hs b/data/cabal-tests/Foo.hs new file mode 100644 --- /dev/null +++ b/data/cabal-tests/Foo.hs @@ -0,0 +1,3 @@ +module Foo where + +import Data.List qualified as List diff --git a/data/cabal-tests/test.cabal b/data/cabal-tests/test.cabal new file mode 100644 --- /dev/null +++ b/data/cabal-tests/test.cabal @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: test +version: 0 + +library + exposed-modules: Foo + hs-source-dirs: . + default-extensions: ImportQualifiedPost + +executable app + main-is: Main + other-modules: Bar + default-extensions: ImportQualifiedPost diff --git a/data/diff-tests/inputs/applicative-after.hs b/data/diff-tests/inputs/applicative-after.hs new file mode 100644 --- /dev/null +++ b/data/diff-tests/inputs/applicative-after.hs @@ -0,0 +1,8 @@ +testPermParser :: Permutation Parser String +testPermParser = + f + <$> toPermutationWithDefault 'x' (char 'a') + <*> toPermutationWithDefault 'y' (char 'b') + <*> toPermutationWithDefault 'z' (char 'c') + where + f a b c = [a, b, c] diff --git a/data/diff-tests/inputs/applicative-before.hs b/data/diff-tests/inputs/applicative-before.hs new file mode 100644 --- /dev/null +++ b/data/diff-tests/inputs/applicative-before.hs @@ -0,0 +1,7 @@ +testPermParser :: Permutation Parser String +testPermParser = + f <$> toPermutationWithDefault 'x' (char 'a') + <*> toPermutationWithDefault 'y' (char 'b') + <*> toPermutationWithDefault 'z' (char 'c') + where + f a b c = [a, b, c] diff --git a/data/diff-tests/inputs/longer-v2.hs b/data/diff-tests/inputs/longer-v2.hs new file mode 100644 --- /dev/null +++ b/data/diff-tests/inputs/longer-v2.hs @@ -0,0 +1,16 @@ +module Main (foo) where + +a +b +c + +main :: IO () +main = return () + +d +e +f +g + +foo :: Int +foo = 6 diff --git a/data/diff-tests/inputs/longer.hs b/data/diff-tests/inputs/longer.hs new file mode 100644 --- /dev/null +++ b/data/diff-tests/inputs/longer.hs @@ -0,0 +1,16 @@ +module Main (main) where + +a +b +c + +main :: IO () +main = return () + +d +e +f +g + +foo :: Int +foo = 5 diff --git a/data/diff-tests/outputs/no-preceding.txt b/data/diff-tests/outputs/no-preceding.txt --- a/data/diff-tests/outputs/no-preceding.txt +++ b/data/diff-tests/outputs/no-preceding.txt @@ -1,6 +1,7 @@ TEST -@@ -1,3 +1,3 @@ +@@ -1,4 +1,4 @@ - module Main (foo) where + module Main (main) where + main :: IO () main = return () diff --git a/data/diff-tests/outputs/simple-hunk.txt b/data/diff-tests/outputs/simple-hunk.txt --- a/data/diff-tests/outputs/simple-hunk.txt +++ b/data/diff-tests/outputs/simple-hunk.txt @@ -1,9 +1,10 @@ TEST -@@ -1,6 +1,6 @@ +@@ -1,7 +1,7 @@ module Main (main) where main :: IO () - main = return () + main = pure () + foo :: Int foo = 5 diff --git a/data/diff-tests/outputs/trimming-trailing-both-eof.txt b/data/diff-tests/outputs/trimming-trailing-both-eof.txt new file mode 100644 --- /dev/null +++ b/data/diff-tests/outputs/trimming-trailing-both-eof.txt @@ -0,0 +1,10 @@ +TEST +@@ -1,6 +1,7 @@ + testPermParser :: Permutation Parser String + testPermParser = +- f <$> toPermutationWithDefault 'x' (char 'a') ++ f ++ <$> toPermutationWithDefault 'x' (char 'a') + <*> toPermutationWithDefault 'y' (char 'b') + <*> toPermutationWithDefault 'z' (char 'c') + where diff --git a/data/diff-tests/outputs/trimming-trailing-both-out-of-margin.txt b/data/diff-tests/outputs/trimming-trailing-both-out-of-margin.txt new file mode 100644 --- /dev/null +++ b/data/diff-tests/outputs/trimming-trailing-both-out-of-margin.txt @@ -0,0 +1,13 @@ +TEST +@@ -1,4 +1,4 @@ +- module Main (main) where ++ module Main (foo) where + + a + b +@@ -13,4 +13,4 @@ + g + + foo :: Int +- foo = 5 ++ foo = 6 diff --git a/data/examples/declaration/type-families/closed-type-family/with-comments-four-out.hs b/data/examples/declaration/type-families/closed-type-family/with-comments-four-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/type-families/closed-type-family/with-comments-four-out.hs @@ -0,0 +1,10 @@ +type family LT a b where + -- 0 + LT 0 _ = True + -- 1 + LT 1 0 = False + LT 1 _ = True + -- 2 + LT 2 0 = False + LT 2 1 = False + LT 2 _ = True diff --git a/data/examples/declaration/type-families/closed-type-family/with-comments-out.hs b/data/examples/declaration/type-families/closed-type-family/with-comments-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/type-families/closed-type-family/with-comments-out.hs @@ -0,0 +1,10 @@ +type family LT a b where + -- 0 + LT 0 _ = True + -- 1 + LT 1 0 = False + LT 1 _ = True + -- 2 + LT 2 0 = False + LT 2 1 = False + LT 2 _ = True diff --git a/data/examples/declaration/type-families/closed-type-family/with-comments.hs b/data/examples/declaration/type-families/closed-type-family/with-comments.hs new file mode 100644 --- /dev/null +++ b/data/examples/declaration/type-families/closed-type-family/with-comments.hs @@ -0,0 +1,12 @@ +type family LT a b where + -- 0 + LT 0 _ = True + + -- 1 + LT 1 0 = False + LT 1 _ = True + + -- 2 + LT 2 0 = False + LT 2 1 = False + LT 2 _ = True diff --git a/data/examples/declaration/value/function/list-comprehensions-four-out.hs b/data/examples/declaration/value/function/list-comprehensions-four-out.hs --- a/data/examples/declaration/value/function/list-comprehensions-four-out.hs +++ b/data/examples/declaration/value/function/list-comprehensions-four-out.hs @@ -22,3 +22,8 @@ , d ] ] + +a = do + [ c + | c <- d + ] diff --git a/data/examples/declaration/value/function/list-comprehensions-out.hs b/data/examples/declaration/value/function/list-comprehensions-out.hs --- a/data/examples/declaration/value/function/list-comprehensions-out.hs +++ b/data/examples/declaration/value/function/list-comprehensions-out.hs @@ -22,3 +22,8 @@ d ] ] + +a = do + [ c + | c <- d + ] diff --git a/data/examples/declaration/value/function/list-comprehensions.hs b/data/examples/declaration/value/function/list-comprehensions.hs --- a/data/examples/declaration/value/function/list-comprehensions.hs +++ b/data/examples/declaration/value/function/list-comprehensions.hs @@ -20,3 +20,7 @@ c, d ] ] + +a = do + [ c + | c <- d ] diff --git a/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs @@ -0,0 +1,32 @@ +module Foo ( + foo, + + -- * Something + bar, + -- | A multiline + -- comment here + baz, + + -- * Another thing + MyClass ( + class1, + class2 + ), +) where + +import qualified MegaModule as M ( + Either, + Maybe (Just, Nothing), + MaybeT (..), + Monad ( + return, + (>>), + (>>=) + ), + MonadBaseControl, + join, + liftIO, + void, + (<<<), + (>>>), + ) diff --git a/data/fourmolu/import-export/output-ImportExportLeading.hs b/data/fourmolu/import-export/output-ImportExportLeading.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/import-export/output-ImportExportLeading.hs @@ -0,0 +1,33 @@ +module Foo + ( foo + + -- * Something + , bar + -- | A multiline + -- comment here + , baz + + -- * Another thing + , MyClass + ( class1 + , class2 + ) + ) +where + +import qualified MegaModule as M + ( Either + , Maybe (Just, Nothing) + , MaybeT (..) + , Monad + ( return + , (>>) + , (>>=) + ) + , MonadBaseControl + , join + , liftIO + , void + , (<<<) + , (>>>) + ) diff --git a/data/fourmolu/import-export/output-ImportExportTrailing.hs b/data/fourmolu/import-export/output-ImportExportTrailing.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/import-export/output-ImportExportTrailing.hs @@ -0,0 +1,33 @@ +module Foo + ( foo, + + -- * Something + bar, + -- | A multiline + -- comment here + baz, + + -- * Another thing + MyClass + ( class1, + class2 + ), + ) +where + +import qualified MegaModule as M + ( Either, + Maybe (Just, Nothing), + MaybeT (..), + Monad + ( return, + (>>), + (>>=) + ), + MonadBaseControl, + join, + liftIO, + void, + (<<<), + (>>>), + ) diff --git a/data/fourmolu/import-export/output-Leading-diff_friendly.hs b/data/fourmolu/import-export/output-Leading-diff_friendly.hs deleted file mode 100644 --- a/data/fourmolu/import-export/output-Leading-diff_friendly.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Foo ( - foo - - -- * Something - , bar - -- | A multiline - -- comment here - , baz - - -- * Another thing - , MyClass ( - class1 - , class2 - ) -) where - -import qualified MegaModule as M ( - Either - , Maybe (Just, Nothing) - , MaybeT (..) - , Monad ( - return - , (>>) - , (>>=) - ) - , MonadBaseControl - , join - , liftIO - , void - , (<<<) - , (>>>) - ) diff --git a/data/fourmolu/import-export/output-Leading.hs b/data/fourmolu/import-export/output-Leading.hs deleted file mode 100644 --- a/data/fourmolu/import-export/output-Leading.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Foo - ( foo - - -- * Something - , bar - -- | A multiline - -- comment here - , baz - - -- * Another thing - , MyClass - ( class1 - , class2 - ) - ) -where - -import qualified MegaModule as M - ( Either - , Maybe (Just, Nothing) - , MaybeT (..) - , Monad - ( return - , (>>) - , (>>=) - ) - , MonadBaseControl - , join - , liftIO - , void - , (<<<) - , (>>>) - ) diff --git a/data/fourmolu/import-export/output-Trailing-diff_friendly.hs b/data/fourmolu/import-export/output-Trailing-diff_friendly.hs deleted file mode 100644 --- a/data/fourmolu/import-export/output-Trailing-diff_friendly.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Foo ( - foo, - - -- * Something - bar, - -- | A multiline - -- comment here - baz, - - -- * Another thing - MyClass ( - class1, - class2 - ), -) where - -import qualified MegaModule as M ( - Either, - Maybe (Just, Nothing), - MaybeT (..), - Monad ( - return, - (>>), - (>>=) - ), - MonadBaseControl, - join, - liftIO, - void, - (<<<), - (>>>), - ) diff --git a/data/fourmolu/import-export/output-Trailing.hs b/data/fourmolu/import-export/output-Trailing.hs deleted file mode 100644 --- a/data/fourmolu/import-export/output-Trailing.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Foo - ( foo, - - -- * Something - bar, - -- | A multiline - -- comment here - baz, - - -- * Another thing - MyClass - ( class1, - class2 - ), - ) -where - -import qualified MegaModule as M - ( Either, - Maybe (Just, Nothing), - MaybeT (..), - Monad - ( return, - (>>), - (>>=) - ), - MonadBaseControl, - join, - liftIO, - void, - (<<<), - (>>>), - ) diff --git a/fourmolu.cabal b/fourmolu.cabal --- a/fourmolu.cabal +++ b/fourmolu.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: fourmolu -version: 0.7.0.1 +version: 0.8.0.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: @@ -17,6 +17,7 @@ extra-source-files: data/**/*.hs data/**/*.txt + data/**/*.cabal extract-hackage-info/hackage-info.json -- needed for integration tests fixity-tests/*.hs diff --git a/fourmolu.yaml b/fourmolu.yaml --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -1,10 +1,9 @@ # Options should imitate Ormolu's style indentation: 2 comma-style: trailing -import-export-comma-style: trailing +import-export-style: trailing indent-wheres: true record-brace-space: true -diff-friendly-import-export: false respectful: false haddock-style: single-line newlines-between-decls: 1 diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs --- a/src/Ormolu/Config.hs +++ b/src/Ormolu/Config.hs @@ -34,6 +34,7 @@ fillMissingPrinterOpts, CommaStyle (..), HaddockPrintStyle (..), + ImportExportStyle (..), -- ** Loading Fourmolu configuration loadConfigFile, @@ -217,10 +218,9 @@ overFieldsM f $(unpackFieldsWithSuffix 'PrinterOpts "0") = do poIndentation <- f poIndentation0 poCommaStyle <- f poCommaStyle0 - poImportExportCommaStyle <- f poImportExportCommaStyle0 + poImportExportStyle <- f poImportExportStyle0 poIndentWheres <- f poIndentWheres0 poRecordBraceSpace <- f poRecordBraceSpace0 - poDiffFriendlyImportExport <- f poDiffFriendlyImportExport0 poRespectful <- f poRespectful0 poHaddockStyle <- f poHaddockStyle0 poNewlinesBetweenDecls <- f poNewlinesBetweenDecls0 @@ -279,16 +279,13 @@ (showAllValues commaStyleMap), metaDefault = Leading }, - poImportExportCommaStyle = + poImportExportStyle = PrinterOptsFieldMeta - { metaName = "import-export-comma-style", - metaGetField = poImportExportCommaStyle, + { metaName = "import-export-style", + metaGetField = poImportExportStyle, metaPlaceholder = "STYLE", - metaHelp = - printf - "How to place commas in multi-line import and export lists (choices: %s)" - (showAllValues commaStyleMap), - metaDefault = Trailing + metaHelp = "Styling of import/export lists", + metaDefault = ImportExportDiffFriendly }, poIndentWheres = PrinterOptsFieldMeta @@ -310,18 +307,6 @@ metaHelp = "Whether to leave a space before an opening record brace", metaDefault = False }, - poDiffFriendlyImportExport = - PrinterOptsFieldMeta - { metaName = "diff-friendly-import-export", - metaGetField = poDiffFriendlyImportExport, - metaPlaceholder = "BOOL", - metaHelp = - unwords - [ "Whether to make use of extra commas in import/export lists", - "(as opposed to Ormolu's style)" - ], - metaDefault = True - }, poRespectful = PrinterOptsFieldMeta { metaName = "respectful", @@ -392,6 +377,15 @@ ] ) +importExportStyleMap :: BijectiveMap ImportExportStyle +importExportStyleMap = + $( mkBijectiveMap + [ ('ImportExportLeading, "leading"), + ('ImportExportTrailing, "trailing"), + ('ImportExportDiffFriendly, "diff-friendly") + ] + ) + instance PrinterOptsFieldType CommaStyle where parseJSON = parseJSONWith commaStyleMap "CommaStyle" parseText = parseTextWith commaStyleMap @@ -401,6 +395,11 @@ parseJSON = parseJSONWith haddockPrintStyleMap "HaddockPrintStyle" parseText = parseTextWith haddockPrintStyleMap showText = show . showTextWith haddockPrintStyleMap + +instance PrinterOptsFieldType ImportExportStyle where + parseJSON = parseJSONWith importExportStyleMap "ImportExportStyle" + parseText = parseTextWith importExportStyleMap + showText = show . showTextWith importExportStyleMap ---------------------------------------------------------------------------- -- BijectiveMap helpers diff --git a/src/Ormolu/Config/TH.hs b/src/Ormolu/Config/TH.hs --- a/src/Ormolu/Config/TH.hs +++ b/src/Ormolu/Config/TH.hs @@ -15,7 +15,8 @@ ) where -import Control.Monad (forM, (>=>)) +import Control.Monad (forM, when, (>=>)) +import Data.Containers.ListUtils (nubOrd) import Data.List (intercalate, nub) import Language.Haskell.TH import Language.Haskell.TH.Syntax (lift) @@ -69,6 +70,7 @@ -- * all Names in given list refer to a constructor of type `a` -- * all Names in given list refer to a 0-arity constructor -- * all constructors in type `a` are accounted for. +-- * each constructor in type `a` must be provided only once. mkBijectiveMap :: [(Name, String)] -> Q Exp mkBijectiveMap mapping = do let (conNames, allOptions) = unzip mapping @@ -103,6 +105,10 @@ case filter (`notElem` conNames) (concatMap getConstructorNames allConsInType) of [] -> return () missing -> fail $ "Missing constructors: " ++ show missing + + -- check for duplicate constructors + when (nubOrd conNames /= conNames) $ + fail "mkBijectiveMap requires each constructor to be provided only once" unknown <- newName "unknown" let parser = diff --git a/src/Ormolu/Config/Types.hs b/src/Ormolu/Config/Types.hs --- a/src/Ormolu/Config/Types.hs +++ b/src/Ormolu/Config/Types.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DeriveGeneric #-} --- | This module only defines PrinterOpts, needed to be separate because of --- Template Haskell staging restrictions. +-- | This module defines PrinterOpts and related types module Ormolu.Config.Types ( PrinterOpts (..), CommaStyle (..), HaddockPrintStyle (..), + ImportExportStyle (..), ) where @@ -17,14 +17,12 @@ poIndentation :: f Int, -- | Whether to place commas at start or end of lines poCommaStyle :: f CommaStyle, - -- | Whether to place commas at start or end of import-export lines - poImportExportCommaStyle :: f CommaStyle, + -- | Styling of import/export lists + poImportExportStyle :: f ImportExportStyle, -- | Whether to indent `where` blocks poIndentWheres :: f Bool, -- | Leave space before opening record brace poRecordBraceSpace :: f Bool, - -- | Trailing commas with parentheses on separate lines - poDiffFriendlyImportExport :: f Bool, -- | Be less opinionated about spaces/newlines etc. poRespectful :: f Bool, -- | How to print doc comments @@ -42,4 +40,10 @@ data HaddockPrintStyle = HaddockSingleLine | HaddockMultiLine + deriving (Eq, Show, Enum, Bounded) + +data ImportExportStyle + = ImportExportLeading + | ImportExportTrailing + | ImportExportDiffFriendly deriving (Eq, Show, Enum, Bounded) diff --git a/src/Ormolu/Diff/Text.hs b/src/Ormolu/Diff/Text.hs --- a/src/Ormolu/Diff/Text.hs +++ b/src/Ormolu/Diff/Text.hs @@ -38,10 +38,7 @@ -- whole diff will be displayed. textDiffSelectedLines :: IntSet } - deriving (Eq) - -instance Show TextDiff where - show (TextDiff path _ _) = "TextDiff " ++ show path ++ " _ _" + deriving (Eq, Show) -- | List of lines tagged by 'D.Both', 'D.First', or 'D.Second'. type DiffList = [D.Diff [Text]] @@ -57,6 +54,7 @@ hunkSecondLength :: Int, hunkDiff :: DiffList } + deriving (Show) ---------------------------------------------------------------------------- -- API @@ -211,8 +209,8 @@ [] -> if gotChanges then - let p = reverse (take margin bothHistory) - currentAcc' = addBothAfter p currentAcc + let currentAcc' = addBothAfter p currentAcc + p = take margin (reverse bothHistory) in case formHunk (currentAcc' []) of Nothing -> hunksAcc [] Just hunk -> hunksAcc [hunk] @@ -235,12 +233,12 @@ piece -> if gotChanges then - let p = reverse bothHistory - currentAcc' = currentAcc . addBothBefore p (piece :) + let currentAcc' = currentAcc . addBothBefore p (piece :) + p = reverse bothHistory in go 0 True hunksAcc currentAcc' [] xs else - let p = reverse (take margin bothHistory) - currentAcc' = addBothBefore p (piece :) + let currentAcc' = addBothBefore p (piece :) + p = reverse (take margin bothHistory) in go 0 True hunksAcc currentAcc' [] xs addBothBefore [] acc = acc addBothBefore p acc = (D.Both p p :) . acc diff --git a/src/Ormolu/Printer/Combinators.hs b/src/Ormolu/Printer/Combinators.hs --- a/src/Ormolu/Printer/Combinators.hs +++ b/src/Ormolu/Printer/Combinators.hs @@ -321,7 +321,11 @@ -- | Delimiting combination with 'comma' for import-export lists. -- To be used with `sep`. commaDelImportExport :: R () -commaDelImportExport = getPrinterOpt poImportExportCommaStyle >>= commaDel' +commaDelImportExport = + getPrinterOpt poImportExportStyle >>= \case + ImportExportLeading -> commaDel' Leading + ImportExportTrailing -> commaDel' Trailing + ImportExportDiffFriendly -> commaDel' Trailing commaDel' :: CommaStyle -> R () commaDel' = \case diff --git a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs --- a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +++ b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs @@ -55,7 +55,7 @@ txt ".." Just eqs -> do newline - sep newline (located' (inci . p_tyFamInstEqn)) eqs + inci (sep newline (located' p_tyFamInstEqn) eqs) p_familyResultSigL :: Located (FamilyResultSig GhcPs) -> diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -751,7 +751,7 @@ forM_ moduleName $ \m -> atom m *> txt "." txt header p_stmts exprPlacement (p_hsExpr' S) es - compBody = brackets N . located es $ \xs -> do + compBody = brackets s . located es $ \xs -> do let p_parBody = sep (breakpoint >> txt "|" >> space) diff --git a/src/Ormolu/Printer/Meat/ImportExport.hs b/src/Ormolu/Printer/Meat/ImportExport.hs --- a/src/Ormolu/Printer/Meat/ImportExport.hs +++ b/src/Ormolu/Printer/Meat/ImportExport.hs @@ -16,13 +16,11 @@ import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc import GHC.Unit.Types -import Ormolu.Config (CommaStyle (..), PrinterOpts (poImportExportCommaStyle), poDiffFriendlyImportExport) +import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Utils (RelativePos (..), attachRelativePos) -{- HLINT ignore "Use camelCase" -} - p_hsmodExports :: [LIE GhcPs] -> R () p_hsmodExports [] = do txt "(" @@ -132,7 +130,7 @@ LastPos -> void m FirstAfterDocPos -> m >> comma MultiLine -> do - commaStyle <- getPrinterOpt poImportExportCommaStyle + commaStyle <- getCommaStyle case commaStyle of Leading -> case relativePos of @@ -142,7 +140,7 @@ _ -> comma >> space >> m Trailing -> m >> comma indentDoc m = do - commaStyle <- getPrinterOpt poImportExportCommaStyle + commaStyle <- getCommaStyle case commaStyle of Trailing -> m Leading -> @@ -181,13 +179,13 @@ -- | Surround given entity by parentheses @(@ and @)@. parens' :: Bool -> R () -> R () parens' topLevelImport m = - getPrinterOpt poDiffFriendlyImportExport >>= \case - True -> do + getPrinterOpt poImportExportStyle >>= \case + ImportExportDiffFriendly -> do txt "(" breakpoint' sitcc body vlayout (txt ")") (inciByFrac (-1) trailingParen) - False -> sitcc $ do + _ -> sitcc $ do txt "(" body txt ")" @@ -195,7 +193,7 @@ body = vlayout singleLine multiLine singleLine = m multiLine = do - commaStyle <- getPrinterOpt poImportExportCommaStyle + commaStyle <- getCommaStyle case commaStyle of -- On leading commas, list elements are inline with the enclosing parentheses Leading -> do @@ -209,8 +207,15 @@ newline trailingParen = if topLevelImport then txt " )" else txt ")" +getCommaStyle :: R CommaStyle +getCommaStyle = + getPrinterOpt poImportExportStyle >>= \case + ImportExportLeading -> pure Leading + ImportExportTrailing -> pure Trailing + ImportExportDiffFriendly -> pure Trailing + breakIfNotDiffFriendly :: R () breakIfNotDiffFriendly = - getPrinterOpt poDiffFriendlyImportExport >>= \case - True -> space - False -> breakpoint + getPrinterOpt poImportExportStyle >>= \case + ImportExportDiffFriendly -> space + _ -> breakpoint diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs --- a/src/Ormolu/Printer/Meat/Module.hs +++ b/src/Ormolu/Printer/Meat/Module.hs @@ -55,7 +55,7 @@ breakIfNotDiffFriendly -- This works around an awkward idempotency bug with deprecation messages. - diffFriendly <- getPrinterOpt poDiffFriendlyImportExport + diffFriendly <- (==) ImportExportDiffFriendly <$> getPrinterOpt poImportExportStyle when (diffFriendly && not (null hsmodDeprecMessage)) newline case hsmodExports of diff --git a/src/Ormolu/Utils/Cabal.hs b/src/Ormolu/Utils/Cabal.hs --- a/src/Ormolu/Utils/Cabal.hs +++ b/src/Ormolu/Utils/Cabal.hs @@ -18,6 +18,7 @@ import Control.Exception import Control.Monad.IO.Class import qualified Data.ByteString as B +import Data.IORef import Data.Map.Lazy (Map) import qualified Data.Map.Lazy as M import Data.Maybe (maybeToList) @@ -35,6 +36,7 @@ import System.FilePath import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError) +import System.IO.Unsafe (unsafePerformIO) -- | Cabal information of interest to Ormolu. data CabalInfo = CabalInfo @@ -103,6 +105,21 @@ then pure Nothing else findCabalFile parentDir +-- | Parsed cabal file information to be shared across multiple source files. +data CachedCabalFile = CachedCabalFile + { -- | Parsed generic package description. + genericPackageDescription :: GenericPackageDescription, + -- | Map from Haskell source file paths (without any extensions) to the + -- corresponding 'DynOption's and dependencies. + extensionsAndDeps :: Map FilePath ([DynOption], [String]) + } + deriving (Show) + +-- | Cache ref that stores 'CachedCabalFile' per cabal file. +cabalCacheRef :: IORef (Map FilePath CachedCabalFile) +cabalCacheRef = unsafePerformIO $ newIORef M.empty +{-# NOINLINE cabalCacheRef #-} + -- | Parse 'CabalInfo' from a .cabal file at the given 'FilePath'. parseCabalInfo :: MonadIO m => @@ -115,23 +132,26 @@ parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do cabalFile <- makeAbsolute cabalFileAsGiven sourceFileAbs <- makeAbsolute sourceFileAsGiven - cabalFileBs <- B.readFile cabalFile - genericPackageDescription <- - case parseGenericPackageDescriptionMaybe cabalFileBs of - Just gpd -> pure gpd - Nothing -> throwIO (OrmoluCabalFileParsingFailed cabalFile) - (dynOpts, dependencies) <- do - let extMap = getExtensionAndDepsMap cabalFile genericPackageDescription - case M.lookup (dropExtensions sourceFileAbs) extMap of - Just exts -> pure exts - Nothing -> do - relativeCabalFile <- makeRelativeToCurrentDirectory cabalFile - hPutStrLn stderr $ - "Found .cabal file " - <> relativeCabalFile - <> ", but it did not mention " - <> sourceFileAsGiven - return ([], []) + cabalCache <- readIORef cabalCacheRef + CachedCabalFile {..} <- whenNothing (M.lookup cabalFile cabalCache) $ do + cabalFileBs <- B.readFile cabalFile + genericPackageDescription <- + whenNothing (parseGenericPackageDescriptionMaybe cabalFileBs) $ + throwIO (OrmoluCabalFileParsingFailed cabalFile) + let extensionsAndDeps = + getExtensionAndDepsMap cabalFile genericPackageDescription + cachedCabalFile = CachedCabalFile {..} + atomicModifyIORef cabalCacheRef $ + (,cachedCabalFile) . M.insert cabalFile cachedCabalFile + (dynOpts, dependencies) <- + whenNothing (M.lookup (dropExtensions sourceFileAbs) extensionsAndDeps) $ do + relativeCabalFile <- makeRelativeToCurrentDirectory cabalFile + hPutStrLn stderr $ + "Found .cabal file " + <> relativeCabalFile + <> ", but it did not mention " + <> sourceFileAsGiven + return ([], []) let pdesc = packageDescription genericPackageDescription packageName = (unPackageName . pkgName . package) pdesc return @@ -141,6 +161,9 @@ ciDependencies = Set.fromList dependencies, ciCabalFilePath = Just cabalFile } + where + whenNothing :: Monad m => Maybe a -> m a -> m a + whenNothing maya ma = maybe ma pure maya -- | Get a map from Haskell source file paths (without any extensions) to -- the corresponding 'DynOption's and dependencies. @@ -168,7 +191,7 @@ extractFromBuildInfo extraModules BuildInfo {..} = (,(exts, deps)) $ do m <- extraModules ++ (ModuleName.toFilePath <$> otherModules) - (takeDirectory cabalFile ) <$> prependSrcDirs (dropExtensions m) + normalise . (takeDirectory cabalFile ) <$> prependSrcDirs (dropExtensions m) where prependSrcDirs f | null hsSourceDirs = [f] diff --git a/tests/Ormolu/CabalInfoSpec.hs b/tests/Ormolu/CabalInfoSpec.hs --- a/tests/Ormolu/CabalInfoSpec.hs +++ b/tests/Ormolu/CabalInfoSpec.hs @@ -42,3 +42,13 @@ it "extracts correct dependencies from fourmolu.cabal (tests/Ormolu/PrinterSpec.hs)" $ do CabalInfo {..} <- parseCabalInfo "fourmolu.cabal" "tests/Ormolu/PrinterSpec.hs" ciDependencies `shouldBe` Set.fromList ["Diff", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "megaparsec", "fourmolu", "path", "path-io", "pretty", "temporary", "text"] + + it "handles `hs-source-dirs: .`" $ do + CabalInfo {..} <- parseTestCabalInfo "Foo.hs" + ciDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] + it "handles empty hs-source-dirs" $ do + CabalInfo {..} <- parseTestCabalInfo "Bar.hs" + ciDynOpts `shouldContain` [DynOption "-XImportQualifiedPost"] + where + parseTestCabalInfo f = + parseCabalInfo "data/cabal-tests/test.cabal" ("data/cabal-tests" f) diff --git a/tests/Ormolu/Config/PrinterOptsSpec.hs b/tests/Ormolu/Config/PrinterOptsSpec.hs --- a/tests/Ormolu/Config/PrinterOptsSpec.hs +++ b/tests/Ormolu/Config/PrinterOptsSpec.hs @@ -74,16 +74,11 @@ }, TestGroup { label = "import-export", - testCases = (,) <$> allOptions <*> allOptions, - updateConfig = \(commaStyle, diffFriendly) opts -> - opts - { poImportExportCommaStyle = pure commaStyle, - poDiffFriendlyImportExport = pure diffFriendly - }, - showTestCase = \(commaStyle, diffFriendly) -> - show commaStyle ++ if diffFriendly then " + diff friendly" else "", - testCaseSuffix = \(commaStyle, diffFriendly) -> - suffixWith [show commaStyle, if diffFriendly then "diff_friendly" else ""] + testCases = allOptions, + updateConfig = \commaStyle opts -> + opts {poImportExportStyle = pure commaStyle}, + showTestCase = show, + testCaseSuffix = suffix1 }, TestGroup { label = "record-brace-space", diff --git a/tests/Ormolu/Diff/TextSpec.hs b/tests/Ormolu/Diff/TextSpec.hs --- a/tests/Ormolu/Diff/TextSpec.hs +++ b/tests/Ormolu/Diff/TextSpec.hs @@ -24,6 +24,8 @@ stdTest "two-hunks" "main-and-baz" "main-and-baz-v2" stdTest "trimming" "spaced" "spaced-v2" stdTest "trailing-blank-line" "no-trailing-blank-line" "with-trailing-blank-line" + stdTest "trimming-trailing-both-eof" "applicative-before" "applicative-after" + stdTest "trimming-trailing-both-out-of-margin" "longer" "longer-v2" -- | Test diff printing. stdTest ::