packages feed

fix-imports 0.1.2 → 0.1.3

raw patch · 5 files changed

+166/−106 lines, 5 files

Files

fix-imports.cabal view
@@ -1,5 +1,5 @@ name: fix-imports-version: 0.1.2+version: 0.1.3 cabal-version: >= 1.6 build-type: Simple synopsis: Program to manage the imports of a haskell module
src/FixImports.hs view
@@ -37,8 +37,10 @@ -} module FixImports where import Prelude hiding (mod)+import Control.Applicative ((<$>)) import qualified Control.Exception as Exception import qualified Control.Monad as Monad+import qualified Data.Char as Char import qualified Data.Either as Either import qualified Data.Generics.Uniplate.Data as Uniplate import qualified Data.List as List@@ -48,6 +50,7 @@  import qualified Language.Haskell.Exts.Annotated as Haskell import qualified Language.Preprocessor.Cpphs as Cpphs+import qualified System.Console.GetOpt as GetOpt import qualified System.Directory as Directory import qualified System.Environment import qualified System.Exit@@ -62,18 +65,15 @@ import qualified Util  -usage :: String-usage = "usage: FixImports [ -v ] Module.hs <Module.hs"-    ++ "\n\t-v print added and removed modules on stderr"- runMain :: Config.Config -> IO () runMain 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) <- parseArgs =<< System.Environment.getArgs+    (modulePath, (verbose, includes)) <-+        parseArgs =<< System.Environment.getArgs     text <- IO.getContents-    fixed <- fixModule config modulePath text+    fixed <- fixModule includes config modulePath text         `Exception.catch` (\(exc :: Exception.SomeException) ->             return $ Left $ "exception: " ++ show exc)     case fixed of@@ -93,29 +93,46 @@         | Set.null xs = "[]"         | otherwise = (Util.join ", " . map Types.moduleName . Set.toList) xs -parseArgs :: [String] -> IO (String, Bool)-parseArgs args = case filter (/="-v") args of-        [modulePath] -> return (modulePath, verbose)-        _ -> do-            IO.hPutStrLn IO.stderr usage-            System.Exit.exitFailure+data Flag = Verbose | Include String+    deriving (Eq, Show)++options :: [GetOpt.OptDescr Flag]+options =+    [ GetOpt.Option ['v'] [] (GetOpt.NoArg Verbose)+        "print added and removed modules on stderr"+    , GetOpt.Option ['i'] [] (GetOpt.ReqArg Include "path")+        "add to module include path"+    ]++usage :: String -> IO a+usage msg =+    putStr (GetOpt.usageInfo (msg ++ help) options) >> System.Exit.exitFailure     where-    verbose = "-v" `elem` args+    help = "FixImports Module.hs <Module.hs" +parseArgs :: [String] -> IO (String, (Bool, [FilePath]))+parseArgs args = case GetOpt.getOpt GetOpt.Permute options args of+    (flags, [modulePath], []) -> return (modulePath, parse flags)+    (_, [], errs) -> usage $ concat errs+    _ -> usage "too many args\n"+    where parse flags = (Verbose `elem` flags, "." : [p | Include p <- flags])+    -- Includes always have the current directory first.+ data Result = Result {     resultText :: String     , resultAdded :: Set.Set Types.ModuleName     , resultRemoved :: Set.Set Types.ModuleName     } deriving (Show) -fixModule :: Config.Config -> FilePath -> String -> IO (Either String Result)-fixModule config modulePath text = do+fixModule :: [FilePath] -> Config.Config -> FilePath -> String+    -> IO (Either String Result)+fixModule includes config modulePath text = do     processed <- cppModule modulePath text     case parse processed of         Haskell.ParseFailed srcloc err ->             return $ Left $ Haskell.prettyPrint srcloc ++ ": " ++ err         Haskell.ParseOk (mod, cmts) ->-            fixImports config modulePath mod cmts text+            fixImports includes config modulePath mod cmts text     where     parse = Haskell.parseFileContentsWithComments $         Haskell.defaultParseMode@@ -150,17 +167,18 @@ -- | 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 :: Config.Config -> FilePath -> Types.Module -> [Haskell.Comment]-    -> String -> IO (Either String Result)-fixImports config modulePath mod cmts text = do+fixImports :: [FilePath] -> Config.Config -> FilePath -> Types.Module+    -> [Haskell.Comment] -> String -> IO (Either String Result)+fixImports includes config modulePath mod cmts text = do     -- Don't bother loading the index if I'm not going to use it.     -- TODO actually, only load it if I don't find local imports     -- I guess Data.Binary's laziness will serve me there     index <- if Set.null newImports         then return Index.empty         else Index.loadIndex (Config.configIndex config)-    mbNew <- mapM (mkImportLine modulePath index) (Set.toList newImports)-    mbExisting <- mapM findImport imports+    mbNew <- mapM (mkImportLine includes modulePath index)+        (Set.toList newImports)+    mbExisting <- mapM (findImport includes) imports     let existing = map (Types.importDeclModule . fst) imports     let (notFound, importLines) = Either.partitionEithers $             zipWith mkError@@ -193,10 +211,10 @@ -- * find new imports  -- | Make a new ImportLine from a ModuleName.-mkImportLine :: FilePath -> Index.Index -> Types.Qualification+mkImportLine :: [FilePath] -> FilePath -> Index.Index -> Types.Qualification     -> IO (Maybe Types.ImportLine)-mkImportLine modulePath index qual@(Types.Qualification name) = do-    found <- findModule index modulePath qual+mkImportLine includes modulePath index qual@(Types.Qualification name) = do+    found <- findModule includes index modulePath qual     return $ case found of         Nothing -> Nothing         Just (mod, local) -> Just (Types.ImportLine (mkImport mod) [] local)@@ -211,10 +229,10 @@  -- | Find the qualification and its ModuleName and True if it was a local -- import.  Nothing if it wasn't found at all.-findModule :: Index.Index -> FilePath -> Types.Qualification+findModule :: [FilePath] -> Index.Index -> FilePath -> Types.Qualification     -> IO (Maybe (Types.ModuleName, Bool))-findModule index modulePath qual = do-    found <- findLocalModule modulePath qual+findModule includes index modulePath qual = do+    found <- findLocalModule includes modulePath qual     return $ case found of         Just path -> Just (pathToModule path, True)         Nothing -> case Map.lookup qual index of@@ -223,14 +241,27 @@  -- | Given A.B, look for A/B.hs, */A/B.hs, */*/A/B.hs, etc.  Look in the -- directory of the current module first.-findLocalModule :: FilePath -> Types.Qualification -> IO (Maybe String)-findLocalModule modulePath (Types.Qualification name) = do-    found <- findFile path 0 dir-    maybe (findFile path 4 ".") (return . Just) found+findLocalModule :: [FilePath] -> FilePath -> Types.Qualification+    -> IO (Maybe String)+findLocalModule includes modulePath (Types.Qualification name) =+    Util.untilJust $+        findFile path 0 moduleDir : map (findFileStrip path 4) includes     where     path = moduleToPath (Types.ModuleName name)-    dir = FilePath.takeDirectory modulePath+    moduleDir = FilePath.takeDirectory modulePath +-- | Like 'findFile', but strip the base directory name from the front of the+-- returned file.+findFileStrip :: FilePath -> Int -> FilePath -> IO (Maybe FilePath)+findFileStrip file depth dir = do+    fmap (dropWhile (=='/') . strip dir) <$> findFile file depth dir+    where+    strip xs ys+        | take (length xs) ys == xs = drop (length xs) ys+        | otherwise = ys++-- | Find the file somewhere below the given directory, giving up after+-- descending the given depth. findFile :: FilePath -> Int -> FilePath -> IO (Maybe FilePath) findFile file depth dir = fmap (fmap FilePath.normalise) $     Util.ifM (Directory.doesFileExist current) (return (Just current)) $@@ -239,31 +270,35 @@     descend = do         subdirs <- Monad.filterM Directory.doesDirectoryExist             =<< Util.listDir dir-        Util.untilJust (findFile file (depth-1)) subdirs+        Util.untilJust $+            map (findFile file (depth-1)) (filter isModuleDir subdirs)     current = dir </> file+    isModuleDir = all Char.isUpper . take 1 . FilePath.takeFileName   -- * figure out existing imports  -- | Make an existing import into an ImportLine by finding out if it's a local -- module or a package module.-findImport :: (Types.ImportDecl, [Types.Comment]) -> IO (Maybe Types.ImportLine)-findImport (imp, cmts) = do-    found <- findModuleName (Types.importDeclModule imp)+findImport :: [FilePath] -> (Types.ImportDecl, [Types.Comment])+    -> IO (Maybe Types.ImportLine)+findImport includes (imp, cmts) = do+    found <- findModuleName includes (Types.importDeclModule imp)     return $ case found of         Nothing -> Nothing         Just local -> Just $ Types.ImportLine imp cmts local  -- | 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 :: Types.ModuleName -> IO (Maybe Bool)-findModuleName mod =-    Util.ifM (isLocalModule mod) (return (Just True)) $+findModuleName :: [FilePath] -> Types.ModuleName -> IO (Maybe Bool)+findModuleName includes mod =+    Util.ifM (isLocalModule mod ("" : includes)) (return (Just True)) $         Util.ifM (isPackageModule mod) (return (Just False))             (return Nothing) -isLocalModule :: Types.ModuleName -> IO Bool-isLocalModule = Directory.doesFileExist . moduleToPath+isLocalModule :: Types.ModuleName -> [FilePath] -> IO Bool+isLocalModule mod =+    Util.anyM (Directory.doesFileExist . (</> moduleToPath mod))  isPackageModule :: Types.ModuleName -> IO Bool isPackageModule (Types.ModuleName name) = do@@ -285,7 +320,7 @@     -> (Set.Set Types.Qualification, Set.Set Types.ModuleName,         [(Types.ImportDecl, [Types.Comment])], (Int, Int))     -- ^ (newModules, unusedModules, moduleToImport, rangeOfImportBlock).-importInfo mod cmts = (missing, redundantModules, declCmts, (start, end))+importInfo mod cmts = (missing, redundantModules, declCmts, range)     where     redundant = Set.difference imported used     missing = Set.difference used imported@@ -302,15 +337,20 @@      used = Set.fromList (moduleQNames mod)     imports = moduleImportDecls mod-    declCmts = [imp | imp@(decl, _) <- associateComments imports importCmts,-        keepImport decl]+    declCmts =+        [ imp | imp@(decl, _)+        <- associateComments imports (filterImportCmts range cmts)+        , keepImport decl+        ]     -- Keep unqualified imports, but only keep qualified ones if they are used.     keepImport = maybe True (`Set.member` used) . Types.importDeclQualification+    range = importRange mod -    (start, end) = importSpan mod-    importCmts = filter inRange cmts-    inRange (Haskell.Comment _ src _) = s >= start && s < end-        where s = Haskell.srcSpanStartLine src+filterImportCmts :: (Int, Int) -> [Haskell.Comment] -> [Haskell.Comment]+filterImportCmts (start, end) = filter inRange+    where+    inRange (Haskell.Comment _ src _) = start <= s && s < end+        where s = Haskell.srcSpanStartLine src - 1 -- spans are 1-based   -- | Pair ImportDecls up with the comments that apply to them.  Comments@@ -340,69 +380,38 @@     start = Haskell.srcSpanStartLine     end = Haskell.srcSpanEndLine -parse :: String -> (Types.Module -> [Haskell.Comment] -> a) -> Either String a-parse text f = case Haskell.parseFileContentsWithComments mode text of-    Haskell.ParseFailed srcloc err ->-        Left $ Haskell.prettyPrint srcloc ++ ": " ++ err-    Haskell.ParseOk (mod, comments) -> Right (f mod comments)-    where mode = Haskell.defaultParseMode- moduleImportDecls :: Types.Module -> [Types.ImportDecl] moduleImportDecls (Haskell.Module _ _ _ imports _) = imports moduleImportDecls _ = []  -- | Return half-open line range of import block, starting from (0 based) line -- of first import to the line after the last one.-importSpan :: Types.Module -> (Int, Int)-importSpan m = case m of-        Haskell.Module _ _ _ imports@(_:_) _ ->-            (start (Haskell.importAnn (head imports)) - 1,-                end (Haskell.importAnn (last imports)))-        Haskell.Module _ (Just (Haskell.ModuleHead src _ _ _)) _ _ _ ->-            (end src, end src)+importRange :: Types.Module -> (Int, Int)+importRange mod = case mod of+        -- Haskell.Module _ mb_head _ imports _ ->+        --     let start = headEnd mb_head+        --     in (start, max start (importsEnd imports))+        Haskell.Module _ Nothing _ imports _ ->+            (importsStart imports, importsEnd imports)+        Haskell.Module _ (Just modHead) _ imports _ ->+            let start = headEnd modHead+            in (start, max start (importsEnd imports))         _ -> (0, 0)     where-    start = Haskell.srcSpanStartLine . Haskell.srcInfoSpan-    end = Haskell.srcSpanEndLine . Haskell.srcInfoSpan+    -- The parser counts lies from 1, but I return a half-open range from 0.+    -- So I don't need to +1 the last line of the head, and since the range+    -- is half-open I don't need to -1 the last line of the imports.+    headEnd (Haskell.ModuleHead src _ _ _) = endOf src+    importsStart [] = 0+    importsStart (importDecl : _) =+        startOf (Haskell.importAnn importDecl) - 1+    importsEnd [] = 0+    importsEnd imports = (endOf . Haskell.importAnn . last) imports +    startOf = Haskell.srcSpanStartLine . Haskell.srcInfoSpan+    endOf = Haskell.srcSpanEndLine . Haskell.srcInfoSpan+ -- | Uniplate is rad. moduleQNames :: Types.Module -> [Types.Qualification] moduleQNames mod = [Types.moduleToQualification m     | Haskell.Qual _ m _ <- Uniplate.universeBi mod]----- * test--{--test = do-    res <- fixModule (Config.defaultConfig ["base"])  "TestMod.hs" tmod-    case res of-        Right res -> do-            putStr (resultText res)-            putStrLn $ "added: " ++ show (resultAdded res)-            putStrLn $ "removed: " ++ show (resultRemoved res)-        Left err -> putStrLn $ "error: " ++ err--t0 = parse tmod $ \mod _ -> moduleImportDecls mod-t1 = parse tmod $ \mod _ -> show (moduleQNames mod)-t2 = parse tmod importInfo-t3 = parse tmod $ \mod cmts ->-    [(Haskell.importModule imp, cs)-        | (imp, cs) <- associateComments (moduleImportDecls mod) cmts]--Right (mod0, cs0) = parse tmod (,)--tmod = "module TestMod (\n\-\       x, y, z\n\-\) where\n\-\import qualified Data.List as C\n\-\-- I want this comment\n\-\-- And this one\n\-\import qualified Util -- cmt right\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"--}
+ src/FixImports_test.hs view
@@ -0,0 +1,46 @@+-- | Grody hand-testing because I'm too lazy to libraryize the test framework+-- just for this.+module FixImports_test where+import qualified Language.Haskell.Exts.Annotated as Haskell++import qualified FixImports+import qualified Types+++importRange modText = do+    (mod, cmts) <- parse modText+    return $ FixImports.importRange mod++cmtsInRange modText = do+    (mod, cmts) <- parse modText+    return $ FixImports.filterImportCmts (FixImports.importRange mod) cmts++parse :: String -> Either String (Types.Module, [Haskell.Comment])+parse text = case Haskell.parseFileContentsWithComments mode text of+    Haskell.ParseFailed srcloc err ->+        Left $ Haskell.prettyPrint srcloc ++ ": " ++ err+    Haskell.ParseOk (mod, comments) -> Right (mod, comments)+    where mode = Haskell.defaultParseMode++-- TODO quasi-quoting has a nicer way for multi-line strings, right?+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 = "{-# 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"
src/Index.hs view
@@ -3,6 +3,7 @@ module Index where import Prelude hiding (mod) import Control.Applicative ( (<$>) )+import Control.Monad.Instances () -- Monad (Either x) instance import qualified Data.List as List import qualified Data.Map as Map import qualified System.Process as Process@@ -102,5 +103,4 @@     [ "name: base", "exposed: True", "exposed-modules: Data.List Data.Map"     , "name: mtl", "exposed: True", "exposed-modules: Monad.B.List"     ]- -}
src/Util.hs view
@@ -23,6 +23,10 @@     b <- cond     if b then consequent else alternative +anyM :: (a -> IO Bool) -> [a] -> IO Bool+anyM _ [] = return False+anyM f (x:xs) = ifM (f x) (return True) (anyM f xs)+ mapMaybe :: (a -> Maybe b) -> [a] -> [b] mapMaybe f xs = [b | Just b <- map f xs] @@ -33,9 +37,10 @@ sortOn key = List.sortBy (compare `Function.on` key)  -- | Keep running the action until it returns a Just.-untilJust :: (a -> IO (Maybe b)) -> [a] -> IO (Maybe b)-untilJust _ [] = return Nothing-untilJust f (x:xs) = maybe (untilJust f xs) (return . Just) =<< f x+untilJust :: [IO (Maybe a)] -> IO (Maybe a)+untilJust [] = return Nothing+untilJust (m:ms) = do+    maybe (untilJust ms) (return . Just) =<< m  -- * file