diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 = 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 diff --git a/src/FixImports.hs b/src/FixImports.hs --- a/src/FixImports.hs +++ b/src/FixImports.hs @@ -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 diff --git a/src/FixImports_test.hs b/src/FixImports_test.hs --- a/src/FixImports_test.hs +++ b/src/FixImports_test.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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" diff --git a/vimrc b/vimrc --- a/vimrc +++ b/vimrc @@ -2,44 +2,39 @@ nm ,a :call FixImports() +" 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