fourmolu 0.13.0.0 → 0.13.1.0

raw patch · 19 files changed

+180/−141 lines, 19 filesdep ~bytestringdep ~deepseqdep ~yamlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, deepseq, yaml

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• data/fourmolu/import-export/input-multi.hs +42/−0
• data/fourmolu/import-export/input.hs +0/−34
• data/fourmolu/import-export/output-ImportExportDiffFriendly.hs +8/−0
• data/fourmolu/import-export/output-ImportExportLeading.hs +8/−0
• data/fourmolu/import-export/output-ImportExportTrailing.hs +8/−0
• data/fourmolu/single-constraint-parens/input.hs +3/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAlways.hs +2/−0
• data/fourmolu/single-constraint-parens/output-ConstraintAuto.hs +2/−0
• data/fourmolu/single-constraint-parens/output-ConstraintNever.hs +2/−0
• fourmolu.cabal +4/−1
• src/Ormolu/Config.hs +1/−1
• src/Ormolu/Parser.hs +7/−8
• src/Ormolu/Printer/Meat/Declaration/Value.hs +0/−1
• src/Ormolu/Printer/Meat/ImportExport.hs +17/−30
• src/Ormolu/Utils.hs +0/−1
• tests/Ormolu/CabalInfoSpec.hs +1/−1
• tests/Ormolu/Config/PrinterOptsSpec.hs +41/−64
• tests/Ormolu/ConfigSpec.hs +28/−0

@@ -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.

@@ -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

@@ -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,-    (<<<),-    (>>>),-  )

@@ -31,3 +31,11 @@     (<<<),     (>>>),  )++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/341+module Foo (+    -- | asdf+    singleExport,+) where

@@ -31,3 +31,11 @@     , (<<<)     , (>>>)     )++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/341+module Foo+    ( -- | asdf+      singleExport+    ) where

@@ -31,3 +31,11 @@       (<<<),       (>>>),     )++{- // -}++-- https://github.com/fourmolu/fourmolu/issues/341+module Foo+    ( -- | asdf+      singleExport,+    ) where

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 

@@ -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 {..} 

@@ -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.

@@ -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

@@ -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 ()

@@ -49,7 +49,6 @@   | FirstPos   | MiddlePos   | LastPos-  | FirstAfterDocPos   deriving (Eq, Show)  -- | Attach 'RelativePos'es to elements of a given list.

@@ -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

@@ -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')

@@ -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