diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ import block sorted, with optional rules for grouping. Support for unqualified imports is limited to symbols you explicitly configure, -so if you list `System.FilePath.()`, it will add that import when you use +so if you list `System.FilePath (())`, it will add that import when you use it, or remove when it's no longer used, but it won't go search modules for unqualified imports. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,16 @@ +### 2.2.0 + +- fix bugs where pretty printing didn't work right for +leave-space-for-unqualified + +- add `format: columns=n` field + +- separate qualify-as fields with ; instead of , + +- fix a bug where I didn't allow _ in unqualified import names + +- better error reporting + ### 2.1.0 - unqualified syntax changed to support multiple imports per module diff --git a/dot-fix-imports b/dot-fix-imports --- a/dot-fix-imports +++ b/dot-fix-imports @@ -39,7 +39,7 @@ unqualified: Data.Bifunctor (first, second); System.FilePath (()) -- DTL.something will turn into a search for Data.Text.Lazy. -qualify-as: Data.Text.Lazy as DTL +qualify-as: Data.Text.Lazy as DTL; Data.Vector.Unboxed as VU format: -- Insert a space gap for the "qualified" keyword. @@ -47,6 +47,9 @@ -- Suppress the usual behaviour where imports are grouped by the first -- component. no-group + -- If there is a long explicit import list, it might have to be wrapped. + -- Wrap to this many columns. + columns=80 -- Space separate list of extensions that are enabled by default. language: GeneralizedNewtypeDeriving diff --git a/fix-imports.cabal b/fix-imports.cabal --- a/fix-imports.cabal +++ b/fix-imports.cabal @@ -1,5 +1,5 @@ name: fix-imports -version: 2.1.0 +version: 2.2.0 cabal-version: >= 1.10 build-type: Simple synopsis: Program to manage the imports of a haskell module diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -5,15 +5,15 @@ {-# LANGUAGE PartialTypeSignatures #-} -- sort keys only care about Ord {-# OPTIONS_GHC -Wno-partial-type-signatures #-} module Config where -import Control.Monad (foldM, unless) -import Data.Bifunctor (second) +import Control.Monad (foldM, unless) +import Data.Bifunctor (second) import qualified Data.Char as Char import qualified Data.Either as Either import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified Data.Text as Text -import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text.IO as Text.IO import qualified Data.Tuple as Tuple @@ -22,7 +22,8 @@ import qualified System.FilePath as FilePath import qualified System.IO as IO import qualified Text.PrettyPrint as PP -import Text.PrettyPrint ((<+>)) +import Text.PrettyPrint ((<+>)) +import qualified Text.Read as Read import qualified Index import qualified Types @@ -74,15 +75,12 @@ mempty = Priority mempty mempty data Format = Format { - -- | How to format import lines. Nothing to use the standard - -- haskell-src-exts style with defaultMode. - _ppConfig :: Maybe PPConfig -- | If true, group imports by their first component. - , _groupImports :: Bool - } deriving (Eq, Show) - -data PPConfig = PPConfig { - _leaveSpaceForQualified :: Bool + _groupImports :: Bool + -- | Insert space for unqualified imports to make the modules line up. + , _leaveSpaceForQualified :: Bool + -- | Number of columns to wrap to. + , _columns :: Int } deriving (Eq, Show) -- | A simple pattern: @M.@ matches M and M.*. Anything else matches exactly. @@ -111,8 +109,9 @@ defaultFormat :: Format defaultFormat = Format - { _ppConfig = Nothing - , _groupImports = True + { _groupImports = True + , _leaveSpaceForQualified = False + , _columns = 80 } -- | Parse .fix-imports file. @@ -193,9 +192,13 @@ parseFormat :: [Text] -> Either Text Format parseFormat = foldM set defaultFormat where - set fmt "leave-space-for-qualified" = Right $ fmt - { _ppConfig = Just $ PPConfig { _leaveSpaceForQualified = True } } + set fmt "leave-space-for-qualified" = Right $ + fmt { _leaveSpaceForQualified = True } set fmt "no-group" = Right $ fmt { _groupImports = False } + set fmt w | Just cols <- Text.stripPrefix "columns=" w = + case Read.readMaybe (Text.unpack cols) of + Nothing -> Left $ "non-numeric: " <> w + Just cols -> Right $ fmt { _columns = cols } set _ w = Left $ "unrecognized word: " <> showt w -- | @@ -236,13 +239,13 @@ isModuleChar c = Char.isLetter c || Char.isDigit c || c == '.' -- | --- "A.B as AB, C as E" -> [("AB", "A.B"), ("E", "C")] +-- "A.B as AB; C as E" -> [("AB", "A.B"), ("E", "C")] parseQualifyAs :: Text -> ([Text], Map.Map Types.Qualification Types.Qualification) parseQualifyAs field | Text.null field = ([], mempty) | otherwise = second Map.fromList . Either.partitionEithers - . map (parse . Text.words) . Text.splitOn "," $ field + . map (parse . Text.words) . Text.splitOn ";" $ field where parse [module_, "as", alias] = Right ( Types.Qualification (Text.unpack alias) @@ -406,21 +409,28 @@ right = Util.join "\n" [cmt | Types.Comment Types.CmtRight cmt <- cmts] showImportDecl :: Format -> Types.ImportDecl -> String -showImportDecl format = case _ppConfig format of - Nothing -> Haskell.prettyPrintStyleMode style Haskell.defaultMode - Just config -> PP.renderStyle style . prettyImportDecl config +showImportDecl format = PP.renderStyle style . prettyImportDecl format where style = Haskell.style - { Haskell.lineLength = 80 + { Haskell.lineLength = _columns format , Haskell.ribbonsPerLine = 1 } -prettyImportDecl :: PPConfig -> Haskell.ImportDecl a -> PP.Doc -prettyImportDecl config +-- showImportDecl format = case _ppConfig format of +-- Nothing -> Haskell.prettyPrintStyleMode style Haskell.defaultMode +-- Just config -> PP.renderStyle style . prettyImportDecl config +-- where +-- style = Haskell.style +-- { Haskell.lineLength = _columns format +-- , Haskell.ribbonsPerLine = 1 +-- } + +prettyImportDecl :: Format -> Haskell.ImportDecl a -> PP.Doc +prettyImportDecl format (Haskell.ImportDecl _ m qual src safe mbPkg mbName mbSpecs) = do - PP.hsep + mySep [ "import" - , if qual || not (_leaveSpaceForQualified config) then mempty + , if qual || not (_leaveSpaceForQualified format) then mempty else PP.text (replicate (length ("qualified" :: String)) ' ') , if src then "{-# SOURCE #-}" else mempty , if safe then "safe" else mempty @@ -483,11 +493,15 @@ ppName (Haskell.Symbol _ s) = PP.text s parenList :: [PP.Doc] -> PP.Doc -parenList = PP.parens . PP.hsep . PP.punctuate PP.comma +parenList = PP.parens . PP.fsep . PP.punctuate PP.comma pretty :: Haskell.Pretty a => a -> PP.Doc pretty _ = "?" +mySep :: [PP.Doc] -> PP.Doc +mySep [] = error "mySep got empty" +mySep [x] = x +mySep (x:xs) = x <+> PP.fsep xs -- * log diff --git a/src/Config_test.hs b/src/Config_test.hs --- a/src/Config_test.hs +++ b/src/Config_test.hs @@ -3,7 +3,6 @@ module Config_test where import qualified Data.Map as Map import qualified Data.Text as Text -import EL.Test.Global import qualified EL.Test.Testing as Testing import qualified Language.Haskell.Exts as Haskell @@ -11,7 +10,9 @@ import qualified FixImports import qualified Types +import EL.Test.Global + test_parse = do let f = check . Config.parse . Text.unlines check (config, errs) @@ -43,7 +44,7 @@ test_parseQualifyAs = do let f = Config._qualifyAs . parseConfig - equal (f ["qualify-as: A.B as AB, E as F"]) $ Map.fromList + equal (f ["qualify-as: A.B as AB; E as F"]) $ Map.fromList [ ("AB", "A.B") , ("F", "E") ] @@ -124,14 +125,34 @@ ] test_showImportLine = do - let f = fmap (Config.showImportDecl style . Types.importDecl . head) - . parse - style = Config.defaultFormat - { Config._ppConfig = Just $ Config.PPConfig - { _leaveSpaceForQualified = True } - } + let f = fmap (Config.showImportDecl style . Types.importDecl . head) . parse + style = Config.defaultFormat { Config._leaveSpaceForQualified = True } -- pprint $ fmap (Types.importDecl . head) . parse $ "import A.B as C (x)" equal (f "import A.B as C (x)") $ Right "import A.B as C (x)" + +test_leaveSpaceForQualified = do + let f columns leaveSpace = + fmap (Config.showImportDecl (fmt columns leaveSpace) . head + . map Types.importDecl) + . parse + fmt columns leaveSpace = Config.defaultFormat + { Config._columns = columns + , Config._leaveSpaceForQualified = leaveSpace + } + equal (f 80 False "import Foo.Bar (a, b, c)") $ + Right "import Foo.Bar (a, b, c)" + equal (f 80 True "import Foo.Bar (a, b, c)") $ + Right "import Foo.Bar (a, b, c)" + + equal (f 20 False "import Foo.Bar (a, b, c)") $ + Right "import Foo.Bar\n (a, b, c)" + equal (f 30 True "import Foo.Bar (a, b, c)") $ + Right "import Foo.Bar\n (a, b, c)" + + equal (f 30 True "import Foo.Bar (tweetle, beetle, paddle, battle)") $ Right + "import Foo.Bar\n\ + \ (tweetle, beetle,\n\ + \ paddle, battle)" -- * util diff --git a/src/FixImports.hs b/src/FixImports.hs --- a/src/FixImports.hs +++ b/src/FixImports.hs @@ -1,6 +1,6 @@ {- | Automatically fix the import list in a haskell module. - This only really works for qualified names. The process is as follows: + The process is as follows: - Parse the entire file and extract the Qualification of qualified names like @A.b@, which is simple @A@. diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -27,25 +27,24 @@ main :: IO () main = do + -- I need the module path to search for modules relative to it first. I + -- could figure it out from the parsed module name, but a main module may + -- not have a name. + (modulePath, flags) <- parseArgs =<< Environment.getArgs (config, errors) <- readConfig ".fix-imports" if null errors - then mainConfig config + then mainConfig config flags modulePath else do - IO.putStr =<< IO.getContents - mapM_ (Text.IO.hPutStrLn IO.stderr) errors + Text.IO.hPutStrLn IO.stderr $ Text.unlines errors Exit.exitFailure readConfig :: FilePath -> IO (Config.Config, [Text.Text]) readConfig = fmap (maybe (Config.empty, []) Config.parse) . Util.catchENOENT . Text.IO.readFile -mainConfig :: Config.Config -> IO () -mainConfig config = do - -- I need the module path to search for modules relative to it first. I - -- could figure it out from the parsed module name, but a main module may - -- not have a name. - (modulePath, (verbose, debug, includes)) <- - parseArgs =<< Environment.getArgs +mainConfig :: Config.Config -> [Flag] -> FilePath -> IO () +mainConfig config flags modulePath = do + let (verbose, debug, includes) = extractFlags flags source <- IO.getContents config <- return $ config { Config._includes = includes ++ Config._includes config @@ -66,7 +65,7 @@ mDone <- FixImports.metric metrics "done" Config.debug config $ Text.stripEnd $ FixImports.showMetrics (mDone : metrics) - when (verbose && (not (null addedMsg) || not (null removedMsg))) $ + when (verbose && not (null addedMsg) || not (null removedMsg)) $ IO.hPutStrLn IO.stderr $ Util.join "; " $ filter (not . null) [ if null addedMsg then "" else "added: " ++ addedMsg , if null removedMsg then "" else "removed: " ++ removedMsg @@ -86,23 +85,26 @@ "print added and removed modules on stderr" ] -usage :: String -> IO a -usage msg = do - name <- Environment.getProgName - putStr $ GetOpt.usageInfo (msg ++ "\n" ++ name ++ " Module.hs IO (String, (Bool, Bool, [FilePath])) +parseArgs :: [String] -> IO (String, [Flag]) parseArgs args = case GetOpt.getOpt GetOpt.Permute options args of - (flags, [modulePath], []) -> return (modulePath, parse flags) + (flags, [modulePath], []) -> return (modulePath, flags) (_, [], errs) -> usage $ concat errs _ -> usage "too many args" - where - parse flags = - ( Verbose `elem` flags - , Debug `elem` flags - , "." : [p | Include p <- flags] - ) + +extractFlags :: [Flag] -> (Bool, Bool, [FilePath]) +extractFlags flags = + ( Verbose `elem` flags + , Debug `elem` flags + , "." : [p | Include p <- flags] + ) -- Includes always have the current directory first. + +usage :: String -> IO a +usage msg = do + name <- Environment.getProgName + IO.hPutStr IO.stderr $ + GetOpt.usageInfo (msg ++ "\n" ++ name ++ " Module.hs Bool haskellOpChar c = IntSet.member (Char.ord c) opChars - || isSymbolCharacterCategory (Char.generalCategory c) + || (IntSet.notMember (Char.ord c) exceptions + && isSymbolCharacterCategory (Char.generalCategory c)) where - opChars :: IntSet.IntSet opChars = IntSet.fromList $ map Char.ord "-!#$%&*+./<=>?@^|~:\\" + exceptions = IntSet.fromList $ map Char.ord "_\"'" isSymbolCharacterCategory :: Char.GeneralCategory -> Bool isSymbolCharacterCategory cat = Set.member cat symbolCategories