hsdev 0.1.3.1 → 0.1.3.2

raw patch · 17 files changed

+525/−399 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hsdev.cabal +2/−1
• src/Control/Concurrent/Task.hs +47/−12
• src/Control/Concurrent/Worker.hs +15/−8
• src/HsDev/Cabal.hs +16/−3
• src/HsDev/Client/Commands.hs +36/−14
• src/HsDev/Commands.hs +8/−5
• src/HsDev/Database/Update.hs +2/−1
• src/HsDev/Inspect.hs +263/−323
• src/HsDev/Project.hs +6/−1
• src/HsDev/Scan.hs +37/−9
• src/HsDev/Scan/Browse.hs +11/−1
• src/HsDev/Server/Commands.hs +3/−4
• src/HsDev/Symbols.hs +48/−4
• src/HsDev/Tools/GhcMod.hs +2/−2
• src/HsDev/Tools/HDocs.hs +8/−7
• src/HsDev/Util.hs +14/−2
• tools/hsinspect.hs +7/−2

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.3.1
+version:             0.1.3.2
 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.
@@ -150,6 +150,7 @@     aeson-pretty >= 0.7.0,
     bytestring >= 0.10.0,
     containers >= 0.5.0,
+    directory >= 1.2.0,
     filepath >= 1.3.0,
     mtl >= 2.1.0,
     text >= 1.1.0,

@@ -1,10 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-}
 
 module Control.Concurrent.Task (
-	Task(..), TaskException(..),
+	Task(..), TaskException(..), TaskResult(..),
 	taskStarted, taskRunning, taskStopped, taskDone, taskFailed, taskCancelled,
-	taskWaitStart, taskWait, taskKill, taskCancel,
-	runTask, forkTask
+	taskWaitStart, taskWait, taskKill, taskCancel, taskStop,
+	runTask, runTask_, forkTask
 	) where
 
 import Control.Applicative
@@ -20,12 +20,30 @@ -- | Task result
 data Task a = Task {
 	taskStart :: MVar (Maybe (SomeException -> IO ())),
-	taskResult :: MVar (Either SomeException a) }
+	taskResult :: TaskResult a }
 
 data TaskException = TaskCancelled | TaskKilled deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)
 
 instance Exception TaskException
 
+data TaskResult a = TaskResult {
+	taskResultEmpty :: IO Bool,
+	taskResultTryRead :: IO (Maybe (Either SomeException a)),
+	taskResultTake :: IO (Either SomeException a),
+	taskResultFail :: SomeException -> IO () }
+
+instance Functor TaskResult where
+	fmap f r = TaskResult {
+		taskResultEmpty = taskResultEmpty r,
+		taskResultTryRead = fmap (fmap (fmap f)) $ taskResultTryRead r,
+		taskResultTake = fmap (fmap f) $ taskResultTake r,
+		taskResultFail = taskResultFail r }
+
+instance Functor Task where
+	fmap f t = Task {
+		taskStart = taskStart t,
+		taskResult = fmap f (taskResult t) }
+
 taskStarted :: Task a -> IO Bool
 taskStarted = fmap (maybe False isJust) . tryReadMVar . taskStart
 
@@ -33,13 +51,13 @@ taskRunning t = (&&) <$> taskStarted t <*> (not <$> taskStopped t)
 
 taskStopped :: Task a -> IO Bool
-taskStopped = fmap not . isEmptyMVar . taskResult
+taskStopped = fmap not . taskResultEmpty . taskResult
 
 taskDone :: Task a -> IO Bool
-taskDone = fmap (maybe False isRight) . tryReadMVar . taskResult
+taskDone = fmap (maybe False isRight) . taskResultTryRead . taskResult
 
 taskFailed :: Task a -> IO Bool
-taskFailed = fmap (maybe False isLeft) . tryReadMVar . taskResult
+taskFailed = fmap (maybe False isLeft) . taskResultTryRead . taskResult
 
 taskCancelled :: Task a -> IO Bool
 taskCancelled = fmap (maybe False isNothing) . tryReadMVar . taskStart
@@ -50,7 +68,7 @@ 
 -- | Wait for task
 taskWait :: Task a -> IO (Either SomeException a)
-taskWait = takeMVar . taskResult
+taskWait = taskResultTake . taskResult
 
 -- | Kill task
 taskKill :: Task a -> IO ()
@@ -62,18 +80,35 @@ taskCancel :: Task a -> IO Bool
 taskCancel t = do
 	aborted <- tryPutMVar (taskStart t) Nothing
-	when aborted $ void $ tryPutMVar (taskResult t) (Left $ toException TaskCancelled)
+	when aborted $ void $ taskResultFail (taskResult t) (toException TaskCancelled)
 	return aborted
 
+-- | Cancel or kill task, returns whether it was cancelled
+taskStop :: Task a -> IO Bool
+taskStop t = do
+	cancelled <- taskCancel t
+	when (not cancelled) $ taskKill t
+	return cancelled
+
 runTask :: (MonadCatch m, MonadIO m, MonadIO n) => (m () -> n ()) -> m a -> n (Task a)
-runTask f act = do
+runTask f = runTask_ (const f)
+
+runTask_ :: (MonadCatch m, MonadIO m, MonadIO n) => (Task a -> m () -> n ()) -> m a -> n (Task a)
+runTask_ f act = do
 	throwVar <- liftIO newEmptyMVar
 	resultVar <- liftIO newEmptyMVar
-	f $ handle (liftIO . putMVar resultVar . Left) $ do
+	f (Task throwVar $ toResult resultVar) $ handle (liftIO . putMVar resultVar . Left) $ do
 		th <- liftIO myThreadId
 		ok <- liftIO $ tryPutMVar throwVar (Just $ throwTo th)
 		when ok $ act >>= liftIO . putMVar resultVar . Right
-	return $ Task throwVar resultVar
+	return $ Task throwVar $ toResult resultVar
+	where
+		toResult :: MVar (Either SomeException a) -> TaskResult a
+		toResult var = TaskResult {
+			taskResultEmpty = isEmptyMVar var,
+			taskResultTryRead = tryReadMVar var,
+			taskResultTake = takeMVar var,
+			taskResultFail = void . tryPutMVar var . Left }
 
 -- | Run task in separate thread
 forkTask :: IO a -> IO (Task a)

@@ -8,15 +8,15 @@ 	) where
 
 import Control.Concurrent.MVar
-import Control.Monad (void, when)
 import Control.Monad.IO.Class
 import Control.Monad.Catch
+import Control.Monad.Error
 
 import Control.Concurrent.FiniteChan
 import Control.Concurrent.Task
 
 data Worker m = Worker {
-	workerChan :: Chan (m ()),
+	workerChan :: Chan (Task (), m ()),
 	workerTask :: MVar (Task ()),
 	workerRestart :: IO Bool }
 
@@ -25,18 +25,25 @@ 	ch <- newChan
 	taskVar <- newEmptyMVar
 	let
-		start = forkTask $ run $ initialize processWork
-		processWork = liftIO (getChan ch) >>= maybe (return ()) (>> processWork)
+		start = forkTask $ do
+			run $ initialize $ processWork
+			processSkip
+		processWork = whileJust (liftM (fmap snd) $ liftIO $ getChan ch) id
+		processSkip = whileJust (liftM (fmap fst) $ getChan ch) taskStop
+		whileJust :: Monad m => m (Maybe a) -> (a -> m b) -> m  ()
+		whileJust v act = v >>= maybe (return ()) (\x -> act x >> whileJust v act)
 	start >>= putMVar taskVar
 	let
 		restart = do
-			f <- readMVar taskVar >>= taskFailed
-			when f (start >>= void . swapMVar taskVar)
-			return f
+			task <- readMVar taskVar
+			stopped <- taskStopped task
+			when stopped (start >>= void . swapMVar taskVar)
+			return stopped
 	return $ Worker ch taskVar restart
 
 sendTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)
-sendTask w = runTask $ putChan (workerChan w)
+sendTask w = runTask_ putTask' where
+	putTask' t act = putChan (workerChan w) (fmap (const ()) t, act)
 
 pushTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)
 pushTask w act = workerRestart w >> sendTask w act

@@ -2,7 +2,7 @@ 
 module HsDev.Cabal (
 	Cabal(..), sandbox,
-	isPackageDb, findPackageDb, locateSandbox, getSandbox,
+	isPackageDb, findPackageDb, locateSandbox, getSandbox, searchSandbox,
 	cabalOpt
 	) where
 
@@ -14,6 +14,8 @@ import System.Directory
 import System.FilePath
 
+import HsDev.Util (searchPath)
+
 -- | Cabal or sandbox
 data Cabal = Cabal | Sandbox FilePath deriving (Eq, Ord)
 
@@ -49,6 +51,10 @@ 	cabalDev dir = "packages-" `isPrefixOf` dir && ".conf" `isSuffixOf` dir
 	cabalSandbox dir = "-packages.conf.d" `isSuffixOf` dir
 
+-- | Is .cabal-sandbox
+cabalSandboxDir :: FilePath -> Bool
+cabalSandboxDir p = takeFileName p == ".cabal-sandbox"
+
 -- | Find -package-db path for sandbox directory or package-db file itself
 findPackageDb :: FilePath -> IO (Maybe FilePath)
 findPackageDb sand = do
@@ -57,8 +63,11 @@ 	if
 		| isDir && isPackageDb sand' -> return $ Just sand'
 		| isDir -> do
-			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents sand'
-			return $ fmap (sand' </>) $ find isPackageDb cts
+			cts <- getDirectoryContents sand'
+			(dir', cts') <- case find cabalSandboxDir cts of
+				Nothing -> return (sand', cts)
+				Just sbox -> (,) <$> pure (sand' </> sbox) <*> getDirectoryContents (sand' </> sbox)
+			return $ fmap (dir' </>) $ find isPackageDb cts'
 		| otherwise -> return Nothing
 
 -- | Create sandbox by directory or package-db file
@@ -70,6 +79,10 @@ -- | Try find sandbox by parent directory
 getSandbox :: FilePath -> IO Cabal
 getSandbox = liftM (either (const Cabal) id) . runErrorT . locateSandbox
+
+-- | Search sandbox
+searchSandbox :: FilePath -> IO Cabal
+searchSandbox p = runErrorT (searchPath p locateSandbox) >>= either (const $ return Cabal) return
 
 -- | Cabal ghc option
 cabalOpt :: Cabal -> [String]

@@ -90,6 +90,7 @@ 		listModules',
 	cmdList' "packages" [] [] "list packages" listPackages',
 	cmdList' "projects" [] [] "list projects" listProjects',
+	cmdList' "sandboxes" [] [] "list sandboxes" listSandboxes',
 	cmdList' "symbol" ["name"] (matches ++ sandboxes ++ [
 		projectArg `desc` "related project",
 		fileArg `desc` "source file",
@@ -114,9 +115,14 @@ 		"resolve module scope (or exports)"
 		resolve',
 	cmd' "project" [] [
-		projectArg `desc` "project path or name"]
+		projectArg `desc` "project path or name",
+		pathArg `desc` "locate project in parent of this path"]
 		"get project info"
 		project',
+	cmd' "sandbox" [] [
+		pathArg `desc` "locate sandbox in parent of this path"]
+		"get sandbox info"
+		sandbox',
 	-- Context commands
 	cmdList' "lookup" ["symbol"] ctx "lookup for symbol" lookup',
 	cmdList' "whois" ["symbol"] ctx "get info for symbol" whois',
@@ -364,6 +370,10 @@ 			dbval <- getDb copts
 			return $ M.elems $ databaseProjects dbval
 
+		-- | List sandboxes
+		listSandboxes' :: [String] -> Opts String -> CommandActionT [Cabal]
+		listSandboxes' _ _ copts = (nub . sort . mapMaybe (cabalOf . moduleId) . allModules) <$> getDb copts
+
 		-- | Get symbol info
 		symbol' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
 		symbol' ns as copts = do
@@ -448,9 +458,17 @@ 		-- | Get project info
 		project' :: [String] -> Opts String -> CommandActionT Project
 		project' _ as copts = do
-			proj <- maybe (commandError "Specify project name or .cabal file" []) (mapErrorStr . findProject copts) $ arg "project" as
-			return proj
+			proj <- runMaybeT $ msum $ map MaybeT [
+				traverse (mapErrorStr . findProject copts) $ arg "project" as,
+				liftM join $ traverse (liftIO . searchProject) $ arg "path" as]
+			maybe (commandError "Specify project name, .cabal file or search directory" []) return proj
 
+		-- | Locate sandbox
+		sandbox' :: [String] -> Opts String -> CommandActionT Cabal
+		sandbox' _ as _ = do
+			sbox <- traverse (liftIO . searchSandbox) (arg "path" as)
+			maybe (commandError "Specify search directory" []) return sbox
+
 		-- | Lookup info about symbol
 		lookup' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
 		lookup' [nm] as copts = do
@@ -467,7 +485,7 @@ 			mapErrorStr $ whois dbval cabal srcFile nm
 		whois' _ _ _ = commandError "Invalid arguments" []
 
-		-- | Get modules accessible from module
+		-- | Get modules accessible from module or from directory
 		scopeModules' :: [String] -> Opts String -> CommandActionT [ModuleId]
 		scopeModules' [] as copts = do
 			dbval <- getDb copts
@@ -626,7 +644,7 @@ findSandbox :: (MonadIO m, Error e) => CommandOptions -> Maybe FilePath -> ErrorT e m Cabal
 findSandbox copts = maybe
 	(return Cabal)
-	(findPath copts >=> mapErrorStr . mapErrorT liftIO . locateSandbox)
+	(findPath copts >=> mapErrorStr . liftIO . getSandbox)
 
 -- | Canonicalize path
 findPath :: (MonadIO m, Error e) => CommandOptions -> FilePath -> ErrorT e m FilePath
@@ -637,9 +655,10 @@ 
 -- | Get context: file and sandbox
 getCtx :: (MonadIO m, Functor m, Error e) => CommandOptions -> Opts String -> ErrorT e m (FilePath, Cabal)
-getCtx copts as = liftM2 (,)
-	(forceJust "No file specified" $ traverse (findPath copts) $ arg "file" as)
-	(getCabal copts as)
+getCtx copts as = do
+	f <- forceJust "No file specified" $ traverse (findPath copts) $ arg "file" as
+	c <- getCabal_ copts as >>= maybe (liftIO $ getSandbox f) return
+	return (f, c)
 
 -- | Get current sandbox set, user-db by default
 getCabal :: (MonadIO m, Error e) => CommandOptions -> Opts String -> ErrorT e m Cabal
@@ -678,8 +697,8 @@ 			| takeExtension p == ".cabal" = p
 			| otherwise = p </> (takeBaseName p <.> "cabal")
 
--- | Find dependency: it may be source, project file or project name
-findDep :: (MonadIO m, Error e) => CommandOptions -> String -> ErrorT e m (Project, Maybe FilePath)
+-- | Find dependency: it may be source, project file or project name, also returns sandbox found
+findDep :: (MonadIO m, Error e) => CommandOptions -> String -> ErrorT e m (Project, Maybe FilePath, Cabal)
 findDep copts depName = do
 	proj <- msum [
 		mapErrorStr $ do
@@ -689,12 +708,15 @@ 	src <- if takeExtension depName == ".hs"
 		then liftM Just (findPath copts depName)
 		else return Nothing
-	return (proj, src)
+	sbox <- liftIO $ searchSandbox $ projectPath proj
+	return (proj, src, sbox)
 
 -- | Check if project or source depends from this module
-inDeps :: (Project, Maybe FilePath) -> ModuleId -> Bool
-inDeps (proj, Just src) = inDepsOfFile proj src
-inDeps (proj, Nothing) = inDepsOfProject proj
+inDeps :: (Project, Maybe FilePath, Cabal) -> ModuleId -> Bool
+inDeps (proj, src, cabal) = liftM2 (&&) (restrictCabal cabal) deps' where
+	deps' = case src of
+		Nothing -> inDepsOfProject proj
+		Just src' -> inDepsOfFile proj src'
 
 -- | Supply module with its source file path if any
 toPair :: Module -> Maybe (FilePath, Module)

@@ -33,6 +33,7 @@ import HsDev.Symbols
 import HsDev.Symbols.Resolve
 import HsDev.Symbols.Util
+import HsDev.Tools.Base (matchRx, at)
 
 -- | Find declaration by name
 findDeclaration :: Database -> String -> ErrorT String IO [ModuleDeclaration]
@@ -158,11 +159,13 @@ 
 -- | Split identifier into module name and identifier itself
 splitIdentifier :: String -> (Maybe String, String)
-splitIdentifier name = (qname, name') where
-	prefix = dropWhileEnd (/= '.') name
-	prefix' = dropWhileEnd (== '.') prefix
-	qname = if null prefix' then Nothing else Just prefix'
-	name' = fromMaybe (error "Impossible happened") $ stripPrefix prefix name
+splitIdentifier name = fromMaybe (Nothing, name) $ do
+	groups <- matchRx "(([A-Z][\\w']*\\.)*)(.*)" name
+	return (fmap dropDot $ groups 1, groups `at` 3)
+	where
+		dropDot :: String -> String
+		dropDot "" = ""
+		dropDot s = init s
 
 -- | Get context file and project
 fileCtx :: Database -> FilePath -> ErrorT String IO (FilePath, Module, Maybe Project)

@@ -252,9 +252,10 @@ -- | Scan directory for source files and projects
 scanDirectory :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
 scanDirectory opts dir = runTask "scanning" (subject dir ["path" .= dir]) $ do
-	(projSrcs, standSrcs) <- runTask "getting list of sources" [] $
+	S.ScanContents standSrcs projSrcs sboxes <- runTask "getting list of sources" [] $
 		liftErrorT $ S.enumDirectory dir
 	runTasks [scanProject opts (projectCabal p) | (p, _) <- projSrcs]
+	runTasks $ map (scanCabal opts) sboxes
 	loadCache $ Cache.loadFiles $ mapMaybe (moduleSource . fst) standSrcs
 	scanModules opts standSrcs
 

@@ -1,323 +1,263 @@-{-# LANGUAGE TypeSynonymInstances #-}
-
-module HsDev.Inspect (
-	analyzeModule,
-	inspectContents, contentsInspection,
-	inspectFile, fileInspection,
-	projectDirs, projectSources,
-	inspectProject
-	) where
-
-import Control.Arrow
-import Control.Applicative
-import Control.DeepSeq
-import qualified Control.Exception as E
-import Control.Monad
-import Control.Monad.Error
-import Data.Function (on)
-import Data.List
-import Data.Map (Map)
-import Data.Maybe (fromMaybe, mapMaybe, catMaybes)
-import Data.Ord (comparing)
-import Data.String (fromString)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
-import Data.Traversable (traverse, sequenceA)
-import qualified Data.Map as M
-import qualified Language.Haskell.Exts as H
-import qualified Documentation.Haddock as Doc
-import qualified System.Directory as Dir
-import System.IO
-import System.FilePath
-import Data.Generics.Uniplate.Data
-
-import qualified Name (Name, getOccString, occNameString)
-import qualified Module (moduleNameString)
-import qualified SrcLoc as Loc
-import qualified HsDecls
-import qualified HsBinds
-
-import HsDev.Symbols
-import HsDev.Project
-import HsDev.Tools.Base
-import HsDev.Tools.HDocs (hdocsProcess)
-import HsDev.Util
-
--- | Analize source contents
-analyzeModule :: [String] -> Maybe FilePath -> String -> Either String Module
-analyzeModule exts file source = case H.parseFileContentsWithMode pmode source' of
-		H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason
-		H.ParseOk (H.Module _ (H.ModuleName mname) _ _ mexports imports declarations) -> Right Module {
-			moduleName = fromString mname,
-			moduleDocs =  Nothing,
-			moduleLocation = ModuleSource Nothing,
-			moduleExports = fmap (concatMap getExports) mexports,
-			moduleImports = map getImport imports,
-			moduleDeclarations = sortDeclarations $ getDecls declarations }
-	where
-		pmode :: H.ParseMode
-		pmode = H.defaultParseMode {
-			H.parseFilename = fromMaybe (H.parseFilename H.defaultParseMode) file,
-			H.baseLanguage = H.Haskell2010,
-			H.extensions = H.glasgowExts ++ map H.parseExtension exts,
-			H.fixities = Just H.baseFixities }
-
-		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces
-		source' = map untab source
-		untab '\t' = ' '
-		untab ch = ch
-
-getExports :: H.ExportSpec -> [Export]
-getExports (H.EModuleContents (H.ModuleName m)) = [ExportModule $ fromString m]
-getExports e = map (uncurry ExportName . (fmap fromString *** fromString) . identOfQName) $ childrenBi e
-
-getImport :: H.ImportDecl -> Import
-getImport d = Import
-	(mname (H.importModule d))
-	(H.importQualified d)
-	(mname <$> H.importAs d)
-	(importLst <$> H.importSpecs d)
-	(Just $ toPosition $ H.importLoc d)
-	where
-		mname (H.ModuleName n) = fromString n
-		importLst (hiding, specs) = ImportList hiding $ map (fromString . identOfName) (concatMap childrenBi specs :: [H.Name])
-
-getDecls :: [H.Decl] -> [Declaration]
-getDecls decls =
-	map mergeDecls .
-	groupBy ((==) `on` declarationName) .
-	sortBy (comparing declarationName) $
-	concatMap getDecl decls ++ concatMap getDef decls
-	where
-		mergeDecls :: [Declaration] -> Declaration
-		mergeDecls [] = error "Impossible"
-		mergeDecls ds = Declaration
-			(declarationName $ head ds)
-			Nothing
-			Nothing
-			(msum $ map declarationDocs ds)
-			(minimum <$> mapM declarationPosition ds)
-			(foldr1 mergeInfos $ map declaration ds)
-
-		mergeInfos :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
-		mergeInfos (Function ln ld) (Function rn rd) = Function (ln `mplus` rn) (ld ++ rd)
-		mergeInfos l _ = l
-
-getBinds :: H.Binds -> [Declaration]
-getBinds (H.BDecls decls) = getDecls decls
-getBinds _ = []
-
-getDecl :: H.Decl -> [Declaration]
-getDecl decl' = case decl' of
-	H.TypeSig loc names typeSignature -> [mkFun loc n (Function (Just $ fromString $ oneLinePrint typeSignature) []) | n <- names]
-	H.TypeDecl loc n args _ -> [mkType loc n Type args]
-	H.DataDecl loc dataOrNew ctx n args _ _ -> [mkType loc n (ctor dataOrNew `withCtx` ctx) args]
-	H.GDataDecl loc dataOrNew ctx n args _ _ _ -> [mkType loc n (ctor dataOrNew `withCtx` ctx) args]
-	H.ClassDecl loc ctx n args _ _ -> [mkType loc n (Class `withCtx` ctx) args]
-	_ -> []
-	where
-		mkFun :: H.SrcLoc -> H.Name -> DeclarationInfo -> Declaration
-		mkFun loc n = setPosition loc . decl (fromString $ identOfName n)
-
-		mkType :: H.SrcLoc -> H.Name -> (TypeInfo -> DeclarationInfo) -> [H.TyVarBind] -> Declaration
-		mkType loc n ctor' args = setPosition loc $ decl (fromString $ identOfName n) $ ctor' $ TypeInfo Nothing (map (fromString . oneLinePrint) args) Nothing
-
-		withCtx :: (TypeInfo -> DeclarationInfo) -> H.Context -> TypeInfo -> DeclarationInfo
-		withCtx ctor' ctx tinfo = ctor' (tinfo { typeInfoContext = makeCtx ctx })
-
-		ctor :: H.DataOrNew -> TypeInfo -> DeclarationInfo
-		ctor H.DataType = Data
-		ctor H.NewType = NewType
-
-		makeCtx [] = Nothing
-		makeCtx ctx = Just $ fromString $ intercalate ", " $ map oneLinePrint ctx
-
-		oneLinePrint :: H.Pretty a => a -> String
-		oneLinePrint = H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode
-
-getDef :: H.Decl -> [Declaration]
-getDef (H.FunBind []) = []
-getDef (H.FunBind matches@(H.Match loc n _ _ _ _ : _)) = [setPosition loc $ decl (fromString $ identOfName n) fun] where
-	fun = Function Nothing $ concatMap (getBinds . matchBinds) matches
-	matchBinds (H.Match _ _ _ _ _ binds) = binds
-getDef (H.PatBind loc pat _ binds) = map (\name -> setPosition loc (decl (fromString $ identOfName name) (Function Nothing $ getBinds binds))) (names pat) where
-	names :: H.Pat -> [H.Name]
-	names (H.PVar n) = [n]
-	names (H.PNPlusK n _) = [n]
-	names (H.PInfixApp l _ r) = names l ++ names r
-	names (H.PApp _ ns) = concatMap names ns
-	names (H.PTuple _ ns) = concatMap names ns
-	names (H.PList ns) = concatMap names ns
-	names (H.PParen n) = names n
-	names (H.PRec _ pf) = concatMap fieldNames pf
-	names (H.PAsPat n ns) = n : names ns
-	names H.PWildCard = []
-	names (H.PIrrPat n) = names n
-	names (H.PatTypeSig _ n _) = names n
-	names (H.PViewPat _ n) = names n
-	names (H.PBangPat n) = names n
-	names _ = []
-
-	fieldNames :: H.PatField -> [H.Name]
-	fieldNames (H.PFieldPat _ n) = names n
-	fieldNames (H.PFieldPun n) = case n of
-		H.Qual _ n' -> [n']
-		H.UnQual n' -> [n']
-		_ -> []
-	fieldNames H.PFieldWildcard = []
-getDef _ = []
-
-identOfQName :: H.QName -> (Maybe String, String)
-identOfQName (H.Qual (H.ModuleName mname) name) = (Just mname, identOfName name)
-identOfQName (H.UnQual name) = (Nothing, identOfName name)
-identOfQName (H.Special sname) = (Nothing, H.prettyPrint sname)
-
-identOfName :: H.Name -> String
-identOfName name = case name of
-	H.Ident s -> s
-	H.Symbol s -> s
-
-toPosition :: H.SrcLoc -> Position
-toPosition (H.SrcLoc _ l c) = Position l c
-
-setPosition :: H.SrcLoc -> Declaration -> Declaration
-setPosition loc d = d { declarationPosition = Just (toPosition loc) }
-
--- | Get Map from declaration name to its documentation
-documentationMap :: Doc.Interface -> Map String String
-documentationMap iface = M.fromList $ concatMap toDoc $ Doc.ifaceExportItems iface where
-	toDoc :: Doc.ExportItem Name.Name -> [(String, String)]
-	toDoc (Doc.ExportDecl decl' docs _ _ _ _) = maybe [] (zip (extractNames decl') . repeat) $ extractDocs docs
-	toDoc _ = []
-
-	extractNames :: HsDecls.LHsDecl Name.Name -> [String]
-	extractNames (Loc.L _ d) = case d of
-		HsDecls.TyClD ty -> [locatedName $ HsDecls.tcdLName ty]
-		HsDecls.SigD sig -> case sig of
-			HsBinds.TypeSig names _ -> map locatedName names
-			HsBinds.GenericSig names _ -> map locatedName names
-			_ -> []
-		_ -> []
-
-	extractDocs :: Doc.DocForDecl Name.Name -> Maybe String
-	extractDocs (mbDoc, _) = printDoc <$> Doc.documentationDoc mbDoc where
-		printDoc :: Doc.Doc Name.Name -> String
-		printDoc Doc.DocEmpty = ""
-		printDoc (Doc.DocAppend l r) = printDoc l ++ printDoc r
-		printDoc (Doc.DocString s) = s
-		printDoc (Doc.DocParagraph p) = printDoc p
-		printDoc (Doc.DocIdentifier i) = Name.getOccString i
-		printDoc (Doc.DocIdentifierUnchecked (m, i)) = Module.moduleNameString m ++ "." ++ Name.occNameString i
-		printDoc (Doc.DocModule m) = m
-		printDoc (Doc.DocWarning w) = printDoc w
-		printDoc (Doc.DocEmphasis e) = printDoc e
-		printDoc (Doc.DocMonospaced m) = printDoc m
-		printDoc (Doc.DocUnorderedList lst) = concatMap printDoc lst -- Is this right?
-		printDoc (Doc.DocOrderedList lst) = concatMap printDoc lst -- And this
-		printDoc (Doc.DocDefList defs) = concatMap (\(l, r) -> printDoc l ++ " = " ++ printDoc r) defs -- ?
-		printDoc (Doc.DocCodeBlock code) = printDoc code
-		printDoc (Doc.DocPic pic) = show pic
-		printDoc (Doc.DocAName a) = a
-		printDoc (Doc.DocExamples exs) = unlines $ map showExample exs where
-			showExample (Doc.Example expr results) = expr ++ " => " ++ intercalate ", " results
-		printDoc (Doc.DocHyperlink link) = fromMaybe (Doc.hyperlinkUrl link) (Doc.hyperlinkLabel link)
-		printDoc (Doc.DocProperty prop) = prop
-		-- Catch all unsupported ones
-		printDoc _ = "[unsupported-by-extractDocs]" -- TODO
-
-	locatedName :: Loc.Located Name.Name -> String
-	locatedName (Loc.L _ nm) = Name.getOccString nm
-
--- | Adds documentation to declaration
-addDoc :: Map String String -> Declaration -> Declaration
-addDoc docsMap decl' = decl' { declarationDocs = M.lookup (declarationName decl') docsMap' } where
-	docsMap' = M.mapKeys fromString . M.map fromString $ docsMap
-
--- | Adds documentation to all declarations in module
-addDocs :: Map String String -> Module -> Module
-addDocs docsMap m = m { moduleDeclarations = map (addDoc docsMap) (moduleDeclarations m) }
-
--- | Inspect contents
-inspectContents :: String -> [String] -> String -> ErrorT String IO InspectedModule
-inspectContents name opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do
-	analyzed <- ErrorT $ return $ analyzeModule exts (Just name) cts
-	return $ setLoc analyzed
-	where
-		setLoc m = m { moduleLocation = ModuleSource (Just name) }
-
-		exts = mapMaybe flagExtension opts
-
-contentsInspection :: String -> [String] -> ErrorT String IO Inspection
-contentsInspection _ _ = return InspectionNone -- crc or smth
-
--- | Inspect file
-inspectFile :: [String] -> FilePath -> ErrorT String IO InspectedModule
-inspectFile opts file = do
-	let
-		noReturn :: E.SomeException -> IO [Doc.Interface]
-		noReturn _ = return []
-
-		hdocsWorkaround = True
-	proj <- liftIO $ locateProject file
-	absFilename <- liftIO $ Dir.canonicalizePath file
-	inspect (FileModule absFilename proj) (fileInspection absFilename opts) $ do
-		docsMap <- liftIO $ if hdocsWorkaround
-			then hdocsProcess absFilename opts
-			else fmap (fmap documentationMap . lookup absFilename) $ do
-				is <- E.catch (Doc.createInterfaces ([Doc.Flag_Verbosity "0", Doc.Flag_NoWarnings] ++ map Doc.Flag_OptGhc opts) [absFilename]) noReturn
-				forM is $ \i -> do
-					mfile <- Dir.canonicalizePath $ Doc.ifaceOrigFilename i
-					return (mfile, i)
-		forced <- ErrorT $ E.handle onError $ do
-			analyzed <- liftM (analyzeModule exts (Just absFilename)) $ readFileUtf8 absFilename
-			force analyzed `deepseq` return analyzed
-			--E.evaluate $ force analyzed
-		return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced
-	where
-		setLoc f p m = m { moduleLocation = FileModule f p }
-		onError :: E.ErrorCall -> IO (Either String Module)
-		onError = return . Left . show
-
-		exts = mapMaybe flagExtension opts
-
--- | File inspection data
-fileInspection :: FilePath -> [String] -> ErrorT String IO Inspection
-fileInspection f opts = do
-	tm <- liftIO $ Dir.getModificationTime f
-	return $ InspectionAt (utcTimeToPOSIXSeconds tm) $ sort $ nub opts
-
--- | Enumerate project dirs
-projectDirs :: Project -> ErrorT String IO [Extensions FilePath]
-projectDirs p = do
-	p' <- loadProject p
-	return $ nub $ map (fmap (normalise . (projectPath p' </>))) $ maybe [] sourceDirs $ projectDescription p'
-
--- | Enumerate project source files
-projectSources :: Project -> ErrorT String IO [Extensions FilePath]
-projectSources p = do
-	dirs <- projectDirs p
-	let
-		enumCabals = liftM (map takeDirectory . filter cabalFile) . traverseDirectory
-		dirs' = map entity dirs
-	-- enum inner projects and dont consider them as part of this project
-	subProjs <- liftIO $ liftM (delete (projectPath p) . nub . concat) $ mapM (liftIO . enumCabals) dirs'
-	let
-		enumHs = liftM (filter thisProjectSource) . traverseDirectory
-		thisProjectSource h = haskellSource h && not (any (`isParent` h) subProjs)
-	liftIO $ liftM (nub . concat) $ mapM (liftM sequenceA . traverse (liftIO . enumHs)) dirs
-
--- | Inspect project
-inspectProject :: [String] -> Project -> ErrorT String IO (Project, [InspectedModule])
-inspectProject opts p = do
-	p' <- loadProject p
-	srcs <- projectSources p'
-	modules <- mapM inspectFile' srcs
-	return (p', catMaybes modules)
-	where
-		inspectFile' exts = liftM return (inspectFile (opts ++ extensionsOpts (extensions exts)) (entity exts)) <|> return Nothing
-
--- | Read file in UTF8
-readFileUtf8 :: FilePath -> IO String
-readFileUtf8 f = withFile f ReadMode $ \h -> do
-	hSetEncoding h utf8
-	cts <- hGetContents h
-	length cts `seq` return cts
+{-# LANGUAGE TypeSynonymInstances, ViewPatterns #-}++module HsDev.Inspect (+	analyzeModule,+	inspectContents, contentsInspection,+	inspectFile, fileInspection,+	projectDirs, projectSources,+	inspectProject+	) where++import Control.Arrow+import Control.Applicative+import Control.DeepSeq+import qualified Control.Exception as E+import Control.Monad+import Control.Monad.Error+import Data.Function (on)+import Data.List+import Data.Map (Map)+import Data.Maybe (fromMaybe, mapMaybe, catMaybes)+import Data.Ord (comparing)+import Data.String (fromString)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.Traversable (traverse, sequenceA)+import qualified Data.Map as M+import qualified Language.Haskell.Exts as H+import qualified System.Directory as Dir+import System.IO+import System.FilePath+import Data.Generics.Uniplate.Data++import HsDev.Symbols+import HsDev.Project+import HsDev.Tools.Base+import HsDev.Tools.HDocs (hdocs, hdocsProcess)+import HsDev.Util++-- | Analize source contents+analyzeModule :: [String] -> Maybe FilePath -> String -> Either String Module+analyzeModule exts file source = case H.parseFileContentsWithMode pmode source' of+		H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason+		H.ParseOk (H.Module _ (H.ModuleName mname) _ _ mexports imports declarations) -> Right Module {+			moduleName = fromString mname,+			moduleDocs =  Nothing,+			moduleLocation = ModuleSource Nothing,+			moduleExports = fmap (concatMap getExports) mexports,+			moduleImports = map getImport imports,+			moduleDeclarations = sortDeclarations $ getDecls declarations }+	where+		pmode :: H.ParseMode+		pmode = H.defaultParseMode {+			H.parseFilename = fromMaybe (H.parseFilename H.defaultParseMode) file,+			H.baseLanguage = H.Haskell2010,+			H.extensions = H.glasgowExts ++ map H.parseExtension exts,+			H.fixities = Just H.baseFixities }++		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces+		source' = map untab source+		untab '\t' = ' '+		untab ch = ch++getExports :: H.ExportSpec -> [Export]+getExports (H.EModuleContents (H.ModuleName m)) = [ExportModule $ fromString m]+getExports e = map (uncurry ExportName . (fmap fromString *** fromString) . identOfQName) $ childrenBi e++getImport :: H.ImportDecl -> Import+getImport d = Import+	(mname (H.importModule d))+	(H.importQualified d)+	(mname <$> H.importAs d)+	(importLst <$> H.importSpecs d)+	(Just $ toPosition $ H.importLoc d)+	where+		mname (H.ModuleName n) = fromString n+		importLst (hiding, specs) = ImportList hiding $ map (fromString . identOfName) (concatMap childrenBi specs :: [H.Name])++getDecls :: [H.Decl] -> [Declaration]+getDecls decls =+	map mergeDecls .+	groupBy ((==) `on` declarationName) .+	sortBy (comparing declarationName) $+	concatMap getDecl decls ++ concatMap getDef decls+	where+		mergeDecls :: [Declaration] -> Declaration+		mergeDecls [] = error "Impossible"+		mergeDecls ds = Declaration+			(declarationName $ head ds)+			Nothing+			Nothing+			(msum $ map declarationDocs ds)+			(minimum <$> mapM declarationPosition ds)+			(foldr1 mergeInfos $ map declaration ds)++		mergeInfos :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo+		mergeInfos (Function ln ld) (Function rn rd) = Function (ln `mplus` rn) (ld ++ rd)+		mergeInfos l _ = l++getBinds :: H.Binds -> [Declaration]+getBinds (H.BDecls decls) = getDecls decls+getBinds _ = []++getDecl :: H.Decl -> [Declaration]+getDecl decl' = case decl' of+	H.TypeSig loc names typeSignature -> [mkFun loc n (Function (Just $ fromString $ oneLinePrint typeSignature) []) | n <- names]+	H.TypeDecl loc n args _ -> [mkType loc n Type args]+	H.DataDecl loc dataOrNew ctx n args _ _ -> [mkType loc n (ctor dataOrNew `withCtx` ctx) args]+	H.GDataDecl loc dataOrNew ctx n args _ _ _ -> [mkType loc n (ctor dataOrNew `withCtx` ctx) args]+	H.ClassDecl loc ctx n args _ _ -> [mkType loc n (Class `withCtx` ctx) args]+	_ -> []+	where+		mkFun :: H.SrcLoc -> H.Name -> DeclarationInfo -> Declaration+		mkFun loc n = setPosition loc . decl (fromString $ identOfName n)++		mkType :: H.SrcLoc -> H.Name -> (TypeInfo -> DeclarationInfo) -> [H.TyVarBind] -> Declaration+		mkType loc n ctor' args = setPosition loc $ decl (fromString $ identOfName n) $ ctor' $ TypeInfo Nothing (map (fromString . oneLinePrint) args) Nothing++		withCtx :: (TypeInfo -> DeclarationInfo) -> H.Context -> TypeInfo -> DeclarationInfo+		withCtx ctor' ctx tinfo = ctor' (tinfo { typeInfoContext = makeCtx ctx })++		ctor :: H.DataOrNew -> TypeInfo -> DeclarationInfo+		ctor H.DataType = Data+		ctor H.NewType = NewType++		makeCtx [] = Nothing+		makeCtx ctx = Just $ fromString $ intercalate ", " $ map oneLinePrint ctx++		oneLinePrint :: H.Pretty a => a -> String+		oneLinePrint = H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode++getDef :: H.Decl -> [Declaration]+getDef (H.FunBind []) = []+getDef (H.FunBind matches@(H.Match loc n _ _ _ _ : _)) = [setPosition loc $ decl (fromString $ identOfName n) fun] where+	fun = Function Nothing $ concatMap (getBinds . matchBinds) matches+	matchBinds (H.Match _ _ _ _ _ binds) = binds+getDef (H.PatBind loc pat _ binds) = map (\name -> setPosition loc (decl (fromString $ identOfName name) (Function Nothing $ getBinds binds))) (names pat) where+	names :: H.Pat -> [H.Name]+	names (H.PVar n) = [n]+	names (H.PNPlusK n _) = [n]+	names (H.PInfixApp l _ r) = names l ++ names r+	names (H.PApp _ ns) = concatMap names ns+	names (H.PTuple _ ns) = concatMap names ns+	names (H.PList ns) = concatMap names ns+	names (H.PParen n) = names n+	names (H.PRec _ pf) = concatMap fieldNames pf+	names (H.PAsPat n ns) = n : names ns+	names H.PWildCard = []+	names (H.PIrrPat n) = names n+	names (H.PatTypeSig _ n _) = names n+	names (H.PViewPat _ n) = names n+	names (H.PBangPat n) = names n+	names _ = []++	fieldNames :: H.PatField -> [H.Name]+	fieldNames (H.PFieldPat _ n) = names n+	fieldNames (H.PFieldPun n) = case n of+		H.Qual _ n' -> [n']+		H.UnQual n' -> [n']+		_ -> []+	fieldNames H.PFieldWildcard = []+getDef _ = []++identOfQName :: H.QName -> (Maybe String, String)+identOfQName (H.Qual (H.ModuleName mname) name) = (Just mname, identOfName name)+identOfQName (H.UnQual name) = (Nothing, identOfName name)+identOfQName (H.Special sname) = (Nothing, H.prettyPrint sname)++identOfName :: H.Name -> String+identOfName name = case name of+	H.Ident s -> s+	H.Symbol s -> s++toPosition :: H.SrcLoc -> Position+toPosition (H.SrcLoc _ l c) = Position l c++setPosition :: H.SrcLoc -> Declaration -> Declaration+setPosition loc d = d { declarationPosition = Just (toPosition loc) }++-- | Adds documentation to declaration+addDoc :: Map String String -> Declaration -> Declaration+addDoc docsMap decl' = decl' { declarationDocs = M.lookup (declarationName decl') docsMap' } where+	docsMap' = M.mapKeys fromString . M.map fromString $ docsMap++-- | Adds documentation to all declarations in module+addDocs :: Map String String -> Module -> Module+addDocs docsMap m = m { moduleDeclarations = map (addDoc docsMap) (moduleDeclarations m) }++-- | Inspect contents+inspectContents :: String -> [String] -> String -> ErrorT String IO InspectedModule+inspectContents name opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do+	analyzed <- ErrorT $ return $ analyzeModule exts (Just name) cts+	return $ setLoc analyzed+	where+		setLoc m = m { moduleLocation = ModuleSource (Just name) }++		exts = mapMaybe flagExtension opts++contentsInspection :: String -> [String] -> ErrorT String IO Inspection+contentsInspection _ _ = return InspectionNone -- crc or smth++-- | Inspect file+inspectFile :: [String] -> FilePath -> ErrorT String IO InspectedModule+inspectFile opts file = do+	let+		hdocsWorkaround = False+	proj <- liftIO $ locateProject file+	absFilename <- liftIO $ Dir.canonicalizePath file+	inspect (FileModule absFilename proj) (fileInspection absFilename opts) $ do+		docsMap <- liftIO $ if hdocsWorkaround+			then hdocsProcess absFilename opts+			else liftM Just $ hdocs (FileModule absFilename Nothing) opts+		forced <- ErrorT $ E.handle onError $ do+			analyzed <- liftM (analyzeModule exts (Just absFilename)) $ readFileUtf8 absFilename+			force analyzed `deepseq` return analyzed+		return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced+	where+		setLoc f p m = m { moduleLocation = FileModule f p }+		onError :: E.ErrorCall -> IO (Either String Module)+		onError = return . Left . show++		exts = mapMaybe flagExtension opts++-- | File inspection data+fileInspection :: FilePath -> [String] -> ErrorT String IO Inspection+fileInspection f opts = do+	tm <- liftIO $ Dir.getModificationTime f+	return $ InspectionAt (utcTimeToPOSIXSeconds tm) $ sort $ nub opts++-- | Enumerate project dirs+projectDirs :: Project -> ErrorT String IO [Extensions FilePath]+projectDirs p = do+	p' <- loadProject p+	return $ nub $ map (fmap (normalise . (projectPath p' </>))) $ maybe [] sourceDirs $ projectDescription p'++-- | Enumerate project source files+projectSources :: Project -> ErrorT String IO [Extensions FilePath]+projectSources p = do+	dirs <- projectDirs p+	let+		enumCabals = liftM (map takeDirectory . filter cabalFile) . traverseDirectory+		dirs' = map entity dirs+	-- enum inner projects and dont consider them as part of this project+	subProjs <- liftIO $ liftM (delete (projectPath p) . nub . concat) $ mapM (liftIO . enumCabals) dirs'+	let+		enumHs = liftM (filter thisProjectSource) . traverseDirectory+		thisProjectSource h = haskellSource h && not (any (`isParent` h) subProjs)+	liftIO $ liftM (nub . concat) $ mapM (liftM sequenceA . traverse (liftIO . enumHs)) dirs++-- | Inspect project+inspectProject :: [String] -> Project -> ErrorT String IO (Project, [InspectedModule])+inspectProject opts p = do+	p' <- loadProject p+	srcs <- projectSources p'+	modules <- mapM inspectFile' srcs+	return (p', catMaybes modules)+	where+		inspectFile' exts = liftM return (inspectFile (opts ++ extensionsOpts (extensions exts)) (entity exts)) <|> return Nothing++-- | Read file in UTF8+readFileUtf8 :: FilePath -> IO String+readFileUtf8 f = withFile f ReadMode $ \h -> do+	hSetEncoding h utf8+	cts <- hGetContents h+	length cts `seq` return cts

@@ -3,7 +3,7 @@ module HsDev.Project (
 	Project(..),
 	ProjectDescription(..), Target(..), Library(..), Executable(..), Test(..), Info(..),
-	readProject, loadProject,
+	readProject, loadProject, getProjectSandbox,
 	project,
 	Extensions(..), withExtensions,
 	infos, inTarget, fileTarget, findSourceDir, sourceDirs,
@@ -34,6 +34,7 @@ import Language.Haskell.Extension
 import System.FilePath
 
+import HsDev.Cabal (Cabal, getSandbox)
 import HsDev.Util
 
 -- | Cabal project
@@ -263,6 +264,10 @@ loadProject p
 	| isJust (projectDescription p) = return p
 	| otherwise = readProject (projectCabal p)
+
+-- | Find project sandbox
+getProjectSandbox :: Project -> IO Cabal
+getProjectSandbox = getSandbox . projectPath
 
 -- | Make project by .cabal file
 project :: FilePath -> Project

@@ -1,6 +1,6 @@ module HsDev.Scan (
 	-- * Enumerate functions
-	enumCabal, CompileFlag, ModuleToScan, ProjectToScan,
+	enumCabal, CompileFlag, ModuleToScan, ProjectToScan, SandboxToScan, ScanContents(..),
 	enumProject, enumDirectory,
 
 	-- * Scan
@@ -8,11 +8,15 @@ 	scanModule, upToDate, rescanModule, changedModule, changedModules
 	) where
 
+import Control.Applicative
 import Control.Monad.Error
 import qualified Data.Map as M
+import Data.Maybe (catMaybes)
 import Data.Traversable (traverse)
 import Language.Haskell.GhcMod (defaultOptions)
+import System.Directory
 
+import HsDev.Scan.Browse (browsePackages)
 import HsDev.Symbols
 import HsDev.Database
 import HsDev.Tools.GhcMod
@@ -31,26 +35,49 @@ type ModuleToScan = (ModuleLocation, [CompileFlag])
 -- | Project ready to scan
 type ProjectToScan = (Project, [ModuleToScan])
+-- | Cabal sandbox to scan
+type SandboxToScan = Cabal
 
+-- | Scan info
+data ScanContents = ScanContents {
+	modulesToScan :: [ModuleToScan],
+	projectsToScan :: [ProjectToScan],
+	sandboxesToScan :: [SandboxToScan] }
+
 -- | Enum project sources
 enumProject :: Project -> ErrorT String IO ProjectToScan
 enumProject p = do
 	p' <- loadProject p
+	cabal <- liftIO $ searchSandbox (projectPath p')
+	pkgs <- liftM (map packageName) $ browsePackages [] cabal
+	let
+		projOpts :: FilePath -> [String]
+		projOpts f = maybe [] makeOpts $ fileTarget p' f where
+			makeOpts :: Info -> [String]
+			makeOpts i = concat [
+				["-hide-all-packages"],
+				["-package " ++ projectName p'],
+				["-package " ++ dep | dep <- infoDepends i, dep `elem` pkgs]]
 	srcs <- projectSources p'
-	return (p', [(FileModule (entity src) (Just p'), extensionsOpts (extensions src)) | src <- srcs])
+	return (p', [(FileModule (entity src) (Just p'), extensionsOpts (extensions src) ++ projOpts (entity src)) | src <- srcs])
 
 -- | Enum directory modules
-enumDirectory :: FilePath -> ErrorT String IO ([ProjectToScan], [ModuleToScan])
+enumDirectory :: FilePath -> ErrorT String IO ScanContents
 enumDirectory dir = do
-	files <- liftException $ traverseDirectory dir
+	cts <- liftException $ traverseDirectory dir
 	let
-		projects = filter cabalFile files
-		sources = filter haskellSource files
+		projects = filter cabalFile cts
+		sources = filter haskellSource cts
+	dirs <- liftIO $ filterM doesDirectoryExist cts
+	sboxes <- liftIO $ liftM catMaybes $ mapM findPackageDb dirs
 	projs <- mapM (enumProject . project) projects
 	let
 		projPaths = map (projectPath . fst) projs
 		standalone = map (\f -> FileModule f Nothing) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
-	return (projs,  [(s, []) | s <- standalone])
+	return $ ScanContents {
+		modulesToScan = [(s, []) | s <- standalone],
+		projectsToScan = projs,
+		sandboxesToScan = map Sandbox sboxes }
 
 -- | Scan project file
 scanProjectFile :: [String] -> FilePath -> ErrorT String IO Project
@@ -61,8 +88,9 @@ -- | Scan module
 scanModule :: [String] -> ModuleLocation -> ErrorT String IO InspectedModule
 scanModule opts (FileModule f _) = inspectFile opts f >>= traverse infer' where
-	infer' m = mapErrorT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $
-		runGhcMod defaultOptions $ inferTypes opts Cabal m
+	infer' m = tryInfer <|> return m where
+		tryInfer = mapErrorT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $
+			runGhcMod defaultOptions $ inferTypes opts Cabal m
 scanModule opts (CabalModule c p n) = browse opts c n p
 scanModule _ (ModuleSource _) = throwError "Can inspect only modules in file or cabal"
 

@@ -1,4 +1,6 @@ module HsDev.Scan.Browse (
+	-- * List all packages
+	browsePackages,
 	-- * Scan cabal modules
 	browseFilter, browse
 	) where
@@ -29,6 +31,11 @@ import qualified Var as GHC
 import Pretty
 
+-- | Browse packages
+browsePackages :: [String] -> Cabal -> ErrorT String IO [ModulePackage]
+browsePackages opts cabal = withPackages (cabalOpt cabal ++ opts) $ \dflags -> do
+	return $ mapMaybe (readPackage . GHC.packageConfigId) $ fromMaybe [] $ GHC.pkgDatabase dflags
+
 -- | Browse modules
 browseFilter :: [String] -> Cabal -> (ModuleLocation -> ErrorT String IO Bool) -> ErrorT String IO [InspectedModule]
 browseFilter opts cabal f = withPackages_ (cabalOpt cabal ++ opts) $ do
@@ -37,7 +44,7 @@ 	liftM catMaybes $ mapM browseModule' ms'
 	where
 		loc :: GHC.Module -> ModuleLocation
-		loc m = CabalModule cabal (readMaybe $ GHC.packageIdString $ GHC.modulePackageId m) (GHC.moduleNameString $ GHC.moduleName m)
+		loc m = CabalModule cabal (readPackage $ GHC.modulePackageId m) (GHC.moduleNameString $ GHC.moduleName m)
 
 		browseModule' :: GHC.Module -> ErrorT String GHC.Ghc (Maybe InspectedModule)
 		browseModule' m = tryT $ inspect (loc m) (return $ InspectionAt 0 opts) (browseModule cabal m)
@@ -132,3 +139,6 @@ 
 tryT :: (Monad m, Error e) => ErrorT e m a -> ErrorT e m (Maybe a)
 tryT act = catchError (liftM Just act) (const $ return Nothing)
+
+readPackage :: GHC.PackageId -> Maybe ModulePackage
+readPackage = readMaybe . GHC.packageIdString

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, CPP, PatternGuards #-}
+{-# LANGUAGE OverloadedStrings, CPP, PatternGuards, LambdaCase #-}
 
 module HsDev.Server.Commands (
 	commands,
@@ -25,6 +25,7 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Either (isLeft)
+import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid
@@ -396,9 +397,7 @@ processClient name receive send' copts = do
 	commandLog copts $ name ++ " connected"
 	respChan <- newChan
-	void $ forkIO $ do
-		responses <- getChanContents respChan
-		mapM_ (send' . uncurry encodeLispOrJSON) responses
+	void $ forkIO $ getChanContents respChan >>= mapM_ (send' . uncurry encodeLispOrJSON)
 	linkVar <- newMVar $ return ()
 	let
 		answer :: Bool -> Message Response -> IO ()

@@ -15,7 +15,7 @@ 	Declaration(..), decl, definedIn, declarationLocals, scopes,
 	TypeInfo(..),
 	DeclarationInfo(..),
-	ModuleDeclaration(..),
+	ModuleDeclaration(..), ExportedDeclaration(..), mergeExported,
 	Inspection(..), inspectionOpts,
 	Inspected(..), InspectedModule,
 
@@ -27,7 +27,7 @@ 
 	-- * Utility
 	Canonicalize(..),
-	locateProject,
+	locateProject, searchProject,
 	locateSourceDir,
 	sourceModuleRoot,
 	importedModulePath,
@@ -49,6 +49,7 @@ import Control.Monad.Trans.Maybe
 import Control.Monad.Error
 import Data.Aeson
+import Data.Function (on)
 import Data.List
 import Data.Maybe (fromMaybe)
 import Data.Monoid (Monoid(mempty))
@@ -64,7 +65,7 @@ import HsDev.Symbols.Class
 import HsDev.Symbols.Documented (Documented(..))
 import HsDev.Project
-import HsDev.Util (tab, tabs, (.::))
+import HsDev.Util (tab, tabs, (.::), searchPath)
 
 -- | Module export
 data Export = ExportName (Maybe Text) Text | ExportModule Text
@@ -475,7 +476,7 @@ declarationTypeName (Class _) = Just "class"
 declarationTypeName _ = Nothing
 
--- | Symbol in module
+-- | Symbol in context of some module
 data ModuleDeclaration = ModuleDeclaration {
 	declarationModuleId :: ModuleId,
 	moduleDeclaration :: Declaration }
@@ -499,6 +500,45 @@ 		v .:: "module-id" <*>
 		v .:: "declaration"
 
+-- | Symbol exported with
+data ExportedDeclaration = ExportedDeclaration {
+	exportedBy :: [ModuleId],
+	exportedDeclaration :: Declaration }
+		deriving (Eq, Ord)
+
+instance NFData ExportedDeclaration where
+	rnf (ExportedDeclaration m s) = rnf m `seq` rnf s
+
+instance Show ExportedDeclaration where
+	show (ExportedDeclaration m s) = unlines $ filter (not . null) [
+		show s,
+		"\tmodules: " ++ intercalate ", " (map (show . moduleIdLocation) m)]
+
+instance ToJSON ExportedDeclaration where
+	toJSON d = object [
+		"exported-by" .= exportedBy d,
+		"declaration" .= exportedDeclaration d]
+
+instance FromJSON ExportedDeclaration where
+	parseJSON = withObject "exported declaration" $ \v -> ExportedDeclaration <$>
+		v .:: "exported-by" <*>
+		v .:: "declaration"
+
+-- | Merge @ModuleDeclaration@ into @ExportedDeclaration@
+mergeExported :: [ModuleDeclaration] -> [ExportedDeclaration]
+mergeExported =
+	map merge' .
+	groupBy ((==) `on` declId) .
+	sortBy (comparing declId)
+	where
+		declId :: ModuleDeclaration -> (Text, Maybe ModuleId)
+		declId = moduleDeclaration >>> (declarationName &&& declarationDefined)
+		merge' :: [ModuleDeclaration] -> ExportedDeclaration
+		merge' [] = error "mergeExported: impossible"
+		merge' ds@(d:_) = ExportedDeclaration {
+			exportedBy = map declarationModuleId ds,
+			exportedDeclaration = moduleDeclaration d }
+
 -- | Returns qualified name of symbol
 qualifiedName :: ModuleId -> Declaration -> Text
 qualifiedName m d = T.concat [moduleIdName m, ".", declarationName d]
@@ -534,6 +574,10 @@ 			case find ((== ".cabal") . takeExtension) cts of
 				Nothing -> if isDrive dir then return Nothing else locateParent (takeDirectory dir)
 				Just cabalf -> return $ Just $ project (dir </> cabalf)
+
+-- | Search project up
+searchProject :: FilePath -> IO (Maybe Project)
+searchProject file = runMaybeT $ searchPath file (MaybeT . locateProject) <|> mzero
 
 -- | Locate source dir of file
 locateSourceDir :: FilePath -> IO (Maybe FilePath)

@@ -269,8 +269,8 @@ 		functionNotExported = True
 		runGhcModT'' :: FilePath -> GhcModT IO () -> IO ()
 		runGhcModT'' cur act
-			| functionNotExported = withCurrentDirectory cur
-				(void . runGhcModT GhcMod.defaultOptions $ act)
+			| functionNotExported = withCurrentDirectory cur $
+				void $ runGhcModT GhcMod.defaultOptions $ act `catchError` (void . return)
 			| otherwise = do
 				env' <- makeEnv cur
 				void $ GhcMod.runGhcModT' env' GhcMod.defaultState $ do

@@ -15,19 +15,20 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.String (fromString)
-import Data.Text (unpack)
 import System.Process (readProcess)
 
 import qualified HDocs.Module as HDocs
-import qualified HDocs.Haddock as HDocs ()
+import qualified HDocs.Haddock as HDocs (readSource)
 
 import HsDev.Symbols
 
 -- | Get docs for module
-hdocs :: String -> [String] -> IO (Map String String)
-hdocs mname opts = do
-	ds <- runErrorT $ HDocs.moduleDocs opts mname
-	return $ either (const M.empty) HDocs.formatDocs ds
+hdocs :: ModuleLocation -> [String] -> IO (Map String String)
+hdocs mloc opts = runErrorT (docs' mloc) >>= return . either (const M.empty) HDocs.formatDocs where
+	docs' :: ModuleLocation -> ErrorT String IO HDocs.ModuleDocMap
+	docs' (FileModule fpath _) = liftM snd $ HDocs.readSource opts fpath
+	docs' (CabalModule _ _ mname) = HDocs.moduleDocs opts mname
+	docs' _ = throwError $ "Can't get docs for: " ++ show mloc
 
 -- | Get all docs
 hdocsCabal :: Cabal -> [String] -> ErrorT String IO (Map String (Map String String))
@@ -42,7 +43,7 @@ -- | Load docs for module
 loadDocs :: [String] -> Module -> IO Module
 loadDocs opts m = do
-	d <- hdocs (unpack $ moduleName m) opts
+	d <- hdocs (moduleLocation m) opts
 	return $ setDocs d m
 
 hdocsProcess :: String -> [String] -> IO (Maybe (Map String String))

@@ -1,7 +1,7 @@ module HsDev.Util (
 	withCurrentDirectory,
 	directoryContents,
-	traverseDirectory,
+	traverseDirectory, searchPath,
 	isParent,
 	haskellSource,
 	cabalFile,
@@ -20,6 +20,7 @@ 	liftTask
 	) where
 
+import Control.Applicative
 import Control.Arrow (second, left)
 import Control.Exception
 import Control.Monad
@@ -66,11 +67,22 @@ 	liftM concat $ forM cts $ \c -> do
 		isDir <- doesDirectoryExist c
 		if isDir
-			then traverseDirectory c
+			then (c :) <$> traverseDirectory c
 			else return [c]
 	where
 		onError :: IOException -> IO [FilePath]
 		onError _ = return []
+
+-- | Search something up
+searchPath :: (MonadIO m, MonadPlus m) => FilePath -> (FilePath -> m a) -> m a
+searchPath path f = do
+	path' <- liftIO $ canonicalizePath path
+	isDir <- liftIO $ doesDirectoryExist path'
+	search' (if isDir then path' else takeDirectory path')
+	where
+		search' dir
+			| isDrive dir = f dir
+			| otherwise = f dir `mplus` search' (takeDirectory dir)
 
 -- | Is one path parent of another
 isParent :: FilePath -> FilePath -> Bool

@@ -8,6 +8,7 @@ import Control.Monad (liftM)
 import Control.Monad.IO.Class
 import Data.Aeson (toJSON)
+import System.Directory (canonicalizePath)
 import System.FilePath (takeExtension)
 
 import HsDev.Project (readProject)
@@ -25,7 +26,11 @@ 		ghcs = listArg "ghc"
 
 		inspect' (Args [] opts) = liftIO getContents >>= liftM toJSON . inspectContents "stdin" (ghcs opts)
-		inspect' (Args [fname@(takeExtension -> ".hs")] opts) = toJSON <$> scanModule (ghcs opts) (FileModule fname Nothing)
-		inspect' (Args [fcabal@(takeExtension -> ".cabal")] _) = toJSON <$> readProject fcabal
+		inspect' (Args [fname@(takeExtension -> ".hs")] opts) = do
+			fname' <- liftIO $ canonicalizePath fname
+			toJSON <$> scanModule (ghcs opts) (FileModule fname' Nothing)
+		inspect' (Args [fcabal@(takeExtension -> ".cabal")] _) = do
+			fcabal' <- liftIO $ canonicalizePath fcabal
+			toJSON <$> readProject fcabal'
 		inspect' (Args [mname] opts) = toJSON <$> scanModule (ghcs opts) (CabalModule Cabal Nothing mname)
 		inspect' _ = toolError "Specify module name or file name (.hs or .cabal)"