packages feed

fix-imports (empty) → 0.1.0

raw patch · 11 files changed

+878/−0 lines, 11 filesdep +basedep +containersdep +cpphssetup-changed

Dependencies added: base, containers, cpphs, directory, filepath, haskell-src-exts, process, split, uniplate

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Evan Laforge 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Evan Laforge nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
@@ -0,0 +1,21 @@+There are a few things which can be configured.  Edit src/Main.hs and mess with+the Config it passes in.  There isn't much configurability but what there is+should be documented in the modules in which it is defined.++See the vimrc for an exmaple of how it can be bound to a key in vim.++It'll reformat the import lines, including an import list if you have one.+Sorry about that.  The formatting style of Language.Haskell.Exts.prettyPrint+is not my personal style.  If it ever bothers me enough maybe I'll write my+own formatter, or come up with a way to not reformat unqualified imports.++Also, it will search for modules starting from '.', so you should be in the+root of the module hierarchy.  It wouldn't be hard to add a -i flag though.++haskell-src-exts will crash the program if it gets an ambigious operator+fixity parse.  I don't know why it does that, but if you get a crash like that+you can add your custom operators to the Config.++It can be a little slow.  Most of this is probably that it rebuilds the+package index on every run.  So if you have a large package db and it's too+slow, caching the package index would probably help.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fix-imports.cabal view
@@ -0,0 +1,30 @@+name: fix-imports+version: 0.1.0+cabal-version: >= 1.6+build-type: Simple+synopsis: Program to manage the imports of a haskell module+description:+    A small standalone program to manage the import block of a haskell program.+    It will try to add import lines for qualified names with no corresponding+    import, remove unused import lines, and sort the import block according to+    some heuristic you can define.  This only works for qualified imports!+    Unqualified imports are left untouched.+    .+    It's most convenient if bound to an editor key.++category: Editor, Haskell, IDE+license: BSD3+license-file: LICENSE+author: Evan Laforge+maintainer: Evan Laforge <qdunkan@gmail.com>+stability: experimental+tested-with: GHC>=7.0.3+data-files: README, vimrc+extra-source-files: src/*.hs++executable FixImports+    main-is: Main.hs+    hs-source-dirs: src+    build-depends: base >= 3 && < 5, containers, directory, filepath, process,+        haskell-src-exts, uniplate, split, cpphs+    ghc-options: -Wall -fno-warn-name-shadowing
+ src/Config.hs view
@@ -0,0 +1,120 @@+-- | This module pulls out a few values I'm more likely to want to configure+-- per-project.  They are passed to 'FixImports.runMain', so you can write+-- your own Main.hs that passes its own Config.+--+-- TODO dyre does this sort of thing+module Config where+import qualified Data.List as List+import qualified Language.Haskell.Exts.Annotated as Haskell++import qualified Types+import qualified Util+import qualified Index+++data Config = Config {+    -- | Format the import block.+    configShowImports :: [Types.ImportLine] -> String+    -- | See 'Index.Config'.+    , configIndex :: Index.Config+    -- | A module can only be parsed if you know the fixities of all the+    -- operators within it.+    , configFixities :: [Haskell.Fixity]+    }++defaultConfig :: [String] -> Config+defaultConfig localModules = Config (formatGroups localModules)+    (Index.Config packagePriority []) Haskell.baseFixities++packagePriority :: [String]+packagePriority = ["base", "containers", "directory", "mtl"]++-- | Print out the imports with spacing how I like it.+formatImports :: [Types.ImportLine] -> String+formatImports imports = unlines $+    map showImport (sort package) ++ [""] ++ map showImport (sort local)+    where+    sort = Util.sortOn Types.importModule+    (local, package) = List.partition Types.importIsLocal imports++-- | Format import list.  Imports are alphabetized and grouped into sections+-- based on the top level module name (before the first dot).  Sections that+-- are too small are grouped with the section below them.+--+-- The local imports are sorted and grouped separately from the package+-- imports.  Rather than being alphabetical, they are sorted in a per-project+-- order that should be general-to-specific.+--+-- An unqualified import will follow a qualified one.  The Prelude, if+-- imported, always goes first.+formatGroups :: [String] -> [Types.ImportLine] -> String+formatGroups priorities imports =+    unlines $ joinGroups+        [ showGroups (group (Util.sortOn packagePrio package))+        , showGroups (group (Util.sortOn localPrio local))+        ]+    where+    packagePrio imp = (fromEnum (name imp /= prelude), name imp,+        fromEnum (not (qualifiedImport imp)))+    localPrio imp = (listPriority (topModule imp) priorities,+        name imp, fromEnum (qualifiedImport imp))+    name = Types.importModule+    (local, package) = List.partition Types.importIsLocal imports+    group = collapse . Util.groupOn topModule+    topModule = takeWhile (/='.') . Types.moduleName . Types.importModule+    collapse [] = []+    collapse (x:xs)+        | length x <= 2 = case collapse xs of+            [] -> [x]+            y : ys -> (x ++ y) : ys+        | otherwise = x : collapse xs+    showGroups = List.intercalate [""] . map (map showImport)+    joinGroups = List.intercalate [""] . filter (not . null)+    prelude = Types.ModuleName "Prelude"++listPriority :: (Eq a) => a -> [a] -> (Int, Maybe Int)+listPriority x xs = case List.elemIndex x xs of+    Nothing -> (1, Nothing)+    Just k -> (0, Just k)++qualifiedImport :: Types.ImportLine -> Bool+qualifiedImport = Haskell.importQualified . Types.importDecl++showImport :: Types.ImportLine -> String+showImport (Types.ImportLine imp cmts _) =+    above ++ importLine ++ (if null right then "" else ' ' : right)+    where+    above = concat [cmt ++ "\n" | Types.Comment Types.CmtAbove cmt <- cmts]+    importLine = Haskell.prettyPrint imp+    right = Util.join "\n" [cmt | Types.Comment Types.CmtRight cmt <- cmts]++{-+-- t0 = map localPrio imports -- formatGroups priorities (map mkImport imports)+t0 = formatGroups priorities imports+    where+    imports = map mkImport+        [ ("Data.List", True, Just "List", False)+        , ("Prelude", False, Nothing, False)+        , ("Prelude", True, Nothing, False)+        , local "A.B"+        , local "A.C"+        , local "C.A"+        , local "B.A"+        , local "B.B"+        , local "B.C"+        , local "B.D"+        ]+    local name = (name, True, Nothing, True)+    mkImport (name, qualified, importAs, local) = Types.ImportLine decl [] local+        where+        decl = Haskell.ImportDecl empty (Haskell.ModuleName empty name)+            qualified False Nothing (fmap (Haskell.ModuleName empty) importAs)+            Nothing+    empty = Haskell.SrcSpanInfo (Haskell.SrcSpan "" 0 0 0 0) []++    priorities = ["A", "B"]+    localPrio imp = (listPriority (topModule imp) priorities,+        name imp, fromEnum (qualifiedImport imp))+    topModule = takeWhile (/='.') . Types.moduleName . Types.importModule+    name = Types.importModule+-}
+ src/FixImports.hs view
@@ -0,0 +1,411 @@+{-# LANGUAGE ScopedTypeVariables #-}+{- | Automatically fix the import list in a haskell module.++    This only really works for qualified names.  The process is as follows:++    - Parse the entire file and extract the Qualification of qualified names+    like @A.b@, which is simple @A@.++    - Combine this with the modules imported to decide which imports can be+    removed and which ones must be added.++    - For added imports, guess the complete import path implied by the+    Qualification.  This requires some heuristics:++        - Check local modules first.  Start in the current module's directory+        and then try from the current directory, descending recursively.++        - If no local modules are found, check the package database.  There is+        a system of package priorities so that @List@ will yield @Data.List@+        from @base@ rather than @List@ from @haskell98@.  After that, shorter+        matches are prioritized so @System.Process@ is chosen over+        @System.Posix.Process@.++        - If the module is not found at all, an error is printed on stderr and+        the unchanged file on stdout.++        - Of course the heuristics may get the wrong module, but existing+        imports are left alone so you can edit them by hand.++    - Then imports are sorted, grouped, and a new module is written to stdout+    with the new import block replacing the old one.++        - The default import formatting separates package imports from local+        imports, and groups them by their toplevel module name (before the+        first dot).  Small groups are combined.  They go in alphabetical order+        by default, but a per-project order may be defined.++    - If there are no imports to be added or removed, the file is returned+    unchanged.  This means it won't sort the imports in this case.+-}+module FixImports where+import Prelude hiding (mod)+import qualified Control.Exception as Exception+import qualified Control.Monad as Monad+import qualified Data.Either as Either+import qualified Data.Generics.Uniplate.Data as Uniplate+import qualified Data.Map as Map+import qualified Data.Maybe as Maybe+import qualified Data.Set as Set++import qualified Language.Preprocessor.Cpphs as Cpphs+import qualified Language.Haskell.Exts.Annotated as Haskell++import qualified System.Directory as Directory+import qualified System.Environment+import qualified System.Exit+import qualified System.FilePath as FilePath+import System.FilePath ( (</>) )+import qualified System.IO as IO+import qualified System.Process as Process++import qualified Config+import qualified Index+import qualified Types+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+    text <- IO.getContents+    fixed <- fixModule config modulePath text+        `Exception.catch` (\(exc :: Exception.SomeException) ->+            return $ Left $ "exception: " ++ show exc)+    case fixed of+        Left err -> do+            IO.putStr text+            IO.hPutStrLn IO.stderr $ "error: " ++ err+            System.Exit.exitFailure+        Right (Result text added removed) -> do+            IO.putStr text+            Monad.when (verbose+                    && (not (Set.null added) || not (Set.null removed))) $+                IO.hPutStrLn IO.stderr $ "added: " ++ names added+                    ++ "; removed: " ++ names removed+            System.Exit.exitSuccess+    where+    names xs+        | 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+    where+    verbose = "-v" `elem` args++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+    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+    where+    parse = Haskell.parseFileContentsWithComments $+        Haskell.defaultParseMode+            { Haskell.parseFilename = modulePath+            , Haskell.fixities = Config.configFixities config+            }++-- | The parse function takes a CPP extension, but doesn't actually pay any+-- attention to it, so I have to run CPP myself.  The imports are fixed+-- post-CPP so if you put CPP in the imports block it will be stripped out.+-- Serves you right anyway.+cppModule :: FilePath -> String -> IO String+cppModule filename s = Cpphs.runCpphs options filename s+    where+    options = Cpphs.defaultCpphsOptions { Cpphs.boolopts = boolOpts }+    boolOpts = Cpphs.defaultBoolOptions+        { Cpphs.macros = True+        , Cpphs.locations = False+        , Cpphs.hashline = False+        , Cpphs.pragma = False+        , Cpphs.stripEol = True+        , Cpphs.stripC89 = True+        , Cpphs.lang = True -- lex input as haskell code+        , Cpphs.ansi = True+        , Cpphs.layout = True+        , Cpphs.literate = False -- untested with literate code +        , Cpphs.warnings = False+        }++-- | Take a parsed module along with its unparsed text.  If the imports should+-- change, generate a new import block with proper spacing, formatting, and+-- comments.  Then snip out the import block on the import file, and replace+-- it.  Otherwise, the unparsed input module is returned unchanged.+fixImports :: Config.Config -> FilePath -> Types.Module -> [Haskell.Comment]+    -> String -> IO (Either String Result)+fixImports config modulePath mod cmts text+    | Set.null newImports && Set.null unusedImports =+        return $ Right $ Result text Set.empty Set.empty+    | otherwise = 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+        let existing = map (Types.importDeclModule . fst) imports+        let (notFound, importLines) = Either.partitionEithers $+                zipWith mkError+                    (map toModule (Set.toList newImports) ++ existing)+                    (mbNew ++ mbExisting)+            mkError _ (Just imp) = Right imp+            mkError mod Nothing = Left mod+        return $ case notFound of+            _ : _ -> Left $ "modules not found: "+                ++ Util.join ", " (map Types.moduleName notFound)+            [] -> Right $ Result+                (substituteImports (showImports importLines) range text)+                (Set.fromList (map (Types.importDeclModule . Types.importDecl)+                    (Maybe.catMaybes mbNew)))+                unusedImports+    where+    (newImports, unusedImports, imports, range) = importInfo mod cmts+    toModule (Types.Qualification name) = Types.ModuleName name+    showImports = Config.configShowImports config++-- | Clip out the range from the given text and replace it with the given+-- lines.+substituteImports :: String -> (Int, Int) -> String -> String+substituteImports imports (start, end) text =+    unlines pre ++ imports ++ unlines post+    where+    (pre, within) = splitAt start (lines text)+    (_, post) = splitAt (end-start) within++-- * find new imports++-- | Make a new ImportLine from a ModuleName.+mkImportLine :: FilePath -> Index.Index -> Types.Qualification+    -> IO (Maybe Types.ImportLine)+mkImportLine modulePath index qual@(Types.Qualification name) = do+    found <- findModule index modulePath qual+    return $ case found of+        Nothing -> Nothing+        Just (mod, local) -> Just (Types.ImportLine (mkImport mod) [] local)+    where+    mkImport (Types.ModuleName mod) =+        Haskell.ImportDecl empty (Haskell.ModuleName empty mod)+            True False Nothing (importAs mod) Nothing+    importAs mod+        | name == mod = Nothing+        | otherwise = Just $ Haskell.ModuleName empty name+    empty = Haskell.noInfoSpan (Haskell.SrcSpan "" 0 0 0 0)++-- | 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+    -> IO (Maybe (Types.ModuleName, Bool))+findModule index modulePath qual = do+    found <- findLocalModule modulePath qual+    return $ case found of+        Just path -> Just (pathToModule path, True)+        Nothing -> case Map.lookup qual index of+            Just mod -> Just (mod, False)+            Nothing -> Nothing++-- | 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+    where+    path = moduleToPath (Types.ModuleName name)+    dir = FilePath.takeDirectory modulePath++findFile :: FilePath -> Int -> FilePath -> IO (Maybe FilePath)+findFile file depth dir = fmap (fmap FilePath.normalise) $+    Util.ifM (Directory.doesFileExist current) (return (Just current)) $+        if depth <= 0 then return Nothing else descend+    where+    descend = do+        subdirs <- Monad.filterM Directory.doesDirectoryExist+            =<< Util.listDir dir+        Util.untilJust (findFile file (depth-1)) subdirs+    current = dir </> file+++-- * 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)+    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)) $+        Util.ifM (isPackageModule mod) (return (Just False))+            (return Nothing)++isLocalModule :: Types.ModuleName -> IO Bool+isLocalModule = Directory.doesFileExist . moduleToPath++isPackageModule :: Types.ModuleName -> IO Bool+isPackageModule (Types.ModuleName name) = do+    output <- Process.readProcess "ghc-pkg"+        ["--simple-output", "find-module", name] ""+    return $ not (null output)++-- * util++pathToModule :: FilePath -> Types.ModuleName+pathToModule = Types.ModuleName .+    map (\c -> if c == '/' then '.' else c) . FilePath.dropExtension++moduleToPath :: Types.ModuleName -> FilePath+moduleToPath (Types.ModuleName name) =+    map (\c -> if c == '.' then '/' else c) name ++ ".hs"++importInfo :: Types.Module -> [Haskell.Comment]+    -> (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))+    where+    redundant = Set.difference imported used+    missing = Set.difference used imported+    imported = Set.fromList (Maybe.catMaybes quals)++    -- Get from the qualified import name back to the actual module name so+    -- I can return that.+    modules = map Types.importDeclModule imports+    quals = map Types.importDeclQualification imports+    qualToModule =+        Map.fromList [(qual, mod) | (Just qual, mod) <- zip quals modules]+    redundantModules = Set.fromList $ Maybe.catMaybes+        [Map.lookup qual qualToModule | qual <- Set.toList redundant]++    used = Set.fromList (moduleQNames mod)+    imports = moduleImportDecls mod+    declCmts = [imp | imp@(decl, _) <- associateComments imports importCmts,+        keepImport decl]+    -- Keep unqualified imports, but only keep qualified ones if they are used.+    keepImport = maybe True (`Set.member` used) . Types.importDeclQualification++    (start, end) = importSpan mod+    importCmts = filter inRange cmts+    inRange (Haskell.Comment _ src _) = s >= start && s < end+        where s = Haskell.srcSpanStartLine src+++-- | Pair ImportDecls up with the comments that apply to them.  Comments+-- below the last import are dropped.  Comments that are separated from an+-- import by a blank line will also be lost.  It could be fixed but I don't+-- think I write those comments.+--+-- Also misses cmts that have leading whitespace.  Don't do that.+-- To do it right I'd have to sort imports and cmts and pull cmts off with+-- a foldl.+associateComments :: [Types.ImportDecl] -> [Haskell.Comment]+    -> [(Types.ImportDecl, [Types.Comment])]+associateComments imports cmts = [(imp, cmtsFor imp) | imp <- imports]+    where+    cmtsFor imp = Util.mapMaybe (associate src) cmts+        where src = Haskell.srcInfoSpan (Haskell.importAnn imp)+    associate src (Haskell.Comment block csrc text)+        | start csrc == end csrc && start csrc `within` src =+            Just $ Types.Comment Types.CmtRight cmt+        | Haskell.srcSpanStartColumn csrc == 1 && end csrc + 1 == start src =+            Just $ Types.Comment Types.CmtAbove cmt+        | otherwise = Nothing+        where+        cmt = if block then "{-" ++ text ++ "-}" else "--" ++ text+    start = Haskell.srcSpanStartLine+    end = Haskell.srcSpanEndLine+    within line src = line >= start src && line <= end src++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)+        _ -> (0, 0)+    where+    start = Haskell.srcSpanStartLine . Haskell.srcInfoSpan+    end = 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\+\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/Index.hs view
@@ -0,0 +1,106 @@+-- | Maintain the index from Qualification to the full module from the package+-- db that this Qualification probably intends.+module Index where+import Prelude hiding (mod)+import Control.Applicative ( (<$>) )+import qualified Data.List as List+import qualified Data.Map as Map+import qualified System.Process as Process++import qualified Types+import qualified Util+++data Config = Config {+    -- | The modules in the packages earlier in this list will override those+    -- later.  So even if there's a package with @Some.Obscure.List@, @List@+    -- will still map to @Data.List@ because @containers@ gets priority.+    --+    -- The rest will be in a consistent but uninteresting order.+    configPackagePriorities :: [String]++    -- | Ignore these packages entirely even if they are exposed, in case they+    -- export something annoyingly general.+    , configIgnorePackages :: [String]+    } deriving (Show)++-- | Map from tails of the each module in the package db to its module name.+-- So @List@ and @Data.List@ will map to @Data.List@.  Modules from a set+-- of core packages, like base and containers, will take priority, so even if+-- there's a package with @Some.Obscure.List@, @List@ will still map to+-- @Data.List@.+type Index = Map.Map Types.Qualification Types.ModuleName++empty :: Index+empty = Map.empty++loadIndex :: Config -> IO Index+loadIndex = buildIndex -- TODO load cache?++buildIndex :: Config -> IO Index+buildIndex config = do+    result <- parseDump config <$> Process.readProcess "ghc-pkg"+        ["field", "*", "name,exposed,exposed-modules"] ""+    either error return result++parseDump :: Config -> String -> Either String Index+parseDump config text = do+    triples <- sequence (triple sections)+    return $ Map.fromList $ makePairs (configPackagePriorities config)+        [(package, mods) | (package, True, mods) <- triples,+            package `notElem` configIgnorePackages config]+    where+    sections = List.unfoldr parseSection (lines text)+    triple [] = []+    triple (("name", [name]) : ("exposed", [exposed])+            : ("exposed-modules", modules) : rest) =+        Right (name, exposed == "True", map Types.ModuleName modules)+            : triple rest+    triple ((tag, _) : _) = [Left $ "unexpected tag: " ++ tag]++makePairs :: [String] -> [(String, [Types.ModuleName])]+    -> [(Types.Qualification, Types.ModuleName)]+makePairs packagePrio packageMods =+    [(qual, mod) | (_, mod) <- pairs, qual <- modQuals mod]+    where+    pairs = Util.sortOn (priority (reverse packagePrio))+        [(p, m) | (p, mods) <- packageMods, m <- mods]+    modQuals = map (Types.Qualification . Util.join ".") . filter (not . null)+        . List.tails . Util.split "." . Types.moduleName++-- | Put the high priority packages last, so they will override the others+-- in @Map.fromList@.+priority :: [String] -> (String, Types.ModuleName) -> (Int, Int, String)+priority packagePrio (package, mod) = (pprio, mprio, package)+    where+    pprio = maybe 0 (+1) (List.elemIndex package packagePrio)+    mprio = negate $ length $ filter (=='.') $ Types.moduleName mod++parseSection :: [String] -> Maybe ((String, [String]), [String])+parseSection [] = Nothing+parseSection (x:xs) = Just ((tag, concatMap words (drop 1 rest : pre)), post)+    where+    (tag, rest) = break (==':') x+    (pre, post) = span ((==" ") . take 1) xs++{-+-- * test++t0 = makePairs prio $ map (\(p, ms) -> (p, map Types.ModuleName ms))+    [ ("base", ["Data.List", "Foo.Bar.List"])+    , ("haskell98", ["List"])+    , ("containers", ["Box.List"])+    ]+    -- Not containers Box.List because containers is lower prio.+    -- Not haskell98 List because haskell98 is lowest prio, even though that's+    -- the shortest match.+    -- Not Foo.Bar.List because Data.List is a shorter match.++t1 = Map.lookup (Types.Qualification "List") (Map.fromList t0)+t10 = List.unfoldr parseSection ["hi: there fred", "  foo", "next: section"]+tdump =+    [ "name: base", "exposed: True", "exposed-modules: Data.List Data.Map"+    , "name: mtl", "exposed: True", "exposed-modules: Monad.B.List"+    ]++-}
+ src/Main.hs view
@@ -0,0 +1,19 @@+-- | Main file for FixImports that uses the default formatting.  Since import+-- priority is per-project, it reads it from a file in the current directory.+--+-- More documentation in "FixImports".+module Main where+import qualified System.Directory as Directory++import qualified Config+import qualified FixImports+import qualified Util+++main :: IO ()+main = do+    priorities <- fmap words (readEmpty "fix-imports-priority")+    FixImports.runMain (Config.defaultConfig priorities)++readEmpty :: FilePath -> IO String+readEmpty fn = Util.ifM (Directory.doesFileExist fn) (readFile fn) (return "")
+ src/Types.hs view
@@ -0,0 +1,49 @@+module Types where+import qualified Language.Haskell.Exts.Annotated as Haskell+++data ImportLine = ImportLine {+    importDecl :: ImportDecl+    , importComments :: [Comment]+    , importIsLocal :: Bool+    } deriving (Show)++-- | A Comment is associated with a particular import line.+data Comment = Comment CmtPos String deriving (Show)+data CmtPos = CmtAbove | CmtRight deriving (Show)++type ImportDecl = Haskell.ImportDecl Haskell.SrcSpanInfo+type Module = Haskell.Module Haskell.SrcSpanInfo++-- | A Qualification is a qualified name minus the actual name.  So it should+-- be the tail of a ModuleName.+newtype Qualification = Qualification String+    deriving (Eq, Ord, Show)++newtype ModuleName = ModuleName String+    deriving (Eq, Ord, Show)++moduleName :: ModuleName -> String+moduleName (ModuleName n) = n++-- | Get the qualified name from a qualified import, if it is a qualified+-- import.+importDeclQualification :: ImportDecl -> Maybe Qualification+importDeclQualification decl+    | Haskell.importQualified decl = Just $ moduleToQualification $+        maybe (Haskell.importModule decl) id (Haskell.importAs decl)+    | otherwise = Nothing++-- | Extract the ModuleName from an ImportDecl.+importDeclModule :: ImportDecl -> ModuleName+importDeclModule imp = case Haskell.importModule imp of+    Haskell.ModuleName _ s -> ModuleName s++importModule :: ImportLine -> ModuleName+importModule = importDeclModule . importDecl++-- | The parser represents the \'as\' part of an import as a ModuleName even+-- though it's actually a Qualification.+moduleToQualification :: Haskell.ModuleName Haskell.SrcSpanInfo+    -> Types.Qualification+moduleToQualification (Haskell.ModuleName _ s) = Types.Qualification s
+ src/Util.hs view
@@ -0,0 +1,45 @@+module Util where+import qualified Data.Function as Function+import qualified Data.List as List+import qualified Data.List.Split as Split+import qualified System.Directory as Directory+import System.FilePath ( (</>) )+++-- * list++-- | Concat a list with 'sep' in between.+join :: [a] -> [[a]] -> [a]+join = List.intercalate++-- | Split 'xs' on 'sep', dropping 'sep' from the result.+split :: (Eq a) => [a] -> [a] -> [[a]]+split = Split.splitOn++-- * control++ifM :: (Monad m) => m Bool -> m a -> m a -> m a+ifM cond consequent alternative = do+    b <- cond+    if b then consequent else alternative++mapMaybe :: (a -> Maybe b) -> [a] -> [b]+mapMaybe f xs = [b | Just b <- map f xs]++groupOn :: (Eq k) => (a -> k) -> [a] -> [[a]]+groupOn key = List.groupBy ((==) `Function.on` key)++sortOn :: (Ord k) => (a -> k) -> [a] -> [a]+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++-- * file++listDir :: FilePath -> IO [FilePath]+listDir dir = fmap (map add . filter (not . (`elem` [".", ".."])))+        (Directory.getDirectoryContents dir)+    where add = if dir == "." then id else (dir </>)
+ vimrc view
@@ -0,0 +1,44 @@+" Example vimrc file to bind a key to FixImports.++nm <silent> ,a :call FixImports()<cr>++" Run the contents of the current buffer through the FixImports 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 !FixImports -v' expand('%') '<' tmp '>' out '2>' err+    let errs = readfile(err)+    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 delete(out)+    call delete(err)+    call delete(tmp)+    redraw!+    if !empty(errs)+        echohl WarningMsg+        echo join(errs)+        echohl None+    endif+endfunction