diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 51441363..c7254264 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -218,6 +218,29 @@ steps: # Default: inline long_list_align: inline + # Entity list align can be used to alter alignment of import list entities + # like 'Bar' record names in the following example: + # + # > import Foo (Bar(x, y)) + # + # - inline: Entities are always formatted inline + # + # - multiline: The list of entities will start on new line, + # except for a case, when it cotains only a single entity. + # + # > import Foo + # > (Bar + # > ( x + # > , y + # > ) + # > ) + # + # This is useful in combination with long_list_aling multiline + # and similar to get a git friendly formatting. + # + # Default: inline + entity_list_align: inline + # Align empty list (importing instances) # # Empty list align has following options diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 3e62108c..f2598456 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -283,6 +283,7 @@ parseImports config o = fmap (Imports.step columns) $ Imports.Options <*> (o A..:? "pad_module_names" A..!= def Imports.padModuleNames) <*> (o A..:? "long_list_align" >>= parseEnum longListAligns (def Imports.longListAlign)) <*> (o A..:? "empty_list_align" >>= parseEnum emptyListAligns (def Imports.emptyListAlign)) + <*> (o A..:? "entity_list_align" >>= parseEnum entityListAligns (def Imports.entityListAlign)) -- Note that padding has to be at least 1. Default is 4. <*> (o A..:? "list_padding" >>= maybe (pure $ def Imports.listPadding) parseListPadding) <*> o A..:? "separate_lists" A..!= def Imports.separateLists @@ -322,6 +323,11 @@ parseImports config o = fmap (Imports.step columns) $ Imports.Options , ("right_after", Imports.RightAfter) ] + entityListAligns = + [ ("inline", Imports.ELInline) + , ("multiline", Imports.ELMultiline) + ] + parseListPadding = \case A.String "module_name" -> pure Imports.LPModuleName A.Number n | n >= 1 -> pure $ Imports.LPConstant (truncate n) diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs index 3ec67eea..9088de22 100644 --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -11,6 +11,7 @@ module Language.Haskell.Stylish.Step.Imports , ImportAlign (..) , ListAlign (..) , LongListAlign (..) + , EntityListAlign (..) , EmptyListAlign (..) , ListPadding (..) , GroupRule (..) @@ -61,32 +62,34 @@ import Language.Haskell.Stylish.Util -------------------------------------------------------------------------------- data Options = Options - { importAlign :: ImportAlign - , listAlign :: ListAlign - , padModuleNames :: Bool - , longListAlign :: LongListAlign - , emptyListAlign :: EmptyListAlign - , listPadding :: ListPadding - , separateLists :: Bool - , spaceSurround :: Bool - , postQualified :: Bool - , groupImports :: Bool - , groupRules :: [GroupRule] + { importAlign :: ImportAlign + , listAlign :: ListAlign + , padModuleNames :: Bool + , longListAlign :: LongListAlign + , emptyListAlign :: EmptyListAlign + , entityListAlign :: EntityListAlign + , listPadding :: ListPadding + , separateLists :: Bool + , spaceSurround :: Bool + , postQualified :: Bool + , groupImports :: Bool + , groupRules :: [GroupRule] } deriving (Eq, Show) defaultOptions :: Options defaultOptions = Options - { importAlign = Global - , listAlign = AfterAlias - , padModuleNames = True - , longListAlign = Inline - , emptyListAlign = Inherit - , listPadding = LPConstant 4 - , separateLists = True - , spaceSurround = False - , postQualified = False - , groupImports = False - , groupRules = [defaultGroupRule] + { importAlign = Global + , listAlign = AfterAlias + , padModuleNames = True + , longListAlign = Inline + , emptyListAlign = Inherit + , entityListAlign = ELInline + , listPadding = LPConstant 4 + , separateLists = True + , spaceSurround = False + , postQualified = False + , groupImports = False + , groupRules = [defaultGroupRule] } where defaultGroupRule = GroupRule { match = unsafeParsePattern ".*" @@ -125,6 +128,28 @@ data LongListAlign | Multiline -- multiline deriving (Eq, Show) +-- | Alignment of lists of constructors, class methods, fields names +-- in import lists entities. +-- @ELMultiline@ causes +-- +-- import Foo (Bar(x, y)) +-- +-- To be expanded to +-- +-- import Foo +-- (Bar +-- ( x +-- , y +-- ) +-- ) +-- +-- This is useful in combination with @LongListAlign@ @Multiline@ +-- to get a git friendly formatting. +data EntityListAlign + = ELInline -- default + | ELMultiline -- multiline + deriving (Eq, Show) + -- | A rule for grouping imports that specifies which module names -- belong in a group and (optionally) how to break them up into -- sub-groups. @@ -347,7 +372,7 @@ groupByRules rules allImports = toList $ go rules allImports Seq.empty -------------------------------------------------------------------------------- printQualified :: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P () -printQualified Options{..} padNames stats ldecl = do +printQualified options@Options{..} padNames stats ldecl = do putText "import" >> space case (isSource decl, isAnySource stats) of @@ -409,7 +434,7 @@ printQualified Options{..} padNames stats ldecl = do Just limports -> do let imports = GHC.unLoc limports printedImports = flagEnds $ -- [P ()] - (printImport separateLists) . GHC.unLoc <$> + (printImport options) . GHC.unLoc <$> prepareImportList imports -- Since we might need to output the import module name several times, we @@ -506,12 +531,12 @@ printQualified Options{..} padNames stats ldecl = do -------------------------------------------------------------------------------- -printImport :: Bool -> GHC.IE GHC.GhcPs -> P () +printImport :: Options -> GHC.IE GHC.GhcPs -> P () printImport _ (GHC.IEVar _ name) = do printIeWrappedName name printImport _ (GHC.IEThingAbs _ name) = do printIeWrappedName name -printImport separateLists (GHC.IEThingAll _ name) = do +printImport Options{..} (GHC.IEThingAll _ name) = do printIeWrappedName name when separateLists space putText "(..)" @@ -519,14 +544,43 @@ printImport _ (GHC.IEModuleContents _ modu) = do putText "module" space putText . GHC.moduleNameString $ GHC.unLoc modu -printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do +printImport Options{..} (GHC.IEThingWith _ name wildcard imps) = do printIeWrappedName name - when separateLists space + let ellipsis = case wildcard of GHC.IEWildcard _position -> [putText ".."] GHC.NoIEWildcard -> [] - parenthesize $ - sep (comma >> space) (ellipsis <> fmap printIeWrappedName imps) + + importNamePosition <- length <$> getCurrentLine + + let putOffset = putText $ replicate offset ' ' + offset = case listPadding of + LPConstant n -> 2 + 2 * n + LPModuleName -> importNamePosition + + entityListSeparator = case entityListAlign of + ELInline -> comma >> space + ELMultiline -> newline >> putOffset >> comma >> space + + printInline = do + when separateLists space + parenthesize $ + sep (comma >> space) (ellipsis <> fmap printIeWrappedName imps) + + case entityListAlign of + ELInline -> printInline + ELMultiline -> do + if length imps == 1 + then + printInline + else do + newline + putOffset + parenthesize $ do + space + sep entityListSeparator (ellipsis <> fmap printIeWrappedName imps) + newline + putOffset printImport _ (GHC.IEGroup _ _ _ ) = error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'" printImport _ (GHC.IEDoc _ _) = diff --git a/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs b/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs index 474a08fc..e6970c75 100644 --- a/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +++ b/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs @@ -226,4 +226,7 @@ printMultiLineExportList conf exports = do -- NOTE(jaspervdj): This code is almost the same as the import printing in -- 'Imports' and should be merged. putExport :: Config -> GHC.LIE GHC.GhcPs -> P () -putExport conf = Imports.printImport (separateLists conf) . GHC.unLoc +putExport conf = + Imports.printImport + (Imports.defaultOptions { Imports.separateLists = separateLists conf}) + . GHC.unLoc diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index 82298068..efcec989 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -79,6 +79,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 44a" case44a , testCase "case 44b" case44b , testCase "case 44c" case44c + , testCase "case 45" case45 ] @@ -1291,3 +1292,22 @@ case44c = ] , importAlign = None } + + +-------------------------------------------------------------------------------- +case45 :: Assertion +case45 = + let + options = defaultOptions { importAlign = None, entityListAlign = ELMultiline } + in + assertSnippet (step (Just 40) options) + case45input + [ "import Foo (Bar" + , " ( x" + , " , y" + , " ))" + ] + +case45input :: Snippet +case45input = + [ "import Foo (Bar(x, y))" ]