Module name conflict detection
This commit is contained in:
parent
1aad1de28f
commit
7fbe8df701
4 changed files with 61 additions and 0 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -15,3 +15,4 @@ cabal-dev
|
|||
/logs-tools/
|
||||
build-plan.txt
|
||||
hackage-map.txt
|
||||
module-name-conflicts.txt
|
||||
|
|
|
@ -9,12 +9,14 @@ import Prelude hiding (pi)
|
|||
import Stackage.CheckCabalVersion (checkCabalVersion)
|
||||
import Stackage.Config
|
||||
import Stackage.InstallInfo
|
||||
import Stackage.ModuleNameConflict
|
||||
import Stackage.Types
|
||||
import Stackage.Util
|
||||
import System.Exit (ExitCode (ExitSuccess), exitWith)
|
||||
import System.IO (BufferMode (NoBuffering),
|
||||
IOMode (WriteMode), hPutStrLn,
|
||||
hSetBuffering, withBinaryFile)
|
||||
import qualified System.IO.UTF8
|
||||
import System.Process (rawSystem, runProcess,
|
||||
waitForProcess)
|
||||
|
||||
|
@ -104,3 +106,8 @@ build settings' bp = do
|
|||
unless (ec == ExitSuccess) $ do
|
||||
putStrLn "Build failed, please see build.log"
|
||||
exitWith ec
|
||||
|
||||
putStrLn "Build completed successfully, checking for module name conflicts"
|
||||
conflicts <- getModuleNameConflicts $ packageDir settings
|
||||
System.IO.UTF8.writeFile "module-name-conflicts.txt"
|
||||
$ renderModuleNameConflicts conflicts
|
||||
|
|
52
Stackage/ModuleNameConflict.hs
Normal file
52
Stackage/ModuleNameConflict.hs
Normal file
|
@ -0,0 +1,52 @@
|
|||
module Stackage.ModuleNameConflict
|
||||
( ModuleNameConflicts
|
||||
, getModuleNameConflicts
|
||||
, renderModuleNameConflicts
|
||||
, parseModuleNameConflicts
|
||||
) where
|
||||
|
||||
import Distribution.Simple.Configure (configCompiler, getInstalledPackages)
|
||||
import Distribution.Simple.Compiler (CompilerFlavor (GHC), PackageDB (GlobalPackageDB, SpecificPackageDB))
|
||||
import Distribution.Verbosity (normal)
|
||||
import Distribution.Simple.Program (defaultProgramConfiguration)
|
||||
import Distribution.Simple.PackageIndex (moduleNameIndex)
|
||||
import Distribution.InstalledPackageInfo (sourcePackageId)
|
||||
import Distribution.Package (PackageIdentifier (PackageIdentifier), PackageName (PackageName))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.List (intercalate)
|
||||
import Distribution.ModuleName (components)
|
||||
|
||||
type ModuleNameConflicts = Map.Map (Set.Set String) (Set.Set String)
|
||||
|
||||
getModuleNameConflicts :: FilePath -> IO ModuleNameConflicts
|
||||
getModuleNameConflicts path = do
|
||||
(compiler, progConfig) <-
|
||||
configCompiler (Just GHC) Nothing Nothing defaultProgramConfiguration normal
|
||||
let stack =
|
||||
[ GlobalPackageDB
|
||||
, SpecificPackageDB path
|
||||
]
|
||||
packageIndex <- getInstalledPackages normal compiler stack progConfig
|
||||
let modMap = moduleNameIndex packageIndex
|
||||
packageName (PackageIdentifier (PackageName x) _) = x
|
||||
simpleMN = intercalate "." . components
|
||||
overlaps = Map.unionsWith Set.union
|
||||
$ map (\(mn, pkgs) -> Map.singleton pkgs (Set.singleton $ simpleMN mn))
|
||||
$ Map.toList
|
||||
$ Map.filter (\x -> Set.size x > 1)
|
||||
$ Map.map Set.fromList
|
||||
$ fmap (map (packageName . sourcePackageId)) modMap
|
||||
return overlaps
|
||||
|
||||
renderModuleNameConflicts :: ModuleNameConflicts -> String
|
||||
renderModuleNameConflicts =
|
||||
unlines . map (unwords . Set.toList) . concatMap (\(x, y) -> [x, y]) . Map.toList
|
||||
|
||||
parseModuleNameConflicts :: String -> ModuleNameConflicts
|
||||
parseModuleNameConflicts =
|
||||
Map.fromList . toPairs . map (Set.fromList . words) . lines
|
||||
where
|
||||
toPairs [] = []
|
||||
toPairs [_] = []
|
||||
toPairs (x:y:z) = (x, y) : toPairs z
|
|
@ -15,6 +15,7 @@ library
|
|||
exposed-modules: Stackage.NarrowDatabase
|
||||
Stackage.LoadDatabase
|
||||
Stackage.HaskellPlatform
|
||||
Stackage.ModuleNameConflict
|
||||
Stackage.Util
|
||||
Stackage.Types
|
||||
Stackage.Config
|
||||
|
|
Loading…
Reference in a new issue