hsdev 0.1.7.2 → 0.1.7.3

raw patch · 6 files changed

+56/−19 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hsdev.cabal +1/−1
• src/HsDev/Scan.hs +1/−1
• src/HsDev/Scan/Browse.hs +13/−7
• src/HsDev/Symbols.hs +15/−5
• src/HsDev/Symbols/Location.hs +23/−2
• src/HsDev/Symbols/Util.hs +3/−3

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.7.2
+version:             0.1.7.3
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.

@@ -112,7 +112,7 @@ enumProject p = do
 	p' <- loadProject p
 	pdbs <- liftE $ searchPackageDbStack (view projectPath p')
-	pkgs <- liftM (map $ view packageName) $ browsePackages [] pdbs
+	pkgs <- liftM (map $ view (package . packageName)) $ browsePackages [] pdbs
 	let
 		projOpts :: FilePath -> [String]
 		projOpts f = concatMap makeOpts $ fileTargets p' f where

@@ -5,7 +5,7 @@ 	listModules, browseModules, browse, browseDb,
 	-- * Helpers
 	withPackages, withPackages_,
-	readPackage, ghcPackageDb, ghcModuleLocation,
+	readPackage, readPackageConfig, ghcPackageDb, ghcModuleLocation,
 	packageDbCandidate, packageDbCandidate_,
 	packageConfigs, packageDbModules, lookupModule_,
 
@@ -45,18 +45,18 @@ import Pretty
 
 -- | Browse packages
-browsePackages :: [String] -> PackageDbStack -> ExceptT String IO [ModulePackage]
+browsePackages :: [String] -> PackageDbStack -> ExceptT String IO [PackageConfig]
 browsePackages opts dbs = liftIOErrors $ withPackages_ (packageDbStackOpts dbs ++ opts) $
-	liftM (map readPackage) $ lift packageConfigs
+	liftM (map readPackageConfig) $ lift packageConfigs
 
 -- | Get packages with deps
-browsePackagesDeps :: [String] -> PackageDbStack -> ExceptT String IO (Deps ModulePackage)
+browsePackagesDeps :: [String] -> PackageDbStack -> ExceptT String IO (Deps PackageConfig)
 browsePackagesDeps opts dbs = liftIOErrors $ withPackages (packageDbStackOpts dbs ++ opts) $ \df -> do
 	cfgs <- lift packageConfigs
 	return $ mapDeps (toPkg df) $ mconcat $ map (uncurry deps) $
 		map (GHC.installedPackageId &&& GHC.depends) cfgs
 	where
-		toPkg df' = readPackage . GHC.getPackageDetails df' . GHC.resolveInstalledPackageId df'
+		toPkg df' = readPackageConfig . GHC.getPackageDetails df' . GHC.resolveInstalledPackageId df'
 
 listModules :: [String] -> PackageDbStack -> ExceptT String IO [ModuleLocation]
 listModules opts dbs = liftIOErrors $ withPackages_ (packageDbStackOpts dbs ++ opts) $ do
@@ -83,7 +83,7 @@ 	inTop = (== Just (topPackageDb dbs)) . preview modulePackageDb
 
 browseModule :: PackageDb -> GHC.PackageConfig -> GHC.Module -> ExceptT String GHC.Ghc Module
-browseModule pdb package m = do
+browseModule pdb package' m = do
 	mi <- lift (GHC.getModuleInfo m) >>= maybe (throwError "Can't find module info") return
 	ds <- mapM (toDecl mi) (GHC.modInfoExports mi)
 	let
@@ -98,7 +98,7 @@ 	where
 		thisLoc = view moduleIdLocation $ mloc m
 		mloc m' = ModuleId (fromString mname') $
-			ghcModuleLocation pdb package m'
+			ghcModuleLocation pdb package' m'
 			where
 				mname' = GHC.moduleNameString $ GHC.moduleName m'
 		toDecl minfo n = do
@@ -171,6 +171,12 @@ 
 readPackage :: GHC.PackageConfig -> ModulePackage
 readPackage pc = ModulePackage (GHC.packageNameString pc) (showVersion (GHC.packageVersion pc))
+
+readPackageConfig :: GHC.PackageConfig -> PackageConfig
+readPackageConfig pc = PackageConfig
+	(readPackage pc)
+	(map (fromString . GHC.moduleNameString . GHC.exposedName) $ GHC.exposedModules pc)
+	(GHC.exposed pc)
 
 ghcModuleLocation :: PackageDb -> GHC.PackageConfig -> GHC.Module -> ModuleLocation
 ghcModuleLocation pdb p m = InstalledModule pdb (Just $ readPackage p) (GHC.moduleNameString $ GHC.moduleName m)

@@ -21,6 +21,7 @@ 	-- * Utility
 	locateProject, searchProject,
 	locateSourceDir,
+	standaloneInfo,
 	moduleOpts,
 
 	-- * Modifiers
@@ -42,7 +43,8 @@ import Control.Monad.Except
 import Data.Function (on)
 import Data.List
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)
+import qualified Data.Map as M
 import Data.Ord (comparing)
 import Data.Text (Text)
 import qualified Data.Text as T (concat)
@@ -54,7 +56,7 @@ import HsDev.Symbols.Types
 import HsDev.Symbols.Class
 import HsDev.Symbols.Documented (Documented(..))
-import HsDev.Util (searchPath)
+import HsDev.Util (searchPath, uniqueBy)
 
 -- | Get name of export
 export :: Export -> Text
@@ -228,14 +230,22 @@ 	proj <- MaybeT $ fmap (either (const Nothing) Just) $ runExceptT $ loadProject p
 	MaybeT $ return $ findSourceDir proj file
 
+-- | Make `Info` for standalone `Module`
+standaloneInfo :: [PackageConfig] -> Module -> Info
+standaloneInfo pkgs m = mempty { _infoDepends = pkgDeps ^.. each . package . packageName } where
+	pkgDeps = catMaybes [M.lookup mdep pkgMap >>= listToMaybe | mdep <- m ^.. moduleImports . each . importModuleName]
+	pkgMap = M.unionsWith mergePkgs [M.singleton m' [p] | p <- pkgs, m' <- view packageModules p]
+	mergePkgs ls rs = if null es then hs else es where
+		(es, hs) = partition (view packageExposed) $ uniqueBy (view package) (ls ++ rs)
+
 -- | Options for GHC of module and project
-moduleOpts :: [ModulePackage] -> Module -> [String]
+moduleOpts :: [PackageConfig] -> Module -> [String]
 moduleOpts pkgs m = case view moduleLocation m of
 	FileModule file proj -> concat [
 		hidePackages,
 		targetOpts info']
 		where
-			infos' = maybe [] (`fileTargets` file) proj
+			infos' = maybe [standaloneInfo pkgs m] (`fileTargets` file) proj
 			info' = over infoDepends (filter validDep) (mconcat $ selfInfo : infos')
 			selfInfo
 				| proj ^? _Just . projectName `elem` map Just (infos' ^.. each . infoDepends . each) = fromMaybe mempty $
@@ -243,7 +253,7 @@ 				| otherwise = mempty
 			-- filter out unavailable packages such as unix under windows
 			validDep d = d `elem` pkgs'
-			pkgs' = pkgs ^.. each . packageName
+			pkgs' = pkgs ^.. each . package . packageName
 			hidePackages
 				| null (info' ^. infoDepends) = []
 				| otherwise = ["-hide-all-packages"]

@@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
 
 module HsDev.Symbols.Location (
-	ModulePackage(..), ModuleLocation(..), moduleStandalone, locationId, noLocation,
+	ModulePackage(..), PackageConfig(..), ModuleLocation(..), moduleStandalone, locationId, noLocation,
 	Position(..), Region(..), region, regionAt, regionLines, regionStr,
 	Location(..),
 
 	packageName, packageVersion,
+	package, packageModules, packageExposed,
 	moduleFile, moduleProject, modulePackageDb, modulePackage, cabalModuleName, moduleSourceName,
 	positionLine, positionColumn,
 	regionFrom, regionTo,
@@ -34,7 +35,7 @@ 
 import HsDev.PackageDb
 import HsDev.Project
-import HsDev.Util ((.::), (.::?))
+import HsDev.Util ((.::), (.::?), (.::?!), objectUnion)
 
 -- | Just package name and version without its location
 data ModulePackage = ModulePackage {
@@ -71,6 +72,26 @@ instance FromJSON ModulePackage where
 	parseJSON = withObject "module package" $ \v ->
 		ModulePackage <$> (v .:: "name") <*> (v .:: "version")
+
+data PackageConfig = PackageConfig {
+	_package :: ModulePackage,
+	_packageModules :: [Text],
+	_packageExposed :: Bool }
+		deriving (Eq, Ord, Read, Show)
+
+makeLenses ''PackageConfig
+
+instance NFData PackageConfig where
+	rnf (PackageConfig p ms e) = rnf p `seq` rnf ms `seq` rnf e
+
+instance ToJSON PackageConfig where
+	toJSON (PackageConfig p ms e) = toJSON p `objectUnion` object ["modules" .= ms, "exposed" .= e]
+
+instance FromJSON PackageConfig where
+	parseJSON = withObject "package-config" $ \v -> PackageConfig <$>
+		parseJSON (Object v) <*>
+		(v .::?! "modules") <*>
+		(v .:: "exposed" <|> pure False)
 
 -- | Location of module
 data ModuleLocation =

@@ -35,7 +35,7 @@ -- | Get module package
 packageOf :: ModuleId -> Maybe ModulePackage
 packageOf m = case view moduleIdLocation m of
-	InstalledModule _ package _ -> package
+	InstalledModule _ package' _ -> package'
 	_ -> Nothing
 
 -- | Check if module in project
@@ -71,12 +71,12 @@ -- | Check if module in package
 inPackage :: String -> ModuleId -> Bool
 inPackage p m = case view moduleIdLocation m of
-	InstalledModule _ package _ -> Just p == fmap (view packageName) package
+	InstalledModule _ package' _ -> Just p == fmap (view packageName) package'
 	_ -> False
 
 inVersion :: String -> ModuleId -> Bool
 inVersion v m = case view moduleIdLocation m of
-	InstalledModule _ package _ -> Just v == fmap (view packageVersion) package
+	InstalledModule _ package' _ -> Just v == fmap (view packageVersion) package'
 	_ -> False
 
 -- | Check if module in file