diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## Fourmolu 0.13.1.0 + +* Fix `single-constraint-parens: never` with `QuantifiedConstraints` ([#340](https://github.com/fourmolu/fourmolu/issues/340)) +* Fix issue with single documented export + `import-export-style: leading` ([#341](https://github.com/fourmolu/fourmolu/issues/341)) +* Fix reexports configuration not allowing repeated modules ([#336](https://github.com/fourmolu/fourmolu/issues/336)) + ## Fourmolu 0.13.0.0 * Automatically ignore files in Cabal/Stack directories when recursively finding files to format. diff --git a/data/fourmolu/import-export/input-multi.hs b/data/fourmolu/import-export/input-multi.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/import-export/input-multi.hs @@ -0,0 +1,42 @@ +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, + (<<<), + (>>>), + ) + +{- // -} + +-- https://github.com/fourmolu/fourmolu/issues/341 +module Foo + ( -- | asdf + singleExport + ) where diff --git a/data/fourmolu/import-export/input.hs b/data/fourmolu/import-export/input.hs deleted file mode 100644 --- a/data/fourmolu/import-export/input.hs +++ /dev/null @@ -1,34 +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-ImportExportDiffFriendly.hs b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs --- a/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs +++ b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs @@ -31,3 +31,11 @@ (<<<), (>>>), ) + +{- // -} + +-- https://github.com/fourmolu/fourmolu/issues/341 +module Foo ( + -- | asdf + singleExport, +) where diff --git a/data/fourmolu/import-export/output-ImportExportLeading.hs b/data/fourmolu/import-export/output-ImportExportLeading.hs --- a/data/fourmolu/import-export/output-ImportExportLeading.hs +++ b/data/fourmolu/import-export/output-ImportExportLeading.hs @@ -31,3 +31,11 @@ , (<<<) , (>>>) ) + +{- // -} + +-- https://github.com/fourmolu/fourmolu/issues/341 +module Foo + ( -- | asdf + singleExport + ) where diff --git a/data/fourmolu/import-export/output-ImportExportTrailing.hs b/data/fourmolu/import-export/output-ImportExportTrailing.hs --- a/data/fourmolu/import-export/output-ImportExportTrailing.hs +++ b/data/fourmolu/import-export/output-ImportExportTrailing.hs @@ -31,3 +31,11 @@ (<<<), (>>>), ) + +{- // -} + +-- https://github.com/fourmolu/fourmolu/issues/341 +module Foo + ( -- | asdf + singleExport, + ) where diff --git a/data/fourmolu/single-constraint-parens/input.hs b/data/fourmolu/single-constraint-parens/input.hs --- a/data/fourmolu/single-constraint-parens/input.hs +++ b/data/fourmolu/single-constraint-parens/input.hs @@ -3,3 +3,6 @@ functionName :: (C a) => a functionName1 :: C a => a functionName2 :: (C a, D a) => a + +-- https://github.com/fourmolu/fourmolu/issues/340 +quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int diff --git a/data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs b/data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs --- a/data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs +++ b/data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs @@ -3,3 +3,5 @@ functionName :: (C a) => a functionName1 :: (C a) => a functionName2 :: (C a, D a) => a +-- https://github.com/fourmolu/fourmolu/issues/340 +quantifiedConstraint :: (forall a. (Show a) => Show (f a)) => f Int diff --git a/data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs b/data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs --- a/data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs +++ b/data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs @@ -3,3 +3,5 @@ functionName :: (C a) => a functionName1 :: C a => a functionName2 :: (C a, D a) => a +-- https://github.com/fourmolu/fourmolu/issues/340 +quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int diff --git a/data/fourmolu/single-constraint-parens/output-ConstraintNever.hs b/data/fourmolu/single-constraint-parens/output-ConstraintNever.hs --- a/data/fourmolu/single-constraint-parens/output-ConstraintNever.hs +++ b/data/fourmolu/single-constraint-parens/output-ConstraintNever.hs @@ -3,3 +3,5 @@ functionName :: C a => a functionName1 :: C a => a functionName2 :: (C a, D a) => a +-- https://github.com/fourmolu/fourmolu/issues/340 +quantifiedConstraint :: (forall a. Show a => Show (f a)) => f Int 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.13.0.0 +version: 0.13.1.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: @@ -205,15 +205,18 @@ -- specific to fourmolu tests other-modules: Ormolu.Config.PrinterOptsSpec + Ormolu.ConfigSpec Ormolu.Integration.CLIOptionsSpec Ormolu.Integration.CLISpec Ormolu.Integration.FixitySpec Ormolu.Integration.RegionSpec Ormolu.Integration.Utils build-depends: + bytestring, Diff >=0.3 && <0.5, pretty >=1.0 && <2.0, process >=1.6 && <2.0, + yaml, fourmolu build-tool-depends: fourmolu:fourmolu diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs --- a/src/Ormolu/Config.hs +++ b/src/Ormolu/Config.hs @@ -248,7 +248,7 @@ rawReexports <- o .:? "reexports" .!= [] cfgFileReexports <- case mapM parseModuleReexportDeclarationStr rawReexports of - Right reexports -> return . ModuleReexports . Map.fromList $ reexports + Right reexports -> return . ModuleReexports . Map.fromListWith (<>) $ reexports Left e -> fail e return FourmoluConfig {..} diff --git a/src/Ormolu/Parser.hs b/src/Ormolu/Parser.hs --- a/src/Ormolu/Parser.hs +++ b/src/Ormolu/Parser.hs @@ -208,16 +208,15 @@ a -> a patchContext :: LHsContext GhcPs -> LHsContext GhcPs patchContext = fmap $ \case - [x@(L _ (HsParTy _ t))] -> unwrapParens x t - [x@(L _ _)] -> wrapParens x + [x@(L _ (HsParTy _ inner))] + | L _ HsForAllTy {} <- inner -> [x] + | ConstraintNever <- constraintParens -> [inner] + | otherwise -> [x] + [x@(L lx _)] + | ConstraintAlways <- constraintParens -> [L lx (HsParTy EpAnnNotUsed x)] + | otherwise -> [x] xs -> xs constraintParens = runIdentity (poSingleConstraintParens cfgPrinterOpts) - unwrapParens outer inner = case constraintParens of - ConstraintNever -> [inner] - _ -> [outer] - wrapParens x@(L lx _) = case constraintParens of - ConstraintAlways -> [L lx (HsParTy EpAnnNotUsed x)] - _ -> [x] -- | Enable all language extensions that we think should be enabled by -- default for ease of use. 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 @@ -528,7 +528,6 @@ FirstPos -> br MiddlePos -> br LastPos -> id - FirstAfterDocPos -> br p_item' (p, item) = positionToBracing p $ withSpacing (either p_valDecl p_sigDecl) item 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 @@ -10,6 +10,7 @@ where import Control.Monad +import Data.List (inits) import Data.Text qualified as T import GHC.Hs import GHC.LanguageExtensions.Type @@ -26,8 +27,8 @@ layout <- getLayout sep breakpoint - (\(p, l) -> sitcc (located l (p_lie layout p))) - (attachRelativePos' xs) + (\(isAllPrevDoc, p, l) -> sitcc (located l (p_lie layout isAllPrevDoc p))) + (withAllPrevDoc $ attachRelativePos xs) p_hsmodImport :: ImportDecl GhcPs -> R () p_hsmodImport ImportDecl {..} = do @@ -70,12 +71,12 @@ layout <- getLayout sep breakpoint - (\(p, l) -> sitcc (located l (p_lie layout p))) + (\(p, l) -> sitcc (located l (p_lie layout False p))) (attachRelativePos xs) newline -p_lie :: Layout -> RelativePos -> IE GhcPs -> R () -p_lie encLayout relativePos = \case +p_lie :: Layout -> Bool -> RelativePos -> IE GhcPs -> R () +p_lie encLayout isAllPrevDoc relativePos = \case IEVar NoExtField l1 -> withComma $ located l1 p_ieWrappedName @@ -106,7 +107,6 @@ FirstPos -> return () MiddlePos -> newline LastPos -> newline - FirstAfterDocPos -> newline indentDoc $ p_hsDoc (Asterisk n) False str IEDoc NoExtField str -> indentDoc $ @@ -122,14 +122,13 @@ FirstPos -> m >> comma MiddlePos -> m >> comma LastPos -> void m - FirstAfterDocPos -> m >> comma MultiLine -> do commaStyle <- getCommaStyle case commaStyle of Leading -> case relativePos of FirstPos -> m - FirstAfterDocPos -> inciBy 2 m + _ | isAllPrevDoc -> inciBy 2 m SinglePos -> m _ -> comma >> space >> m Trailing -> m >> comma @@ -145,30 +144,18 @@ ---------------------------------------------------------------------------- --- | Unlike the version in `Ormolu.Utils`, this version handles explicitly leading export documentation -attachRelativePos' :: [LIE GhcPs] -> [(RelativePos, LIE GhcPs)] -attachRelativePos' = \case - [] -> [] - [x] -> [(SinglePos, x)] - -- Check if leading export is a Doc - (x@(L _ IEDoc {}) : xs) -> (FirstPos, x) : markDoc xs - (x@(L _ IEGroup {}) : xs) -> (FirstPos, x) : markDoc xs - (x@(L _ IEDocNamed {}) : xs) -> (FirstPos, x) : markDoc xs - (x : xs) -> (FirstPos, x) : markLast xs +-- | Annotate each element with a Bool indicating if all preceding elements are +-- documentation elements. +withAllPrevDoc :: [(RelativePos, LIE GhcPs)] -> [(Bool, RelativePos, LIE GhcPs)] +withAllPrevDoc xs = zipWith go (inits xs) xs where - -- Mark leading documentation, making sure the first export gets assigned - -- a `FirstPos` - markDoc [] = [] - markDoc [x] = [(LastPos, x)] - markDoc (x@(L _ IEDoc {}) : xs) = (FirstAfterDocPos, x) : markDoc xs - markDoc (x@(L _ IEGroup {}) : xs) = (FirstAfterDocPos, x) : markDoc xs - markDoc (x@(L _ IEDocNamed {}) : xs) = (FirstAfterDocPos, x) : markDoc xs - -- First export after a Doc gets assigned a `FirstPos` - markDoc (x : xs) = (FirstAfterDocPos, x) : markLast xs + go prevElems (p, l) = (all (isDoc . snd) prevElems, p, l) - markLast [] = [] - markLast [x] = [(LastPos, x)] - markLast (x : xs) = (MiddlePos, x) : markLast xs + isDoc = \case + L _ IEDoc {} -> True + L _ IEGroup {} -> True + L _ IEDocNamed {} -> True + _ -> False -- | Surround given entity by parentheses @(@ and @)@. parens' :: Bool -> R () -> R () diff --git a/src/Ormolu/Utils.hs b/src/Ormolu/Utils.hs --- a/src/Ormolu/Utils.hs +++ b/src/Ormolu/Utils.hs @@ -49,7 +49,6 @@ | FirstPos | MiddlePos | LastPos - | FirstAfterDocPos deriving (Eq, Show) -- | Attach 'RelativePos'es to elements of a given list. diff --git a/tests/Ormolu/CabalInfoSpec.hs b/tests/Ormolu/CabalInfoSpec.hs --- a/tests/Ormolu/CabalInfoSpec.hs +++ b/tests/Ormolu/CabalInfoSpec.hs @@ -44,7 +44,7 @@ mentioned `shouldBe` True unPackageName ciPackageName `shouldBe` "fourmolu" ciDynOpts `shouldBe` [DynOption "-XGHC2021"] - Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "fourmolu", "megaparsec", "path", "path-io", "pretty", "process", "temporary", "text"] + Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "QuickCheck", "base", "bytestring", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "fourmolu", "megaparsec", "path", "path-io", "pretty", "process", "temporary", "text", "yaml"] ciCabalFilePath `shouldSatisfy` isAbsolute makeRelativeToCurrentDirectory ciCabalFilePath `shouldReturn` "fourmolu.cabal" it "handles correctly files that are not mentioned in fourmolu.cabal" $ do 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 @@ -14,7 +14,6 @@ import Control.Monad (forM_, when) import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) import Data.Char (isSpace) -import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust) import Data.Text (Text) import Data.Text qualified as T @@ -54,6 +53,10 @@ data TestGroup = forall a. TestGroup { label :: String, + -- | When True, takes input from 'input-multi.hs' instead of 'input.hs', where sections + -- delimited by `{- // -}` will be formatted as separate Haskell files. Useful for testing + -- combinations of module headers, which is normally only allowed once. + isMulti :: Bool, testCases :: [a], updateConfig :: a -> PrinterOptsTotal -> PrinterOptsTotal, showTestCase :: a -> String, @@ -61,21 +64,14 @@ checkIdempotence :: Bool } -spec :: Spec -spec = - sequence_ - [ singleTests, - multiTests - ] - -- Tests where each test group is a directory with an `input.hs` file and multiple `output-*.hs` -- files that could be regenerated with ORMOLU_REGENERATE_EXAMPLES. -singleTests :: Spec -singleTests = - mapM_ - (runTestGroup False) +spec :: Spec +spec = + mapM_ runTestGroup $ [ TestGroup { label = "indentation", + isMulti = False, testCases = (,) <$> [2, 3, 4] <*> allOptions, updateConfig = \(indent, indentWheres) opts -> opts @@ -90,6 +86,7 @@ }, TestGroup { label = "column-limit", + isMulti = False, testCases = [NoLimit, ColumnLimit 80, ColumnLimit 100], updateConfig = \columnLimit opts -> opts {poColumnLimit = pure columnLimit}, showTestCase = show, @@ -103,6 +100,7 @@ }, TestGroup { label = "function-arrows", + isMulti = False, testCases = allOptions, updateConfig = \functionArrows opts -> opts {poFunctionArrows = pure functionArrows}, @@ -112,6 +110,7 @@ }, TestGroup { label = "comma-style", + isMulti = False, testCases = allOptions, updateConfig = \commaStyle opts -> opts {poCommaStyle = pure commaStyle}, showTestCase = show, @@ -120,6 +119,7 @@ }, TestGroup { label = "import-export", + isMulti = True, testCases = allOptions, updateConfig = \commaStyle opts -> opts {poImportExportStyle = pure commaStyle}, @@ -129,6 +129,7 @@ }, TestGroup { label = "record-brace-space", + isMulti = False, testCases = allOptions, updateConfig = \recordBraceSpace opts -> opts {poRecordBraceSpace = pure recordBraceSpace}, showTestCase = show, @@ -137,6 +138,7 @@ }, TestGroup { label = "newlines-between-decls", + isMulti = False, testCases = (,) <$> [0, 1, 2] <*> allOptions, updateConfig = \(newlines, respectful) opts -> opts @@ -151,6 +153,7 @@ }, TestGroup { label = "haddock-style", + isMulti = False, testCases = (,) <$> allOptions <*> (PrintStyleInherit : map PrintStyleOverride allOptions), updateConfig = \(haddockStyle, haddockStyleModule) opts -> opts @@ -173,6 +176,7 @@ }, TestGroup { label = "let-style", + isMulti = False, testCases = (,,) <$> allOptions <*> allOptions <*> [2, 4], updateConfig = \(letStyle, inStyle, indent) opts -> opts @@ -188,6 +192,7 @@ }, TestGroup { label = "single-constraint-parens", + isMulti = False, testCases = allOptions, updateConfig = \parens opts -> opts {poSingleConstraintParens = pure parens}, showTestCase = show, @@ -196,6 +201,7 @@ }, TestGroup { label = "unicode-syntax", + isMulti = False, testCases = allOptions, updateConfig = \unicodePreference options -> options {poUnicode = pure unicodePreference}, showTestCase = show, @@ -204,23 +210,16 @@ }, TestGroup { label = "respectful", + isMulti = False, testCases = allOptions, updateConfig = \respectful opts -> opts {poRespectful = pure respectful}, showTestCase = show, testCaseSuffix = suffix1, checkIdempotence = True - } - ] - --- Same as 'singleTests', except with input taken from 'input-multi.hs', where sections --- delimited by `{- // -}` will be formatted as separate Haskell files. Useful for testing --- combinations of module headers, which is normally only allowed once. -multiTests :: Spec -multiTests = - mapM_ - (runTestGroup True) - [ TestGroup + }, + TestGroup { label = "respectful-module-where", + isMulti = True, testCases = (,) <$> allOptions <*> allOptions, updateConfig = \(respectful, importExportStyle) opts -> opts @@ -235,8 +234,8 @@ } ] -runTestGroup :: Bool -> TestGroup -> Spec -runTestGroup isMulti TestGroup {..} = +runTestGroup :: TestGroup -> Spec +runTestGroup TestGroup {..} = describe label $ forM_ testCases $ \testCase -> it ("generates the correct output for: " ++ showTestCase testCase) $ do @@ -299,11 +298,20 @@ suffix1 a1 = suffixWith [show a1] overSectionsM :: (Monad m) => Text -> (Text -> m Text) -> Text -> m Text -overSectionsM delim f = - fmap T.concat - . mapM (\(s, isDelim) -> if isDelim then pure s else f s) - . splitOnDelim delim +overSectionsM delim f = go . T.lines + where + go inputLines = + case break (== delim) inputLines of + (section, []) -> f $ T.unlines section + (pre, _ : post) -> do + let (section, delimPre) = spanEnd (T.all isSpace) pre + (delimPost, rest) = span (T.all isSpace) post + resultPre <- f $ T.unlines section + let delimLines = T.unlines $ concat [delimPre, [delim], delimPost] + resultPost <- go rest + pure $ resultPre <> delimLines <> resultPost + getFileContents :: Path b File -> IO (Maybe Text) getFileContents path = do fileExists <- doesFileExist path @@ -338,38 +346,7 @@ {--- Utilities ---} --- | Group delimiter (including surrounding whitespace) and non-delimiter lines --- and annotate lines with a Bool indicating if the group is a delimiter group --- or not. -splitOnDelim :: Text -> Text -> [(Text, Bool)] -splitOnDelim delim = - map (\(lineGroup, delimType) -> (T.unlines lineGroup, isDelim delimType)) - . collapseSpaces NonDelim - . collapseSpaces Delim - . groupWith toLineType - . T.lines - where - toLineType line - | T.all isSpace line = Space - | line == delim = Delim - | otherwise = NonDelim - - collapseSpaces delimType = \case - (xs, Space) : (ys, ysType) : rest | ysType == delimType -> collapseSpaces delimType $ (xs ++ ys, delimType) : rest - (xs, xsType) : (ys, Space) : rest | xsType == delimType -> collapseSpaces delimType $ (xs ++ ys, delimType) : rest - x : rest -> x : collapseSpaces delimType rest - [] -> [] - - isDelim = \case - Delim -> True - NonDelim -> False - Space -> error "isDelim called on Space, but all Spaces should've been eliminated at this point" - - -- Like 'NE.groupWith', except annotates group with comparator - groupWith :: (Eq b) => (a -> b) -> [a] -> [([a], b)] - groupWith f = - let liftComparator xs = (map fst $ NE.toList xs, snd $ NE.head xs) - in map liftComparator . NE.groupWith snd . map (\a -> (a, f a)) - -data LineType = Space | Delim | NonDelim - deriving (Eq) +spanEnd :: (a -> Bool) -> [a] -> ([a], [a]) +spanEnd f xs = + let xs' = reverse xs + in (reverse $ dropWhile f xs', reverse $ takeWhile f xs') diff --git a/tests/Ormolu/ConfigSpec.hs b/tests/Ormolu/ConfigSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Ormolu/ConfigSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Tests for Fourmolu file configuration. +module Ormolu.ConfigSpec (spec) where + +import Data.ByteString.Char8 qualified as Char8 +import Data.List.NonEmpty qualified as NonEmpty +import Data.Map qualified as Map +import Data.Yaml qualified as Yaml +import Ormolu.Config (FourmoluConfig (..)) +import Ormolu.Fixity (ModuleReexports (..)) +import Test.Hspec + +spec :: Spec +spec = do + describe "FourmoluConfig" $ do + it "parses multiple reexports from same module" $ do + config <- + Yaml.decodeThrow . Char8.pack . unlines $ + [ "reexports:", + "- module Foo exports Bar1", + "- module Foo exports Bar2" + ] + let expected = + Map.fromList + [ ("Foo", NonEmpty.fromList [(Nothing, "Bar2"), (Nothing, "Bar1")]) + ] + cfgFileReexports config `shouldBe` ModuleReexports expected