diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,10 @@ # CHANGELOG +- 0.14.3.0 (2022-09-28) + * Fix parsing of NoXyz extensions + * Bump `Cabal` upper bound to 4.0 + * Add option to automatically group imports (by Tikhon Jelvis) + - 0.14.2.0 (2022-04-27) * Add a build flag to force the use of ghc-lib-parser diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -168,8 +168,8 @@ can use stylish-haskell for formatting. [HLS]: https://github.com/haskell/haskell-language-server -[HLS option]: https://github.com/haskell/haskell-language-server#language-specific-server-options -[HLS stylish-haskell Plugin]: https://github.com/haskell/haskell-language-server/blob/master/plugins/default/src/Ide/Plugin/StylishHaskell.hs +[HLS option]: https://haskell-language-server.readthedocs.io/en/latest/configuration.html#language-specific-server-options +[HLS stylish-haskell Plugin]: https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs [LSP]: https://microsoft.github.io/language-server-protocol/ ### VIM integration diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -294,6 +294,107 @@ # Default: false post_qualify: false + # Automatically group imports based on their module names, with + # a blank line separating each group. Groups are ordered in + # alphabetical order. + # + # By default, this groups by the first part of each module's + # name (Control.* will be grouped together, Data.*... etc), but + # this can be configured with the group_patterns setting. + # + # When enabled, this rewrites existing blank lines and groups. + # + # - true: Group imports by the first part of the module name. + # + # > import Control.Applicative + # > import Control.Monad + # > import Control.Monad.MonadError + # > + # > import Data.Functor + # + # - false: Keep import groups as-is (still sorting and + # formatting the imports within each group) + # + # > import Control.Monad + # > import Data.Functor + # > + # > import Control.Applicative + # > import Control.Monad.MonadError + # + # Default: false + group_imports: false + + # A list of rules specifying how to group modules and how to + # order the groups. + # + # Each rule has a match field; the rule only applies to module + # names matched by this pattern. Patterns are POSIX extended + # regular expressions; see the documentation of Text.Regex.TDFA + # for details: + # https://hackage.haskell.org/package/regex-tdfa-1.3.1.2/docs/Text-Regex-TDFA.html + # + # Rules are processed in order, so only the *first* rule that + # matches a specific module will apply. Any module names that do + # not match a single rule will be put into a single group at the + # end of the import block. + # + # Example: group MyApp modules first, with everything else in + # one group at the end. + # + # group_rules: + # - match: "^MyApp\\>" + # + # > import MyApp + # > import MyApp.Foo + # > + # > import Control.Monad + # > import MyApps + # > import Test.MyApp + # + # A rule can also optionally have a sub_group pattern. Imports + # that match the rule will be broken up into further groups by + # the part of the module name matched by the sub_group pattern. + # + # Example: group MyApp modules first, then everything else + # sub-grouped by the first part of the module name. + # + # group_rules: + # - match: "^MyApp\\>" + # - match: "." + # sub_group: "^[^.]+" + # + # > import MyApp + # > import MyApp.Foo + # > + # > import Control.Applicative + # > import Control.Monad + # > + # > import Data.Map + # + # A pattern only needs to match part of the module name, which + # could be in the middle. You can use ^pattern to anchor to the + # beginning of the module name, pattern$ to anchor to the end + # and ^pattern$ to force a full match. Example: + # + # - "Test\\." would match "Test.Foo" and "Foo.Test.Lib" + # - "^Test\\." would match "Test.Foo" but not "Foo.Test.Lib" + # - "\\.Test$" would match "Foo.Test" but not "Foo.Test.Lib" + # - "^Test$" would *only* match "Test" + # + # You can use \\< and \\> to anchor against the beginning and + # end of words, respectively. For example: + # + # - "^Test\\." would match "Test.Foo" but not "Test" or "Tests" + # - "^Test\\>" would match "Test.Foo" and "Test", but not + # "Tests" + # + # The default is a single rule that matches everything and + # sub-groups based on the first component of the module name. + # + # Default: [{ "match" : ".*", "sub_group": "^[^.]+" }] + group_rules: + - match: ".*" + sub_group: "^[^.]+" # Language pragmas - language_pragmas: diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -287,6 +287,8 @@ <*> o A..:? "separate_lists" A..!= def Imports.separateLists <*> o A..:? "space_surround" A..!= def Imports.spaceSurround <*> o A..:? "post_qualify" A..!= def Imports.postQualified + <*> o A..:? "group_imports" A..!= def Imports.groupImports + <*> o A..:? "group_rules" A..!= def Imports.groupRules where def f = f Imports.defaultOptions diff --git a/lib/Language/Haskell/Stylish/Parse.hs b/lib/Language/Haskell/Stylish/Parse.hs --- a/lib/Language/Haskell/Stylish/Parse.hs +++ b/lib/Language/Haskell/Stylish/Parse.hs @@ -5,13 +5,11 @@ -------------------------------------------------------------------------------- -import Control.Monad ((>=>)) import Data.List (foldl', stripPrefix) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) -import Data.Traversable (for) import qualified GHC.Data.StringBuffer as GHC import GHC.Driver.Ppr as GHC import qualified GHC.Driver.Session as GHC @@ -36,6 +34,15 @@ -------------------------------------------------------------------------------- +parseExtension :: String -> Either String (LangExt.Extension, Bool) +parseExtension str = case GHCEx.readExtension str of + Just e -> Right (e, True) + Nothing -> case str of + 'N' : 'o' : str' -> fmap not <$> parseExtension str' + _ -> Left $ "Unknown extension: " ++ show str + + +-------------------------------------------------------------------------------- -- | Filter out lines which use CPP macros unCpp :: String -> String unCpp = unlines . go False . lines @@ -60,23 +67,24 @@ parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module parseModule externalExts0 fp string = do -- Parse extensions. - externalExts1 <- for externalExts0 $ \s -> case GHCEx.readExtension s of - Nothing -> Left $ "Unknown extension: " ++ show s - Just e -> Right e + externalExts1 <- traverse parseExtension externalExts0 -- Build first dynflags. - let dynFlags0 = foldl' turnOn baseDynFlags externalExts1 + let dynFlags0 = foldl' toggleExt baseDynFlags externalExts1 -- Parse options from file let fileOptions = fmap GHC.unLoc $ GHC.getOptions dynFlags0 (GHC.stringToStringBuffer string) (fromMaybe "-" fp) - fileExtensions = mapMaybe - (stripPrefix "-X" >=> GHCEx.readExtension) + fileExtensions = mapMaybe (\str -> do + str' <- stripPrefix "-X" str + case parseExtension str' of + Left _ -> Nothing + Right x -> pure x) fileOptions -- Set further dynflags. - let dynFlags1 = foldl' turnOn dynFlags0 fileExtensions + let dynFlags1 = foldl' toggleExt dynFlags0 fileExtensions `GHC.gopt_set` GHC.Opt_KeepRawTokenStream -- Possibly strip CPP. @@ -92,7 +100,7 @@ where withFileName x = maybe "" (<> ": ") fp <> x - turnOn dynFlags ext = foldl' - turnOn - (GHC.xopt_set dynFlags ext) - [rhs | (lhs, True, rhs) <- GHC.impliedXFlags, lhs == ext] + toggleExt dynFlags (ext, onOff) = foldl' + toggleExt + ((if onOff then GHC.xopt_set else GHC.xopt_unset) dynFlags ext) + [(rhs, onOff') | (lhs, onOff', rhs) <- GHC.impliedXFlags, lhs == ext] diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -1,7 +1,10 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DoAndIfThenElse #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Language.Haskell.Stylish.Step.Imports ( Options (..) , defaultOptions @@ -10,22 +13,31 @@ , LongListAlign (..) , EmptyListAlign (..) , ListPadding (..) + , GroupRule (..) , step , printImport + + , parsePattern + , unsafeParsePattern ) where -------------------------------------------------------------------------------- import Control.Monad (forM_, void, when) +import qualified Data.Aeson as A import Data.Foldable (toList) import Data.Function (on, (&)) import Data.Functor (($>)) -import Data.List (sortBy) +import Data.List (groupBy, intercalate, + partition, sortBy, sortOn) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Sequence (Seq ((:|>))) +import qualified Data.Sequence as Seq import qualified Data.Set as Set +import qualified Data.Text as T import qualified GHC.Data.FastString as GHC import qualified GHC.Hs as GHC import qualified GHC.Types.Name.Reader as GHC @@ -33,7 +45,9 @@ import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Unit.Module.Name as GHC import qualified GHC.Unit.Types as GHC - +import Text.Regex.TDFA (Regex) +import qualified Text.Regex.TDFA as Regex +import Text.Regex.TDFA.ReadRegex (parseRegex) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Block @@ -44,7 +58,6 @@ import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util - -------------------------------------------------------------------------------- data Options = Options { importAlign :: ImportAlign @@ -56,20 +69,28 @@ , 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 + { importAlign = Global + , listAlign = AfterAlias + , padModuleNames = True + , longListAlign = Inline + , emptyListAlign = Inherit + , listPadding = LPConstant 4 + , separateLists = True + , spaceSurround = False + , postQualified = False + , groupImports = False + , groupRules = [defaultGroupRule] } + where defaultGroupRule = GroupRule + { match = unsafeParsePattern ".*" + , subGroup = Just $ unsafeParsePattern "^[^.]+" + } data ListPadding = LPConstant Int @@ -103,7 +124,78 @@ | Multiline -- 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. +-- +-- See the documentation for the group_rules setting in +-- data/stylish-haskell.yaml for more details. +data GroupRule = GroupRule + { match :: Pattern + -- ^ The pattern that determines whether a rule applies to a + -- module name. + , subGroup :: Maybe Pattern + -- ^ An optional pattern for breaking the group up into smaller + -- sub-groups. + } deriving (Show, Eq) +instance A.FromJSON GroupRule where + parseJSON = A.withObject "group_rule" parse + where parse o = GroupRule + <$> (o A..: "match") + <*> (o A..:? "sub_group") + +-- | A compiled regular expression. Provides instances that 'Regex' +-- does not have (eg 'Show', 'Eq' and 'FromJSON'). +-- +-- Construct with 'parsePattern' to maintain the invariant that +-- 'string' is the exact regex string used to compile 'regex'. +data Pattern = Pattern + { regex :: Regex + -- ^ The compiled regular expression. + , string :: String + -- ^ The valid regex string that 'regex' was compiled from. + } + +instance Show Pattern where show = show . string + +instance Eq Pattern where (==) = (==) `on` string + +instance A.FromJSON Pattern where + parseJSON = A.withText "regex" parse + where parse text = case parsePattern $ T.unpack text of + Left err -> fail $ "Invalid regex:\n" <> err + Right pat -> pure pat + + +-- | Parse a string into a compiled regular expression ('Pattern'). +-- +-- Returns a human-readable parse error message if the string is not +-- valid regex syntax. +-- +-- >>> parsePattern "^([^.]+)" +-- Right "^([^.]+)" +-- +-- >>> parsePattern "(" +-- Left "\"(\" (line 1, column 2):\nunexpected end of input\nexpecting empty () or anchor ^ or $ or an atom" +parsePattern :: String -> Either String Pattern +parsePattern string = case parseRegex string of + Right _ -> Right $ Pattern { string, regex = Regex.makeRegex string } + Left err -> Left (show err) + +-- | Parse a string into a regular expression, raising a runtime +-- exception if the string is not valid regex syntax. +-- +-- >>> unsafeParsePattern "^([^.]+)" +-- "^([^.]+)" +-- +-- >>> unsafeParsePattern "(" +-- "*** Exception: "(" (line 1, column 2): +-- unexpected end of input +-- expecting empty () or anchor ^ or $ or an atom +unsafeParsePattern :: String -> Pattern +unsafeParsePattern = either error id . parsePattern + -------------------------------------------------------------------------------- step :: Maybe Int -> Options -> Step step columns = makeStep "Imports (ghc-lib-parser)" . printImports columns @@ -111,11 +203,15 @@ -------------------------------------------------------------------------------- printImports :: Maybe Int -> Options -> Lines -> Module -> Lines -printImports maxCols align ls m = Editor.apply changes ls +printImports maxCols options ls m = Editor.apply changes ls where groups = moduleImportGroups m moduleStats = foldMap importStats . fmap GHC.unLoc $ concatMap toList groups - changes = foldMap (formatGroup maxCols align moduleStats) groups + changes + | groupImports options = + groupAndFormat maxCols options moduleStats groups + | otherwise = + foldMap (formatGroup maxCols options moduleStats) groups formatGroup :: Maybe Int -> Options -> ImportStats @@ -158,6 +254,93 @@ None -> mempty forM_ group \imp -> printQualified options padNames stats imp >> newline + + +-------------------------------------------------------------------------------- +-- | Reorganize imports into groups based on 'groupPatterns', then +-- format each group as specified by the rest of 'Options'. +-- +-- Note: this will discard blank lines and comments inside the imports +-- section. +groupAndFormat + :: Maybe Int + -> Options + -> ImportStats + -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)] + -> Editor.Edits +groupAndFormat _ _ _ [] = mempty +groupAndFormat maxCols options moduleStats groups = + Editor.changeLines block (const regroupedLines) + where + regroupedLines :: Lines + regroupedLines = intercalate [""] $ + map (formatImports maxCols options moduleStats) grouped + + grouped :: [NonEmpty (GHC.LImportDecl GHC.GhcPs)] + grouped = groupByRules (groupRules options) imports + + imports :: [GHC.LImportDecl GHC.GhcPs] + imports = concatMap toList groups + + -- groups is non-empty by the pattern for this case + -- imports is non-empty as long as groups is non-empty + block = Block + (GHC.srcSpanStartLine . src $ head imports) + (GHC.srcSpanEndLine . src $ last imports) + src = fromMaybe (error "regroupImports: missing location") . + GHC.srcSpanToRealSrcSpan . GHC.getLocA + +-- | Group imports based on a list of patterns. +-- +-- See the documentation for @group_patterns@ in +-- @data/stylish-haskell.yaml@ for details about the patterns and +-- grouping logic. +groupByRules + :: [GroupRule] + -- ^ The patterns specifying the groups to build. Order matters: + -- earlier patterns take precedence over later ones. + -> [GHC.LImportDecl GHC.GhcPs] + -- ^ The imports to group. Order does not matter. + -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)] +groupByRules rules allImports = toList $ go rules allImports Seq.empty + where + go :: [GroupRule] + -> [GHC.LImportDecl GHC.GhcPs] + -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs)) + -> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs)) + go [] [] groups = groups + go [] imports groups = groups :|> NonEmpty.fromList imports + go (r : rs) imports groups = + let + (groups', rest) = extract r imports + in + go rs rest (groups <> groups') + + extract :: GroupRule + -> [GHC.LImportDecl GHC.GhcPs] + -> ( Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs)) + , [GHC.LImportDecl GHC.GhcPs] + ) + extract GroupRule { match, subGroup } imports = + let + (matched, rest) = partition (matches match) imports + subgroups = groupBy ((==) `on` firstMatch subGroup) $ + sortOn (firstMatch subGroup) matched + in + -- groupBy never produces empty groups, so this mapMaybe will + -- not discard anything from subgroups + (Seq.fromList $ mapMaybe NonEmpty.nonEmpty subgroups, rest) + + matches :: Pattern -> GHC.LImportDecl GHC.GhcPs -> Bool + matches Pattern { regex } import_ = Regex.match regex $ moduleName import_ + + firstMatch :: Maybe Pattern -> GHC.LImportDecl GHC.GhcPs -> String + firstMatch (Just Pattern { regex }) import_ = + Regex.match regex $ moduleName import_ + firstMatch Nothing _ = + "" -- constant grouping key, so everything will be grouped together + + moduleName = importModuleName . GHC.unLoc -------------------------------------------------------------------------------- diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,6 +1,6 @@ Cabal-version: 2.4 Name: stylish-haskell -Version: 0.14.2.0 +Version: 0.14.3.0 Synopsis: Haskell code prettifier Homepage: https://github.com/haskell/stylish-haskell License: BSD-3-Clause @@ -37,12 +37,13 @@ aeson >= 0.6 && < 2.1, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.12, - Cabal >= 3.4 && < 3.7, + Cabal >= 3.4 && < 4.0, containers >= 0.3 && < 0.7, directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, file-embed >= 0.0.10 && < 0.1, mtl >= 2.0 && < 2.3, + regex-tdfa >= 1.3 && < 1.4, syb >= 0.3 && < 0.8, text >= 1.2 && < 1.3, HsYAML-aeson >=0.2.0 && < 0.3, diff --git a/tests/Language/Haskell/Stylish/Parse/Tests.hs b/tests/Language/Haskell/Stylish/Parse/Tests.hs --- a/tests/Language/Haskell/Stylish/Parse/Tests.hs +++ b/tests/Language/Haskell/Stylish/Parse/Tests.hs @@ -30,6 +30,7 @@ , testCase "UnicodeSyntax extension" testUnicodeSyntax , testCase "XmlSyntax regression" testXmlSyntaxRegression , testCase "MagicHash regression" testMagicHashRegression + , testCase "Disabling extensions" testDisableExtensions ] -------------------------------------------------------------------------------- @@ -137,6 +138,13 @@ testMagicHashRegression = returnsRight $ parseModule [] Nothing $ unlines [ "xs = \"foo\"#|1#|'a'#|bar#|Nil" ] + +testDisableExtensions :: Assertion +testDisableExtensions = returnsRight $ + parseModule ["NoImplicitPrelude"] Nothing $ unlines + [ "{-# NoStarIsType #-}" + , "main = return ()" + ] -------------------------------------------------------------------------------- returnsRight :: HasCallStack => Show a => Either a b -> Assertion diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Imports.Tests ( tests ) where @@ -70,6 +71,14 @@ , testCase "case 36" case36 , testCase "case 37" case37 , testCase "case 38" case38 + , testCase "case 39" case39 + , testCase "case 40" case40 + , testCase "case 41" case41 + , testCase "case 42" case42 + , testCase "case 43" case43 + , testCase "case 44a" case44a + , testCase "case 44b" case44b + , testCase "case 44c" case44c ] @@ -198,7 +207,7 @@ case08 :: Assertion case08 = let - options = Options Global WithAlias True Inline Inherit (LPConstant 4) True False False + options = defaultOptions { listAlign = WithAlias } in assertSnippet (step (Just 80) options) input [ "module Herp where" @@ -222,7 +231,7 @@ case08b :: Assertion case08b = let - options = Options Global WithModuleName True Inline Inherit (LPConstant 4) True False False + options = defaultOptions { listAlign = WithModuleName } in assertSnippet (step (Just 80) options) input ["module Herp where" @@ -245,7 +254,7 @@ case09 :: Assertion case09 = let - options = Options Global WithAlias True Multiline Inherit (LPConstant 4) True False False + options = defaultOptions { listAlign = WithAlias, longListAlign = Multiline } in assertSnippet (step (Just 80) options) input [ "module Herp where" @@ -280,7 +289,11 @@ case10 :: Assertion case10 = let - options = Options Group WithAlias True Multiline Inherit (LPConstant 4) True False False + options = defaultOptions + { importAlign = Group + , listAlign = WithAlias + , longListAlign = Multiline + } in assertSnippet (step (Just 40) options) input [ "module Herp where" @@ -321,7 +334,7 @@ case11 :: Assertion case11 = let - options = Options Group NewLine True Inline Inherit (LPConstant 4) True False False + options = defaultOptions { importAlign = Group, listAlign = NewLine } in assertSnippet (step (Just 80) options) input [ "module Herp where" @@ -348,7 +361,7 @@ case11b :: Assertion case11b = let - options = Options Group WithModuleName True Inline Inherit (LPConstant 4) True False False + options = defaultOptions { importAlign = Group, listAlign = WithModuleName } in assertSnippet (step (Just 80) options) input [ "module Herp where" @@ -371,7 +384,11 @@ case12 :: Assertion case12 = let - options = Options Group NewLine True Inline Inherit (LPConstant 2) True False False + options = defaultOptions + { importAlign = Group + , listAlign = NewLine + , listPadding = LPConstant 2 + } in assertSnippet (step (Just 80) options) [ "import Data.List (map)" @@ -385,7 +402,11 @@ case12b :: Assertion case12b = let - options = Options Group WithModuleName True Inline Inherit (LPConstant 2) True False False + options = defaultOptions + { importAlign = Group + , listAlign = WithModuleName + , listPadding = LPConstant 2 + } in assertSnippet (step (Just 80) options) ["import Data.List (map)"] @@ -396,7 +417,11 @@ case13 :: Assertion case13 = let - options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False False + options = defaultOptions + { importAlign = None + , listAlign = WithAlias + , longListAlign = InlineWithBreak + } in assertSnippet (step (Just 80) options) [ "import qualified Data.List as List (concat, foldl, foldr, head, init," @@ -410,7 +435,11 @@ case13b :: Assertion case13b = let - options = Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False False + options = defaultOptions + { importAlign = None + , listAlign = WithModuleName + , longListAlign = InlineWithBreak + } in assertSnippet (step (Just 80) options) [ "import qualified Data.List as List (concat, foldl, foldr, head, init," @@ -426,7 +455,12 @@ case14 :: Assertion case14 = let - options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False False + options = defaultOptions + { importAlign = None + , listAlign = WithAlias + , longListAlign = InlineWithBreak + , listPadding = LPConstant 10 + } in assertSnippet (step (Just 80) options) [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" @@ -439,7 +473,7 @@ case15 :: Assertion case15 = let - options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False False + options = defaultOptions { importAlign = None, longListAlign = Multiline } in assertSnippet (step (Just 80) options) [ "import Data.Acid (AcidState)" @@ -464,7 +498,11 @@ case16 :: Assertion case16 = let - options = Options None AfterAlias True Multiline Inherit (LPConstant 4) False False False + options = defaultOptions + { importAlign = None + , longListAlign = Multiline + , separateLists = False + } in assertSnippet (step (Just 80) options) [ "import Data.Acid (AcidState)" @@ -487,7 +525,7 @@ case17 :: Assertion case17 = let - options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False False + options = defaultOptions { importAlign = None, longListAlign = Multiline } in assertSnippet (step (Just 80) options) [ "import Control.Applicative (Applicative ((<*>),pure))" @@ -504,7 +542,7 @@ case18 :: Assertion case18 = let - options = Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False False + options = defaultOptions { importAlign = None, longListAlign = InlineToMultiline } in assertSnippet (step (Just 40) options) [ "import Data.Foo as Foo (Bar, Baz, Foo)" @@ -531,7 +569,12 @@ case19 :: Assertion case19 = let - options = Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False False + options = defaultOptions + { listAlign = NewLine + , longListAlign = InlineWithBreak + , emptyListAlign = RightAfter + , listPadding = LPConstant 17 + } in assertSnippet (step (Just 40) options) case19input ---------------------------------------- @@ -547,7 +590,13 @@ case19b :: Assertion case19b = let - options = Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False False + options = defaultOptions + { importAlign = File + , listAlign = NewLine + , longListAlign = InlineWithBreak + , emptyListAlign = RightAfter + , listPadding = LPConstant 17 + } in assertSnippet (step (Just 40) options) case19input ---------------------------------------- @@ -562,7 +611,13 @@ case19c :: Assertion case19c = let - options = Options File NewLine True InlineWithBreak RightAfter LPModuleName True False False + options = defaultOptions + { importAlign = File + , listAlign = NewLine + , longListAlign = InlineWithBreak + , emptyListAlign = RightAfter + , listPadding = LPModuleName + } in assertSnippet (step (Just 40) options) case19input ---------------------------------------- @@ -577,7 +632,12 @@ case19d :: Assertion case19d = let - options = Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False False + options = defaultOptions + { listAlign = NewLine + , longListAlign = InlineWithBreak + , emptyListAlign = RightAfter + , listPadding = LPModuleName + } in assertSnippet (step (Just 40) options) case19input ---------------------------------------- @@ -669,7 +729,11 @@ case23 :: Assertion case23 = let - options = Options None AfterAlias False Inline Inherit (LPConstant 4) True True False + options = defaultOptions + { importAlign = None + , padModuleNames = False + , spaceSurround = True + } in assertSnippet (step (Just 40) options) [ "import Data.Acid (AcidState)" @@ -694,7 +758,12 @@ case23b :: Assertion case23b = let - options = Options None WithModuleName False Inline Inherit (LPConstant 4) True True False + options = defaultOptions + { importAlign = None + , listAlign = WithModuleName + , padModuleNames = False + , spaceSurround = True + } in assertSnippet (step (Just 40) options) [ "import Data.Acid (AcidState)" @@ -720,7 +789,12 @@ case24 :: Assertion case24 = let - options = Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True False + options = defaultOptions + { importAlign = None + , padModuleNames = False + , longListAlign = InlineWithBreak + , spaceSurround = True + } in assertSnippet (step (Just 40) options) [ "import Data.Acid (AcidState)" @@ -744,7 +818,12 @@ case25 :: Assertion case25 = let - options = Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False False + options = defaultOptions + { importAlign = Group + , padModuleNames = False + , longListAlign = Multiline + , separateLists = False + } in assertSnippet (step (Just 80) options) [ "import Data.Acid (AcidState)" @@ -930,3 +1009,285 @@ [ "import Happstack.Server" , "import HSP" ] + +-------------------------------------------------------------------------------- +case39 :: Assertion +case39 = assertSnippet (step Nothing options) + [ "import Something.A" + , "import SomethingElse.A" + , "import SomeThing.B" + , "import SomeThingelse.B" + ] + [ "import SomeThing.B" + , "" + , "import SomeThingelse.B" + , "" + , "import Something.A" + , "" + , "import SomethingElse.A" + ] + where options = defaultOptions { groupImports = True } + +-------------------------------------------------------------------------------- +case40 :: Assertion +case40 = assertSnippet (step Nothing options) + [ "import Data.Default.Class (Default(def))" + , "import qualified Data.Aeson as JSON" + , "import qualified Data.Aeson as JSON" + , "import Control.Monad" + , "import Control.Monad" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + , "import Data.Foo (Foo (Foo,Bar))" + , "import Data.Set (empty, intersect)" + , "import Data.Set (empty, nub)" + ] + [ "import Control.Monad" + , "" + , "import Data.Aeson qualified as JSON" + , "import Data.Default.Class (Default (def))" + , "import Data.Foo (Foo (Bar, Foo), Goo (Goo))" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import Data.Maybe.Extra qualified (Maybe (Just, Nothing))" + , "import Data.Set (empty, intersect, nub)" + ] + where options = defaultOptions { groupImports = True, postQualified = True } + +-------------------------------------------------------------------------------- +case41 :: Assertion +case41 = assertSnippet (step Nothing options) + [ "import Data.Default.Class (Default(def))" + , "import qualified Data.Aeson as JSON" + , "import Control.Monad" + , "import Control.Monad" + , "import qualified Foo.Bar.Baz" + , "" + , "import Data.Set (empty, intersect)" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" + , "" + , "import qualified Data.Aeson as JSON" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + , "import Data.Foo (Foo (Foo,Bar))" + , "import Data.Set (empty, nub)" + , "import Foo.Bar.Baz (Foo)" + ] + [ "import Control.Monad" + , "" + , "import qualified Data.Aeson as JSON" + , "import Data.Default.Class (Default (def))" + , "import Data.Foo (Foo (Bar, Foo), Goo (Goo))" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe (Just, Nothing))" + , "import Data.Set (empty, intersect, nub)" + , "" + , "import Foo.Bar.Baz (Foo)" + , "import qualified Foo.Bar.Baz" + ] + where options = defaultOptions { groupImports = True, importAlign = Group } + +-------------------------------------------------------------------------------- +case42 :: Assertion +case42 = + assertSnippet (step (Just 80) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default (def))" + , "import Control.Monad" + , "" + , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + ] + [ "import Control.Monad" + , "" + , "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + ] + where options = defaultOptions + { groupImports = True + , importAlign = None + , longListAlign = Multiline + } + +-------------------------------------------------------------------------------- +case43 :: Assertion +case43 = + assertSnippet (step (Just 80) options) + [ "import Project.Internal.Blah" + , "import Project.Something" + , "import Control.Monad" + , "" + , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + , "" + , "import qualified Project.Internal.Blarg as Blarg" + , "import Control.Applicative" + , "import Data.Functor" + , "import Data.Acid (AcidState)" + , "import Project" + , "" + , "import Data.Map (Map)" + , "import qualified Data.Map as Map" + ] + [ "import Project.Internal.Blah" + , "import qualified Project.Internal.Blarg as Blarg" + , "" + , "import Project" + , "import Project.Something" + , "" + , "import Control.Applicative" + , "import Control.Monad" + , "" + , "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + , "import Data.Functor" + , "import Data.Map (Map)" + , "import qualified Data.Map as Map" + ] + where options = defaultOptions + { groupImports = True + , groupRules = + [ GroupRule + { match = unsafeParsePattern "Project\\.Internal" + , subGroup = Nothing + } + , GroupRule + { match = unsafeParsePattern "Project" + , subGroup = Nothing + } + , GroupRule + { match = unsafeParsePattern ".*" + , subGroup = Just $ unsafeParsePattern "^[^.]+" + } + ] + , importAlign = None + , longListAlign = Multiline + } + +-------------------------------------------------------------------------------- +case44a :: Assertion +case44a = + assertSnippet (step (Just 80) options) + [ "import Project" + , "import Control.Monad" + , "" + , "import qualified Data.Acid as Acid" + , "import Project.Something" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + , "import ProJect.WrongCapitalization" + ] + [ "import Project" + , "import Project.Something" + , "" + , "import Control.Monad" + , "import qualified Data.Acid as Acid" + , "import Data.Default.Class (Default (def))" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + , "import ProJect.WrongCapitalization" + ] + where options = defaultOptions + { groupImports = True + , groupRules = [ GroupRule + { match = unsafeParsePattern "Project" + , subGroup = Nothing + } + ] + , importAlign = None + } + +-------------------------------------------------------------------------------- +case44b :: Assertion +case44b = + assertSnippet (step (Just 80) options) + [ "import Project" + , "import Control.Monad" + , "" + , "import qualified Data.Acid as Acid" + , "import Project.Something" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + , "import ProJect.WrongCapitalization" + ] + [ "import Project" + , "import Project.Something" + , "" + , "import qualified Data.Acid as Acid" + , "" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + , "" + , "import Control.Monad" + , "" + , "import ProJect.WrongCapitalization" + ] + where options = defaultOptions + { groupImports = True + , groupRules = + [ GroupRule + { match = unsafeParsePattern "Project" + , subGroup = Nothing + } + , GroupRule + { match = unsafeParsePattern "[^.]+\\.[^.]+" + , subGroup = Just $ unsafeParsePattern "\\.[^.]+" + } + ] + , importAlign = None + } + + +-------------------------------------------------------------------------------- +case44c :: Assertion +case44c = + assertSnippet (step (Just 80) options) + [ "import Project" + , "import Control.Monad" + , "" + , "import qualified Data.Acid as Acid" + , "import Project.Something" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + , "import ProJect.WrongCapitalization" + ] + [ "import Project" + , "import Project.Something" + , "" + , "import Control.Monad" + , "import qualified Data.Acid as Acid" + , "import Data.Default.Class (Default (def))" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + , "import ProJect.WrongCapitalization" + ] + where options = defaultOptions + { groupImports = True + , groupRules = + [ GroupRule + { match = unsafeParsePattern "Project" + , subGroup = Nothing + } + , GroupRule + { match = unsafeParsePattern "[^.]+\\.[^.]+" + , subGroup = Nothing + } + ] + , importAlign = None + } diff --git a/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs b/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs --- a/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs @@ -21,6 +21,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.UnicodeSyntax.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 + , testCase "case 03" case03 ] @@ -45,4 +46,15 @@ [ "{-# LaNgUaGe UnicodeSyntax #-}" , "sort ∷ Ord a ⇒ [a] → [a]" , "sort _ = []" + ] + + +-------------------------------------------------------------------------------- +case03 :: Assertion +case03 = assertSnippet (step False "LANGUAGE") + [ "x :: Int -> Int -> Int" + , "x = undefined" + ] + [ "x ∷ Int → Int → Int" + , "x = undefined" ]