git.iko.soy/stackage
on 91ca149 help sign in
stackage/Stackage/ModuleNameConflict.hs
52 lines 2.2 kB history raw
1module Stackage.ModuleNameConflict
2 ( ModuleNameConflicts
3 , getModuleNameConflicts
4 , renderModuleNameConflicts
5 , parseModuleNameConflicts
6 ) where
8import Distribution.Simple.Configure (configCompiler, getInstalledPackages)
9import Distribution.Simple.Compiler (CompilerFlavor (GHC), PackageDB (GlobalPackageDB, SpecificPackageDB))
10import Distribution.Verbosity (normal)
11import Distribution.Simple.Program (defaultProgramConfiguration)
12import Distribution.Simple.PackageIndex (moduleNameIndex)
13import Distribution.InstalledPackageInfo (sourcePackageId)
14import Distribution.Package (PackageIdentifier (PackageIdentifier), PackageName (PackageName))
15import qualified Data.Map as Map
16import qualified Data.Set as Set
17import Data.List (intercalate)
18import Distribution.ModuleName (components)
20type ModuleNameConflicts = Map.Map (Set.Set String) (Set.Set String)
22getModuleNameConflicts :: FilePath -> IO ModuleNameConflicts
23getModuleNameConflicts path = do
24 (compiler, progConfig) <-
25 configCompiler (Just GHC) Nothing Nothing defaultProgramConfiguration normal
26 let stack =
27 [ GlobalPackageDB
28 , SpecificPackageDB path
29 ]
30 packageIndex <- getInstalledPackages normal compiler stack progConfig
31 let modMap = moduleNameIndex packageIndex
32 packageName (PackageIdentifier (PackageName x) _) = x
33 simpleMN = intercalate "." . components
34 overlaps = Map.unionsWith Set.union
35 $ map (\(mn, pkgs) -> Map.singleton pkgs (Set.singleton $ simpleMN mn))
36 $ Map.toList
37 $ Map.filter (\x -> Set.size x > 1)
38 $ Map.map Set.fromList
39 $ fmap (map (packageName . sourcePackageId)) modMap
40 return overlaps
42renderModuleNameConflicts :: ModuleNameConflicts -> String
43renderModuleNameConflicts =
44 unlines . map (unwords . Set.toList) . concatMap (\(x, y) -> [x, y]) . Map.toList
46parseModuleNameConflicts :: String -> ModuleNameConflicts
47parseModuleNameConflicts =
48 Map.fromList . toPairs . map (Set.fromList . words) . lines
49 where
50 toPairs [] = []
51 toPairs [_] = []
52 toPairs (x:y:z) = (x, y) : toPairs z