fix-imports 2.2.0 → 2.3.0
raw patch · 8 files changed
+180/−147 lines, 8 files
Files
- README.md +29/−0
- changelog.md +8/−0
- dot-fix-imports +5/−4
- fix-imports.cabal +2/−1
- src/FixImports.hs +47/−26
- src/FixImports_test.hs +40/−74
- src/Main.hs +21/−9
- vimrc +28/−33
README.md view
@@ -13,3 +13,32 @@ Since it's a unix-style filter, it should be possible to integrate into any editor. There's an example vimrc to bind to a key in vim.++### Usage:++Normally you would integrate it with your editor (see `vimrc` for a vim+example), but for testing, here's an example invocation:++ fix-imports -i src -i test src/A/B/C.hs <src/A/B/C.hs+ [ fixed contents of A/B/C.hs, or an error ]++The `-i` flag is like ghc's `-i` flag, it will add an aditional root to the+module search path. The example will find modules in both `test/*` and+`src/*`, in addition to the global package db.++About the global package db, `fix-imports` uses the `ghc-pkg` command to find+packages, so it will see whatever you see if you do `ghc-pkg list`. If it+doesn't see the right things for your package, say for the new nix-style+builds, you'll have to figure out how to fix that. As is usual for cabal and+ghc integration, ghc has several overlapping but documented configuration+methods, and cabal is completely undocumented. The relevant bits for ghc are+GHC_PACKAGE_PATH and perhaps package environments:+https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/packages.html#the-ghc-package-path-environment-variable+Cabal doesn't seem to document how to get the appropriate package path for a+nix-style build. I don't use cabal so I haven't figured this out yet, but+let me know if you know or figure it out.++I don't use stack either, but my understanding is this is enough to get+`ghc-pkg` working:++ export GHC_PACKAGE_PATH=$(stack path --ghc-package-path)
changelog.md view
@@ -1,3 +1,11 @@+### 2.3.0++- add --edit flag, so I can just replace imports, instead of the whole file++- add logging, and show findModule info when passed --debug++- Add --config flag to explicitly set the config file.+ ### 2.2.0 - fix bugs where pretty printing didn't work right for
dot-fix-imports view
@@ -1,5 +1,5 @@ -- fix-imports looks for a .fix-imports file in the current directory for--- per-project configuration.+-- per-project configuration. You can set the file explicitly with --config. -- -- The syntax is like ghc-pkg or cabal: word, colon, and a list of words. -- A line with leading space is a continuation of the previous line.@@ -15,8 +15,9 @@ import-order-first: Util. -- These go in the given order, but after all the other imports. import-order-last: Global--- If present at all, unqualified import-all lines always go last.--- They should be special, and this helps them stand out.+-- If present at all (the 't' argument is irrelevant), unqualified import-all+-- lines always go last. The idea is that they should be special, and this+-- helps them stand out. sort-unqualified-last: t -- When there are multiple candidates for a module, prefer or don't prefer@@ -51,5 +52,5 @@ -- Wrap to this many columns. columns=80 --- Space separate list of extensions that are enabled by default.+-- Space separated list of extensions that are enabled by default. language: GeneralizedNewtypeDeriving
fix-imports.cabal view
@@ -1,5 +1,5 @@ name: fix-imports-version: 2.2.0+version: 2.3.0 cabal-version: >= 1.10 build-type: Simple synopsis: Program to manage the imports of a haskell module@@ -52,6 +52,7 @@ , directory , filepath , haskell-src-exts >= 1.16.0+ , mtl , process , split , text
src/FixImports.hs view
@@ -42,7 +42,9 @@ module FixImports where import Prelude hiding (mod) import Control.Applicative ((<$>))+import qualified Control.Monad.State.Strict as State import qualified Control.DeepSeq as DeepSeq+import Control.Monad.Trans (lift) import Data.Bifunctor (first) import qualified Data.Char as Char import qualified Data.Either as Either@@ -73,32 +75,42 @@ import Control.Monad +-- | Look only this deep for local modules.+searchDepth :: Int+searchDepth = 12+ data Result = Result {- resultText :: String+ resultRange :: (Row, Row)+ , resultImports :: String , resultAdded :: Set.Set Types.ModuleName , resultRemoved :: Set.Set Types.ModuleName , resultMetrics :: [Metric] } deriving (Show) +-- | Line number in the input file.+type Row = Int+ type Metric = (Clock.UTCTime, Text) addMetrics :: [Metric] -> Result -> Result addMetrics ms result = result { resultMetrics = ms ++ resultMetrics result } -fixModule :: Config.Config -> FilePath -> String -> IO (Either String Result)+fixModule :: Config.Config -> FilePath -> String+ -> IO (Either String Result, [Text]) fixModule config modulePath source = do mStart <- metric () "start" processedSource <- cppModule modulePath source mCpp <- metric () "cpp" case parse (Config._language config) modulePath processedSource of Haskell.ParseFailed srcloc err ->- return $ Left $ Haskell.prettyPrint srcloc ++ ": " ++ err+ return (Left $ Haskell.prettyPrint srcloc ++ ": " ++ err, []) Haskell.ParseOk (mod, cmts) -> do mParse <- metric (mod `seq` (), cmts) "parse" index <- Index.load mLoad <- metric () "load-index"- fmap (addMetrics [mStart, mCpp, mParse, mLoad]) <$>- fixImports ioFilesystem config index modulePath mod cmts source+ fmap (fmap List.reverse) $ flip State.runStateT [] $+ fmap (addMetrics [mStart, mCpp, mParse, mLoad]) <$>+ fixImports ioFilesystem config index modulePath mod cmts parse :: [Extension.Extension] -> FilePath -> String -> Haskell.ParseResult@@ -159,26 +171,33 @@ , _metric = metric } +type LogT m a = State.StateT [Text] m a++debug :: Monad m => Config.Config -> Text -> LogT m ()+debug config msg = when (Config._debug config) $ State.modify' (msg:)+ -- The check is unnecessary since I check debug before printing them, but+ -- it'll save a thunk at least.+ -- | Take a parsed module along with its unparsed text. Generate a new import -- block with proper spacing, formatting, and comments. Then snip out the -- import block on the import file, and replace it. fixImports :: Monad m => Filesystem m -> Config.Config -> Index.Index- -> FilePath -> Types.Module -> [Haskell.Comment] -> String- -> m (Either String Result)-fixImports fs config index modulePath mod cmts source = do+ -> FilePath -> Types.Module -> [Haskell.Comment]+ -> LogT m (Either String Result)+fixImports fs config index modulePath mod cmts = do let (newImports, unusedImports, imports, range) = importInfo mod cmts- mProcess <- _metric fs+ mProcess <- lift $ _metric fs (length newImports, length unusedImports, length imports, range) "process" mbNew <- mapM (findNewImport fs config modulePath index) (Set.toList newImports)- mNewImports <- _metric fs mbNew "find-new-imports"+ mNewImports <- lift $ _metric fs mbNew "find-new-imports" (imports, newUnqualImports, unusedUnqual) <- return $ fixUnqualified config mod imports- newUnqualImports <- mapM (locateImport fs) newUnqualImports- mUnqual <- _metric fs newUnqualImports "unqualified-imports"+ newUnqualImports <- lift $ mapM (locateImport fs) newUnqualImports+ mUnqual <- lift $ _metric fs newUnqualImports "unqualified-imports" mbExisting <- mapM (findImport fs index (Config._includes config)) imports- mExistingImports <- _metric fs mbExisting "find-existing-imports"+ mExistingImports <- lift $ _metric fs mbExisting "find-existing-imports" let existing = map (Types.importDeclModule . fst) imports let (notFound, importLines) = Either.partitionEithers $ zipWith mkError@@ -193,7 +212,8 @@ _ : _ -> Left $ "not found: " ++ Util.join ", " (map Types.moduleName notFound) [] -> Right $ Result- { resultText = substituteImports formattedImports range source+ { resultRange = range+ , resultImports = formattedImports , resultAdded = Set.fromList $ map (Types.importDeclModule . Types.importDecl) $ Maybe.catMaybes mbNew ++ newUnqualImports@@ -341,7 +361,7 @@ -- | Make a new ImportLine from a ModuleName. findNewImport :: Monad m => Filesystem m -> Config.Config -> FilePath -> Index.Index -> Types.Qualification- -> m (Maybe Types.ImportLine)+ -> LogT m (Maybe Types.ImportLine) -- ^ Nothing if the module wasn't found findNewImport fs config modulePath index qual = fmap make <$> findModule fs config index modulePath qual@@ -380,7 +400,7 @@ -- or Types.Package module. Nothing if it wasn't found at all. findModule :: Monad m => Filesystem m -> Config.Config -> Index.Index -> FilePath -- ^ Path to the module being fixed.- -> Types.Qualification -> m (Maybe (Types.ModuleName, Types.Source))+ -> Types.Qualification -> LogT m (Maybe (Types.ModuleName, Types.Source)) findModule fs config index modulePath qual = do local <- map fnameToModule <$> ((++) <$> findLocalModules fs (Config._includes config) qual@@ -388,9 +408,9 @@ qualifyAs) let package = map (first Just) $ findPackageModules qual ++ maybe [] findPackageModules qualifyAs- -- Config.debug config $ "findModule " <> showt qual <> " from "- -- <> showt modulePath <> ": local " <> showt found- -- <> "\npackage: " <> showt package+ debug config $ "findModule " <> showt qual <> " from "+ <> showt modulePath <> ": local " <> showt local+ <> "\npackage: " <> showt package let prio = Config._modulePriority config return $ case Config.pickModule prio modulePath (local++package) of Just (package, mod) -> Just@@ -407,10 +427,11 @@ -- | Given A.B, look for A/B.hs, */A/B.hs, */*/A/B.hs, etc. in each of the -- include paths. findLocalModules :: Monad m => Filesystem m -> [FilePath]- -> Types.Qualification -> m [FilePath]+ -> Types.Qualification -> LogT m [FilePath] findLocalModules fs includes (Types.Qualification name) = fmap concat . forM includes $ \dir -> map (stripDir dir) <$>- findFiles fs 4 (Types.moduleToPath (Types.ModuleName name)) dir+ findFiles fs searchDepth (Types.moduleToPath (Types.ModuleName name))+ dir stripDir :: FilePath -> FilePath -> FilePath stripDir dir path@@ -421,9 +442,9 @@ -> Int -- ^ Descend into subdirectories this many times. -> FilePath -- ^ Find files with this suffix. Can contain slashes. -> FilePath -- ^ Start from this directory. Return [] if it doesn't exist.- -> m [FilePath]+ -> LogT m [FilePath] findFiles fs depth file dir = do- (subdirs, fns) <- _listDir fs dir+ (subdirs, fns) <- lift $ _listDir fs dir subfns <- if depth > 0 then concat <$> mapM (findFiles fs (depth-1) file) (filter isModuleDir subdirs)@@ -439,7 +460,7 @@ -- | Make an existing import into an ImportLine by finding out if it's a local -- module or a package module. findImport :: Monad m => Filesystem m -> Index.Index -> [FilePath] -> ImportLine- -> m (Maybe Types.ImportLine)+ -> LogT m (Maybe Types.ImportLine) findImport fs index includes (imp, cmts) = do found <- findModuleName fs index includes (Types.importDeclModule imp) return $ case found of@@ -453,9 +474,9 @@ -- | True if it was found in a local directory, False if it was found in the -- ghc package db, and Nothing if it wasn't found at all. findModuleName :: Monad m => Filesystem m -> Index.Index -> [FilePath]- -> Types.ModuleName -> m (Maybe Types.Source)+ -> Types.ModuleName -> LogT m (Maybe Types.Source) findModuleName fs index includes mod = do- isLocal <- isLocalModule fs mod ("" : includes)+ isLocal <- lift $ isLocalModule fs mod ("" : includes) return $ if isLocal then Just Types.Local else if isPackageModule index mod then Just Types.Package
src/FixImports_test.hs view
@@ -3,6 +3,7 @@ module FixImports_test where import Control.Monad (unless, void) import qualified Control.Monad.Identity as Identity+import qualified Control.Monad.State.Strict as State import Data.Bifunctor (bimap) import qualified Data.List as List import qualified Data.Map as Map@@ -23,33 +24,27 @@ test_simple = do- let run config = fmap FixImports.resultText+ let run config = fmap FixImports.resultImports . fixModule index ["C.hs"] (mkConfig config) "A.hs" index = Index.makeIndex [ ("pkg", ["A.B"]) , ("zpkg", ["Z"]) ]- equal (run "" "x = B.c") $ Right- "import qualified A.B as B\n\- \x = B.c\n"- equal (run "" "x = A.B.c") $ Right- "import qualified A.B\n\- \x = A.B.c\n"+ equal (run "" "x = B.c") $ Right "import qualified A.B as B\n"+ equal (run "" "x = A.B.c") $ Right "import qualified A.B\n" leftLike (run "" "x = Q.c") "not found: Q" -- Remove unused.- equal (run "" "import qualified A.B as B\n\nx = y") $ Right- "\nx = y\n"+ equal (run "" "import qualified A.B as B\n\nx = y") $ Right "" -- Unless it's unqualified. equal (run "" "import A.B as B\n\nx = y") $ Right- "import A.B as B\n\nx = y\n"+ "import A.B as B\n" -- Local goes below package. equal (run "" "x = (B.a, C.a, Z.a)") $ Right "import qualified A.B as B\n\ \import qualified Z\n\ \\n\- \import qualified C\n\- \x = (B.a, C.a, Z.a)\n"+ \import qualified C\n" -- Don't mess with imports I don't manage. equal (run "" "import A.B hiding (mod)\n") $@@ -64,7 +59,7 @@ equal (run config [] "x = DTL.y") $ Right ( ["Data.Text.Lazy"] , []- , "import qualified Data.Text.Lazy as DTL\nx = DTL.y\n"+ , "import qualified Data.Text.Lazy as DTL\n" ) equal (run config [] "import qualified Data.Text.Lazy as DTL\n") $ Right ( []@@ -75,7 +70,7 @@ -- qualifyAs aliases are prioritized in the same way as others, so -- the local module wins: equal (run config ["DTL.hs"] "x = DTL.y") $- Right (["DTL"], [], "import qualified DTL\nx = DTL.y\n")+ Right (["DTL"], [], "import qualified DTL\n") -- Unless explicitly suppressed: let config2 = mkConfig $ Text.unlines@@ -85,7 +80,7 @@ equal (run config2 ["DTL.hs"] "x = DTL.y") $ Right ( ["Data.Text.Lazy"] , []- , "import qualified Data.Text.Lazy as DTL\nx = DTL.y\n"+ , "import qualified Data.Text.Lazy as DTL\n" ) test_unqualified = do@@ -95,64 +90,60 @@ [ ("pkg", ["A.B"]) , ("zpkg", ["Z"]) ]- equal (run "unqualified: A.B (c)" "x = (c, c)") $ Right (["A.B"], [],- "import A.B (c)\n\- \x = (c, c)\n"+ equal (run "unqualified: A.B (c)" "x = (c, c)") $ Right+ ( ["A.B"]+ , []+ , "import A.B (c)\n" ) -- Modify an existing import.- equal (run "unqualified: A.B (c)" "import A.B (a, z)\nx = (c, c)") $- Right ([], [],- "import A.B (a, c, z)\n\- \x = (c, c)\n"+ equal (run "unqualified: A.B (c)" "import A.B (a, z)\nx = (c, c)") $ Right+ ( []+ , []+ , "import A.B (a, c, z)\n" )- equal (run "unqualified: A.B (a, c)" "import A.B (a, c)\nx = a") $- Right ([], [],- "import A.B (a)\n\- \x = a\n"+ equal (run "unqualified: A.B (a, c)" "import A.B (a, c)\nx = a") $ Right+ ( []+ , []+ , "import A.B (a)\n" ) -- Don't accumulate duplicates. equal (run "unqualified: A.B (c)" "import A.B (c)\nx = c") $- Right ([], [], "import A.B (c)\nx = c\n")+ Right ([], [], "import A.B (c)\n") equal (run "unqualified: A.B (C)" "import A.B (C)\nx :: C") $- Right ([], [],- "import A.B (C)\n\- \x :: C\n"- )+ Right ([], [], "import A.B (C)\n") -- Don't manage it if it's not mine. equal (run "unqualified: A.B (c)" "import A.B (d)") $ Right ([], [], "import A.B (d)\n") -- local still goes below package- equal (run "unqualified: C (a)" "import A.B\nimport Z\nx = a") $- Right (["C"], [],- "import A.B\n\- \import Z\n\- \\n\- \import C (a)\n\- \x = a\n"+ equal (run "unqualified: C (a)" "import A.B\nimport Z\nx = a") $ Right+ ( ["C"]+ , []+ , "import A.B\n\+ \import Z\n\+ \\n\+ \import C (a)\n" ) -- Don't import when it's an assignee.- equal (run "unqualified: A.B (c)" "c = x") $ Right ([], [], "c = x\n")- equal (run "unqualified: A.B ((</>))" "x = a </> b") $ Right (["A.B"], [],- "import A.B ((</>))\n\- \x = a </> b\n"- )+ equal (run "unqualified: A.B (c)" "c = x") $ Right ([], [], "")+ equal (run "unqualified: A.B ((</>))" "x = a </> b") $+ Right (["A.B"], [], "import A.B ((</>))\n") -- Removed unused. equal (run "unqualified: A.B (c)" "import A.B (c)\nx = x\n") $- Right ([], ["A.B"], "x = x\n")+ Right ([], ["A.B"], "") -- But not if it's a spec-less import. equal (run "unqualified: A.B (c)" "import A.B\nx = x\n") $- Right ([], [], "import A.B\nx = x\n")+ Right ([], [], "import A.B\n") eResult :: FixImports.Result -> ([Types.ModuleName], [Types.ModuleName], String) eResult r = ( Set.toList (FixImports.resultAdded r) , Set.toList (FixImports.resultRemoved r)- , FixImports.resultText r+ , FixImports.resultImports r ) fixModule :: Index.Index -> [FilePath]@@ -161,9 +152,10 @@ case FixImports.parse (Config._language config) modulePath source of Haskell.ParseFailed srcloc err -> Left $ Haskell.prettyPrint srcloc ++ ": " ++ err- Haskell.ParseOk (mod, cmts) -> Identity.runIdentity $+ Haskell.ParseOk (mod, cmts) ->+ fst $ Identity.runIdentity $ flip State.runStateT [] $ FixImports.fixImports (pureFilesystem files) config index- modulePath mod cmts source+ modulePath mod cmts -- | The ./ stuff is tricky, this is probably still wrong. pureFilesystem :: [FilePath] -> FixImports.Filesystem Identity.Identity@@ -200,32 +192,6 @@ | otherwise = error $ "parsing " <> show content <> ": " <> unlines (map Text.unpack errs) where (config, errs) = Config.parse content--tmod0 :: String-tmod0 =- "-- cmt1\n\- \-- cmt2\n\- \import Data.List\n\- \x = 42\n"--tmod1 = "module Foo\nwhere\n" ++ tmod0-tmod2 = "module Foo\nwhere\nx = 42\n"--tmod :: String-tmod =- "{-# LANGUAGE SomeExtension #-} -- comment on LANGUAGE\n\- \-- cmt1 for Data.List\n\- \-- cmt2 for Data.List\n\- \import qualified Data.List as C\n\- \-- cmt1 for Util\n\- \-- cmt2 for Util\n\- \import qualified Util -- cmt right of Util\n\- \import qualified Extra as Biz {- block cmt -}\n\- \import Data.Map (a,\n\- \ b)\n\- \\n\- \f :: Util.One -> Midi.New.Two -> Util.Foo -> C.Result\n\- \f x = x * C.z\n" -- * util
src/Main.hs view
@@ -31,7 +31,9 @@ -- 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"+ let configFile = if null fns then ".fix-imports" else last fns+ where fns = [fn | Config fn <- flags]+ (config, errors) <- readConfig configFile if null errors then mainConfig config flags modulePath else do@@ -50,19 +52,25 @@ { Config._includes = includes ++ Config._includes config , Config._debug = debug }- fixed <- FixImports.fixModule config modulePath source- `Exception.catch` (\(exc :: Exception.SomeException) ->- return $ Left $ "exception: " ++ show exc)+ (fixed, logs) <- FixImports.fixModule config modulePath source+ `Exception.catch` \(exc :: Exception.SomeException) ->+ return (Left $ "exception: " ++ show exc, []) case fixed of Left err -> do- IO.putStr source+ if Edit `elem` flags then putStrLn "0,0" else putStr source+ when debug $ mapM_ (Text.IO.hPutStrLn IO.stderr) logs IO.hPutStrLn IO.stderr $ "error: " ++ err Exit.exitFailure- Right (FixImports.Result source added removed metrics) -> do- IO.putStr source+ Right (FixImports.Result range imports added removed metrics) -> do+ if Edit `elem` flags+ then do+ putStrLn $ show (fst range) <> "," <> show (snd range)+ putStr imports+ else putStr $ FixImports.substituteImports imports range source let names = Util.join ", " . map Types.moduleName . Set.toList (addedMsg, removedMsg) = (names added, names removed) mDone <- FixImports.metric metrics "done"+ when debug $ mapM_ (Text.IO.hPutStrLn IO.stderr) logs Config.debug config $ Text.stripEnd $ FixImports.showMetrics (mDone : metrics) when (verbose && not (null addedMsg) || not (null removedMsg)) $@@ -72,12 +80,16 @@ ] Exit.exitSuccess -data Flag = Debug | Include String | Verbose+data Flag = Config FilePath | Debug | Edit | Include String | Verbose deriving (Eq, Show) options :: [GetOpt.OptDescr Flag] options =- [ GetOpt.Option [] ["debug"] (GetOpt.NoArg Debug)+ [ GetOpt.Option ['c'] ["config"] (GetOpt.ReqArg Config "path")+ "path to config file, defaults to .fix-imports"+ , GetOpt.Option [] ["edit"] (GetOpt.NoArg Edit)+ "print delete range and new import block, rather than the whole file"+ , GetOpt.Option [] ["debug"] (GetOpt.NoArg Debug) "print debugging info on stderr" , GetOpt.Option ['i'] [] (GetOpt.ReqArg Include "path") "add to module include path"
vimrc view
@@ -2,44 +2,39 @@ nm <silent> ,a :call FixImports()<cr> +" Parse --edit output and splice in the imports.+function s:ReplaceImports(lines)+ let [start, end] = split(a:lines[0], ',')+ " Otherwise vim does string comparison.+ if end+0 > start+0+ " This stupidity is necessary because vim apparently has no way to+ " delete lines.+ let old_line = line('.')+ let old_col = col('.')+ let old_total = line('$')+ silent execute (start+1) . ',' . end . 'delete _'+ " If the import fix added or removed lines I need to take that+ " into account. This will be wrong if the cursor was in the+ " import block.+ let new_total = line('$')+ call cursor(old_line + (new_total - old_total), old_col)+ endif+ call append(start, a:lines[1:])+endfunction++ " Run the contents of the current buffer through the fix-imports cmd. Print " any stderr output on the status line.-" Remove 'a' from cpoptions if you don't want this to mess up #. function FixImports()- let out = tempname()- let err = tempname()- let tmp = tempname()- " Using a tmp file means I don't have to save the buffer, which the user- " didn't ask for.- execute 'write' tmp- execute 'silent !fix-imports -v' expand('%') '<' tmp '>' out '2>' err- let errs = readfile(err)+ let l:err = tempname()+ let l:cmd = 'fix-imports -v --edit ' . expand('%') . ' 2>' . l:err+ let l:out = systemlist(l:cmd, bufnr('%'))++ let errs = readfile(l:err)+ call delete(l:err) if v:shell_error == 0- " Don't replace the buffer if there's no change, this way I won't- " mess up fold and undo state.- call system('cmp -s ' . tmp . ' ' . out)- if v:shell_error != 0- " Is there an easier way to replace the buffer with a file?- let old_line = line('.')- let old_col = col('.')- let old_total = line('$')- %d- execute 'silent :read' out- 0d- let new_total = line('$')- " If the import fix added or removed lines I need to take that- " into account. This will be wrong if the cursor was above the- " import block.- call cursor(old_line + (new_total - old_total), old_col)- " The reload will forget fold state. It was open, right?- if foldclosed('.') != -1- execute 'normal zO'- endif- endif+ call s:ReplaceImports(l:out) endif- call delete(out)- call delete(err)- call delete(tmp) redraw! if !empty(errs) echohl WarningMsg