packages feed

hsdev 0.1.1.0 → 0.1.2.0

raw patch · 18 files changed

+219/−157 lines, 18 filesdep +haddock-apidep −haddockdep ~ghc-mod

Dependencies added: haddock-api

Dependencies removed: haddock

Dependency ranges changed: ghc-mod

Files

hsdev.cabal view
@@ -2,9 +2,10 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.1.0
+version:             0.1.2.0
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
--- description:
+description:
+  Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
 homepage:            https://github.com/mvoidex/hsdev
 license:             BSD3
 license-file:        LICENSE
@@ -50,6 +51,7 @@     HsDev.Tools.Base
     HsDev.Tools.Cabal
     HsDev.Tools.ClearImports
+    HsDev.Tools.Ghc.Worker
     HsDev.Tools.GhcMod
     HsDev.Tools.GhcMod.InferType
     HsDev.Tools.Hayoo
@@ -83,9 +85,9 @@     directory >= 1.2.0,
     filepath >= 1.3.0,
     ghc >= 7.8.1,
-    ghc-mod >= 4.1.0 && < 4.2.0,
+    ghc-mod >= 5.0.0.0 && < 5.1.0.0,
     ghc-paths >= 0.1.0,
-    haddock >= 2.14.0,
+    haddock-api >= 2.15.0,
     haskell-src-exts >= 1.14.0,
     hdocs >= 0.4.0,
     HTTP >= 4000.2.0,
src/HsDev/Client/Commands.hs view
@@ -9,34 +9,20 @@ import Control.Monad
 import Control.Monad.Error
 import Control.Monad.Trans.Maybe
-import Control.Exception
-import Control.Concurrent
 import Data.Aeson hiding (Result, Error)
 import Data.Aeson.Encode.Pretty
-import Data.Aeson.Types hiding (Result, Error)
-import Data.Char
 import Data.Either
 import Data.List
 import Data.Maybe
 import Data.Monoid
-import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Lazy.Char8 (ByteString)
-import qualified Data.ByteString.Lazy.Char8 as L
-import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Text (unpack)
 import Data.Traversable (traverse)
-import Network.Socket
 import System.Directory
-import System.Environment
-import System.Exit
-import System.IO
-import System.Process
-import System.Console.GetOpt
 import System.FilePath
 import Text.Read (readMaybe)
 
-import Control.Apply.Util
 import qualified HsDev.Database.Async as DB
 import HsDev.Commands
 import HsDev.Database
@@ -48,12 +34,12 @@ import HsDev.Server.Message as M
 import HsDev.Server.Types
 import qualified HsDev.Tools.Cabal as Cabal
+import HsDev.Tools.Ghc.Worker
 import qualified HsDev.Tools.GhcMod as GhcMod
 import qualified HsDev.Tools.Hayoo as Hayoo
 import qualified HsDev.Cache.Structured as SC
 import HsDev.Cache
 
-import qualified Control.Concurrent.FiniteChan as F
 import Control.Concurrent.Util
 import System.Console.Cmd
 
@@ -67,16 +53,16 @@ 	-- Database commands
 	cmd' "add" [] [dataArg] "add info to database" add',
 	cmd' "scan" [] (sandboxes ++ [
-		projectArg `desc` "project path or .cabal",
-		fileArg `desc` "source file",
-		pathArg `desc` "directory to scan for files and projects",
+		manyReq $ projectArg `desc` "project path or .cabal",
+		manyReq $ fileArg `desc` "source file",
+		manyReq $ pathArg `desc` "directory to scan for files and projects",
 		ghcOpts])
 		"scan sources"
 		scan',
 	cmd' "rescan" [] (sandboxes ++ [
-		projectArg `desc` "project path or .cabal",
-		fileArg `desc` "source file",
-		pathArg `desc` "path to rescan",
+		manyReq $ projectArg `desc` "project path or .cabal",
+		manyReq $ fileArg `desc` "source file",
+		manyReq $ pathArg `desc` "path to rescan",
 		ghcOpts])
 		"rescan sources"
 		rescan',
@@ -90,9 +76,9 @@ 		remove',
 	-- Context free commands
 	cmd' "modules" [] (sandboxes ++ [
-		projectArg `desc` "projects to list modules from",
+		manyReq $ projectArg `desc` "projects to list modules from",
 		noLastArg,
-		packageArg,
+		manyReq packageArg,
 		sourced, standaloned])
 		"list modules"
 		listModules',
@@ -128,13 +114,15 @@ 	cmd' "hayoo" ["query"] [] "find declarations online via Hayoo" hayoo',
 	cmd' "cabal list" ["packages..."] [] "list cabal packages" cabalList',
 	cmd' "ghc-mod type" ["line", "column"] (ctx ++ [ghcOpts]) "infer type with 'ghc-mod type'" ghcmodType',
-	cmd' "ghc-mod check" ["files"] [fileArg `desc` "source files", sandbox, ghcOpts] "check source files" ghcmodCheck',
-	cmd' "ghc-mod lint" ["file"] [fileArg `desc` "source file", hlintOpts] "lint source file" ghcmodLint',
+	cmd' "ghc-mod check" ["files..."] [sandbox, ghcOpts] "check source files" ghcmodCheck',
+	cmd' "ghc-mod lint" ["file"] [hlintOpts] "lint source file" ghcmodLint',
+	-- Ghc commands
+	cmd' "ghc eval" ["expr..."] [] "evaluate expression" ghcEval',
 	-- Dump/load commands
 	cmd' "dump" [] (sandboxes ++ [
 		cacheDir, cacheFile,
-		projectArg `desc` "project",
-		fileArg `desc` "file",
+		manyReq $ projectArg `desc` "project",
+		manyReq $ fileArg `desc` "file",
 		standaloned,
 		allFlag "dump all"])
 		"dump database info" dump',
@@ -174,9 +162,10 @@ 		projectArg = req "project" "project"
 		packageVersionArg = req "version" "id" `short` ['v'] `desc` "package version"
 		sandbox = req "sandbox" "path" `desc` "path to cabal sandbox"
+		sandboxList = manyReq sandbox
 		sandboxes = [
 			flag "cabal" `desc` "cabal",
-			sandbox]
+			sandboxList]
 		sourced = flag "src" `desc` "source files"
 		standaloned = flag "stand" `desc` "standalone files"
 
@@ -217,7 +206,7 @@ 				updateData (ResultProject p) = DB.update (dbVar copts) $ return $ fromProject p
 				updateData (ResultList l) = mapM_ updateData l
 				updateData (ResultMap m) = mapM_ updateData $ M.elems m
-				updateData (ResultString s) = commandError "Can't insert string" []
+				updateData (ResultString _) = commandError "Can't insert string" []
 				updateData ResultNone = return ()
 			updateData decodedData
 
@@ -395,7 +384,7 @@ 			dbval <- getDb copts
 			(srcFile, cabal) <- getCtx copts as
 			mapErrorStr $ lookupSymbol dbval cabal srcFile nm
-		lookup' _ as copts = commandError "Invalid arguments" []
+		lookup' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Get detailed info about symbol in source file
 		whois' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
@@ -403,7 +392,7 @@ 			dbval <- getDb copts
 			(srcFile, cabal) <- getCtx copts as
 			mapErrorStr $ whois dbval cabal srcFile nm
-		whois' _ as copts = commandError "Invalid arguments" []
+		whois' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Get modules accessible from module
 		scopeModules' :: [String] -> Opts String -> CommandActionT [ModuleId]
@@ -411,7 +400,7 @@ 			dbval <- getDb copts
 			(srcFile, cabal) <- getCtx copts as
 			liftM (map moduleId) $ mapErrorStr $ scopeModules dbval cabal srcFile
-		scopeModules' _ as copts = commandError "Invalid arguments" []
+		scopeModules' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Get declarations accessible from module
 		scope' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
@@ -419,7 +408,7 @@ 			dbval <- getDb copts
 			(srcFile, cabal) <- getCtx copts as
 			liftM (filterMatch as) $ mapErrorStr $ scope dbval cabal srcFile (flagSet "global" as)
-		scope' _ as copts = commandError "Invalid arguments" []
+		scope' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Completion
 		complete' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
@@ -428,15 +417,15 @@ 			dbval <- getDb copts
 			(srcFile, cabal) <- getCtx copts as
 			mapErrorStr $ completions dbval cabal srcFile input
-		complete' _ as copts = commandError "Invalid arguments" []
+		complete' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Hayoo
 		hayoo' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		hayoo' [] as copts = commandError "Query not specified" []
+		hayoo' [] _ copts = commandError "Query not specified" []
 		hayoo' [query] as copts = liftM
 				(map Hayoo.hayooAsDeclaration . Hayoo.hayooFunctions) $
 				mapErrorStr $ Hayoo.hayoo query
-		hayoo' _ as copts = commandError "Too much arguments" []
+		hayoo' _ _ _ = commandError "Too much arguments" []
 
 		-- | Cabal list
 		cabalList' :: [String] -> Opts String -> CommandActionT [Cabal.CabalPackage]
@@ -452,12 +441,12 @@ 			(srcFile, cabal) <- getCtx copts as
 			(srcFile', m, mproj) <- mapErrorStr $ fileCtx dbval srcFile
 			mapErrorStr $ GhcMod.typeOf (listArg "ghc" as) cabal srcFile' mproj (moduleName m) line' column'
-		ghcmodType' [] as copts = commandError "Specify line" []
-		ghcmodType' _ as copts = commandError "Too much arguments" []
+		ghcmodType' [] _ copts = commandError "Specify line" []
+		ghcmodType' _ _ _ = commandError "Too much arguments" []
 
 		-- | Ghc-mod check
 		ghcmodCheck' :: [String] -> Opts String -> CommandActionT [GhcMod.OutputMessage]
-		ghcmodCheck' [] as copts = commandError "Specify at least one file" []
+		ghcmodCheck' [] _ copts = commandError "Specify at least one file" []
 		ghcmodCheck' files as copts = do
 			files' <- mapM (findPath copts) files
 			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM (locateProject) files')
@@ -466,12 +455,21 @@ 
 		-- | Ghc-mod lint
 		ghcmodLint' :: [String] -> Opts String -> CommandActionT [GhcMod.OutputMessage]
-		ghcmodLint' [] as copts = commandError "Specify file to hlint" []
+		ghcmodLint' [] _ copts = commandError "Specify file to hlint" []
 		ghcmodLint' [file] as copts = do
 			file' <- findPath copts file
 			mapErrorStr $ GhcMod.lint (listArg "hlint" as) file'
-		ghcmodLint' fs as copts = commandError "Too much files specified" []
+		ghcmodLint' fs _ copts = commandError "Too much files specified" []
 
+		-- | Evaluate expression
+		ghcEval' :: [String] -> Opts String -> CommandActionT [Value]
+		ghcEval' exprs _ copts = mapErrorStr $ liftM (map toValue) $
+			waitWork (commandGhc copts) $ mapM (try . evaluate) exprs
+			where
+				toValue :: Either String String -> Value
+				toValue (Left e) = object ["fail" .= e]
+				toValue (Right s) = toJSON s
+
 		-- | Dump database info
 		dump' :: [String] -> Opts String -> CommandActionT ()
 		dump' [] as copts = do
@@ -496,7 +494,7 @@ 				do
 					f <- MaybeT $ traverse (findPath copts) $ arg "file" as
 					fork $ dump f dat]
-		dump' _ as copts = commandError "Invalid arguments" []
+		dump' _ _ _ = commandError "Invalid arguments" []
 
 		-- | Load database
 		load' :: [String] -> Opts String -> CommandActionT ()
@@ -529,10 +527,12 @@ -- | Check positional args count
 checkPosArgs :: Cmd a -> Cmd a
 checkPosArgs c = validateArgs pos' c where
-	pos' (Args args os) =
-		guard (length args <= length (cmdArgs c))
-		`mplus`
-		failMatch ("unexpected positional arguments: " ++ unwords (drop (length $ cmdArgs c) args))
+	pos' (Args args os) = case cmdArgs c of
+		[ellipsis]
+			| "..." `isSuffixOf` ellipsis -> return ()
+		_ -> mplus
+			(guard (length args <= length (cmdArgs c)))
+			(failMatch ("unexpected positional arguments: " ++ unwords (drop (length $ cmdArgs c) args)))
 
 -- | Find sandbox by path
 findSandbox :: (MonadIO m, Error e) => CommandOptions -> Maybe FilePath -> ErrorT e m Cabal
src/HsDev/Display.hs view
@@ -22,7 +22,7 @@ instance Display ModuleLocation where
 	display (FileModule f _) = f
 	display (CabalModule _ _ n) = n
-	display (OtherModuleSource s) = fromMaybe "" s
+	display (ModuleSource s) = fromMaybe "" s
 	displayType _ = "module"
 
 instance Display Project where
src/HsDev/Inspect.hs view
@@ -2,6 +2,7 @@ 
 module HsDev.Inspect (
 	analyzeModule,
+	inspectContents, contentsInspection,
 	inspectFile, fileInspection,
 	projectDirs, projectSources,
 	inspectProject
@@ -45,7 +46,7 @@ 		H.ParseOk (H.Module _ (H.ModuleName mname) _ _ _ imports declarations) -> Right $ Module {
 			moduleName = mname,
 			moduleDocs =  Nothing,
-			moduleLocation = OtherModuleSource Nothing,
+			moduleLocation = ModuleSource Nothing,
 			moduleExports = [],
 			moduleImports = map getImport imports,
 			moduleDeclarations = M.fromList $ map (declarationName &&& id) $ getDecls declarations }
@@ -194,6 +195,19 @@ -- | Adds documentation to all declarations in module
 addDocs :: Map String String -> Module -> Module
 addDocs docsMap m = m { moduleDeclarations = M.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 cts opts = return InspectionNone -- crc or smth
 
 -- | Inspect file
 inspectFile :: [String] -> FilePath -> ErrorT String IO InspectedModule
src/HsDev/Scan.hs view
@@ -65,7 +65,7 @@ scanModule :: [String] -> ModuleLocation -> ErrorT String IO InspectedModule
 scanModule opts (FileModule f p) = inspectFile opts f >>= traverse (inferTypes opts Cabal)
 scanModule opts (CabalModule c p n) = browse opts c n p
-scanModule opts (OtherModuleSource _) = throwError "Can inspect only modules in file or cabal"
+scanModule opts (ModuleSource _) = throwError "Can inspect only modules in file or cabal"
 
 -- | Is inspected module up to date?
 upToDate :: [String] -> InspectedModule -> ErrorT String IO Bool
src/HsDev/Scan/Browse.hs view
@@ -65,7 +65,7 @@ 		mloc = CabalModule cabal (readMaybe $ GHC.packageIdString $ GHC.modulePackageId m) (GHC.moduleNameString $ GHC.moduleName m)
 		toDecl minfo n = do
 			tyInfo <- lift $ GHC.modInfoLookupName minfo n
-			tyResult <- lift $ maybe (inOtherModuleSource n) (return . Just) tyInfo
+			tyResult <- lift $ maybe (inModuleSource n) (return . Just) tyInfo
 			dflag <- lift GHC.getSessionDynFlags
 			return $ Declaration
 				(GHC.getOccString n)
@@ -100,8 +100,8 @@ withPackages_ :: [String] -> ErrorT String GHC.Ghc a -> ErrorT String IO a
 withPackages_ ghcOpts act = withPackages ghcOpts (const act)
 
-inOtherModuleSource :: GHC.Name -> GHC.Ghc (Maybe GHC.TyThing)
-inOtherModuleSource nm = GHC.getModuleInfo (GHC.nameModule nm) >> GHC.lookupGlobalName nm
+inModuleSource :: GHC.Name -> GHC.Ghc (Maybe GHC.TyThing)
+inModuleSource nm = GHC.getModuleInfo (GHC.nameModule nm) >> GHC.lookupGlobalName nm
 
 formatType :: GHC.NamedThing a => GHC.DynFlags -> (a -> GHC.Type) -> a -> String
 formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
src/HsDev/Server/Commands.hs view
@@ -48,6 +48,7 @@ import qualified HsDev.Client.Commands as Client
 import HsDev.Database
 import qualified HsDev.Database.Async as DB
+import HsDev.Tools.Ghc.Worker
 import HsDev.Server.Message as M
 import HsDev.Server.Types
 import HsDev.Util
@@ -136,7 +137,7 @@ 				waitListen <- newEmptyMVar
 				clientChan <- F.newChan
 
-				forkIO $ do
+				void $ forkIO $ do
 					accepter <- myThreadId
 
 					let
@@ -160,7 +161,7 @@ 											when notDone $ do
 												void $ forkIO $ do
 													threadDelay 1000000
-													tryPutMVar done ()
+													void $ tryPutMVar done ()
 													killThread me
 												takeMVar done
 										waitForever = forever $ hGetLineBS h
@@ -288,7 +289,7 @@ 
 	parseResponse h str = case eitherDecode str of
 		Left e -> putStrLn $ "Can't decode response: " ++ e
-		Right (Message i r) -> do
+		Right (Message _ r) -> do
 			r' <- unMmap r
 			L.putStrLn $ case r' of
 				Left n -> encodeValue n
@@ -319,6 +320,7 @@ #if mingw32_HOST_OS
 	mmapPool <- Just <$> createPool "hsdev"
 #endif
+	worker <- startWorker
 	act $ CommandOptions
 		db
 		(writeCache sopts outputStr)
@@ -329,6 +331,7 @@ #if mingw32_HOST_OS
 		mmapPool
 #endif
+		worker
 		(const $ return ())
 		(return ())
 		(return ())
@@ -336,12 +339,12 @@ 
 -- | Process request, notifications can be sent during processing
 processRequest :: CommandOptions -> (Notification -> IO ()) -> Request -> IO Result
-processRequest copts onNotify req =
+processRequest copts onNotify req' =
 	runArgs
 		Client.commands
 		unknownCommand
 		requestError
-		(requestToArgs req)
+		(requestToArgs req')
 		(copts { commandNotify = onNotify })
 	where
 		unknownCommand :: CommandAction
@@ -353,12 +356,12 @@ 
 -- | Process client, listen for requests and process them
 processClient :: String -> IO ByteString -> (ByteString -> IO ()) -> CommandOptions -> IO ()
-processClient name receive send copts = do
+processClient name receive send' copts = do
 	commandLog copts $ name ++ " connected"
 	respChan <- newChan
-	forkIO $ do
+	void $ forkIO $ do
 		responses <- getChanContents respChan
-		mapM_ (send . encode) responses
+		mapM_ (send' . encode) responses
 	linkVar <- newMVar $ return ()
 	let
 		answer :: Message Response -> IO ()
@@ -366,12 +369,12 @@ 			commandLog copts $ name ++ " << " ++ fromMaybe "_" i ++ ":" ++ fromUtf8 (encode r)
 			writeChan respChan m
 	flip finally (disconnected linkVar) $ forever $ do
-		req <- receive
-		case fmap extractMeta <$> eitherDecode req of
-			Left err -> do
-				commandLog copts $ name ++ " >> #: " ++ fromUtf8 req
+		req' <- receive
+		case fmap extractMeta <$> eitherDecode req' of
+			Left _ -> do
+				commandLog copts $ name ++ " >> #: " ++ fromUtf8 req'
 				answer $ Message Nothing $ responseError "Invalid request" [
-					"request" .= fromUtf8 req]
+					"request" .= fromUtf8 req']
 			Right m -> do
 				resp' <- flip traverse m $ \(cdir, noFile, silent, tm, reqArgs) -> do
 					let
@@ -433,21 +436,21 @@ 	Just cdir -> onCache cdir
 
 writeCache :: Opts String -> (String -> IO ()) -> Database -> IO ()
-writeCache sopts logMsg d = withCache sopts () $ \cdir -> do
-	logMsg $ "writing cache to " ++ cdir
-	logIO "cache writing exception: " logMsg $ do
+writeCache sopts logMsg' d = withCache sopts () $ \cdir -> do
+	logMsg' $ "writing cache to " ++ cdir
+	logIO "cache writing exception: " logMsg' $ do
 		SC.dump cdir $ structurize d
-	logMsg $ "cache saved to " ++ cdir
+	logMsg' $ "cache saved to " ++ cdir
 
 readCache :: Opts String -> (String -> IO ()) -> (FilePath -> ErrorT String IO Structured) -> IO (Maybe Database)
-readCache sopts logMsg act = withCache sopts Nothing $ join . liftM (either cacheErr cacheOk) . runErrorT . act where
-	cacheErr e = logMsg ("Error reading cache: " ++ e) >> return Nothing
+readCache sopts logMsg' act = withCache sopts Nothing $ join . liftM (either cacheErr cacheOk) . runErrorT . act where
+	cacheErr e = logMsg' ("Error reading cache: " ++ e) >> return Nothing
 	cacheOk s = do
-		forM_ (M.keys (structuredCabals s)) $ \c -> logMsg ("cache read: cabal " ++ show c)
-		forM_ (M.keys (structuredProjects s)) $ \p -> logMsg ("cache read: project " ++ p)
+		forM_ (M.keys (structuredCabals s)) $ \c -> logMsg' ("cache read: cabal " ++ show c)
+		forM_ (M.keys (structuredProjects s)) $ \p -> logMsg' ("cache read: project " ++ p)
 		case allModules (structuredFiles s) of
 			[] -> return ()
-			ms -> logMsg $ "cache read: " ++ show (length ms) ++ " files"
+			ms -> logMsg' $ "cache read: " ++ show (length ms) ++ " files"
 		return $ Just $ merge s
 
 #if mingw32_HOST_OS
@@ -482,7 +485,7 @@ 	| Just (MmapFile f) <- parseMaybe parseJSON v = do
 		cts <- runErrorT (fmap L.fromStrict (readMapFile f))
 		case cts of
-			Left e -> return $ responseError "Unable to read map view of file" ["file" .= f]
+			Left _ -> return $ responseError "Unable to read map view of file" ["file" .= f]
 			Right r' -> case eitherDecode r' of
 				Left e' -> return $ responseError "Invalid response" ["response" .= fromUtf8 r', "parser error" .= e']
 				Right r'' -> return r''
src/HsDev/Server/Message.hs view
@@ -6,7 +6,7 @@ 	Request(..), requestToArgs,
 	withOpts, withoutOpts,
 	Notification(..), Result(..),
-	Response(..), notification, result, responseError,
+	Response, notification, result, responseError,
 	groupResponses, responsesById
 	) where
 
@@ -42,7 +42,7 @@ 		Message <$> (fmap join (v .::? "id")) <*> parseJSON (Object v)
 
 instance Foldable Message where
-	foldMap f (Message i m) = f m
+	foldMap f (Message _ m) = f m
 
 instance Traversable Message where
 	traverse f (Message i m) = Message i <$> f m
src/HsDev/Server/Types.hs view
@@ -19,6 +19,7 @@ import HsDev.Symbols
 import HsDev.Server.Message
 import HsDev.Tools.GhcMod (OutputMessage, TypedRegion)
+import HsDev.Tools.Ghc.Worker (Worker)
 
 #if mingw32_HOST_OS
 import System.Win32.FileMapping.NamePool (Pool)
@@ -34,6 +35,7 @@ #if mingw32_HOST_OS
 	commandMmapPool :: Maybe Pool,
 #endif
+	commandGhc :: Worker,
 	commandNotify :: Notification -> IO (),
 	commandLink :: IO (),
 	commandHold :: IO (),
src/HsDev/Symbols.hs view
@@ -112,7 +112,7 @@ 	symbolName = declarationName
 	symbolQualifiedName = declarationName
 	symbolDocs = declarationDocs
-	symbolLocation d = Location (OtherModuleSource Nothing) (declarationPosition d)
+	symbolLocation d = Location (ModuleSource Nothing) (declarationPosition d)
 
 instance Symbol ModuleDeclaration where
 	symbolName = declarationName . moduleDeclaration
@@ -391,7 +391,7 @@ instance Canonicalize ModuleLocation where
 	canonicalize (FileModule f p) = liftM2 FileModule (canonicalizePath f) (traverse canonicalize p)
 	canonicalize (CabalModule c p n) = fmap (\c' -> CabalModule c' p n) $ canonicalize c
-	canonicalize (OtherModuleSource m) = return $ OtherModuleSource m
+	canonicalize (ModuleSource m) = return $ ModuleSource m
 
 -- | Find project file is related to
 locateProject :: FilePath -> IO (Maybe Project)
@@ -516,7 +516,7 @@ 		showError e = unlines $ ("\terror: " ++ e) : case mi of
 			FileModule f p -> ["file: " ++ f, "project: " ++ maybe "" projectPath p]
 			CabalModule c p n -> ["cabal: " ++ show c, "package: " ++ maybe "" show p, "name: " ++ n]
-			OtherModuleSource src -> ["source: " ++ fromMaybe "" src]
+			ModuleSource src -> ["source: " ++ fromMaybe "" src]
 
 instance ToJSON InspectedModule where
 	toJSON im = object [
src/HsDev/Symbols/Location.hs view
@@ -60,7 +60,7 @@ data ModuleLocation =
 	FileModule { moduleFile :: FilePath, moduleProject :: Maybe Project } |
 	CabalModule { moduleCabal :: Cabal, modulePackage :: Maybe ModulePackage, cabalModuleName :: String } |
-	OtherModuleSource { moduleOtherSource :: Maybe String }
+	ModuleSource { moduleSourceName :: Maybe String }
 		deriving (Eq, Ord)
 
 moduleSource :: ModuleLocation -> Maybe FilePath
@@ -74,23 +74,23 @@ instance NFData ModuleLocation where
 	rnf (FileModule f p) = rnf f `seq` rnf p
 	rnf (CabalModule c p n) = rnf c `seq` rnf p `seq` rnf n
-	rnf (OtherModuleSource m) = rnf m
+	rnf (ModuleSource m) = rnf m
 
 instance Show ModuleLocation where
 	show (FileModule f p) = f ++ maybe "" (" in " ++) (fmap projectPath p)
 	show (CabalModule c p _) = show c ++ maybe "" (" in package " ++) (fmap show p)
-	show (OtherModuleSource m) = fromMaybe "" m
+	show (ModuleSource m) = fromMaybe "" m
 
 instance ToJSON ModuleLocation where
 	toJSON (FileModule f p) = object ["file" .= f, "project" .= fmap projectCabal p]
 	toJSON (CabalModule c p n) = object ["cabal" .= c, "package" .= fmap show p, "name" .= n]
-	toJSON (OtherModuleSource s) = object ["source" .= s]
+	toJSON (ModuleSource s) = object ["source" .= s]
 
 instance FromJSON ModuleLocation where
 	parseJSON = withObject "module location" $ \v ->
 		(FileModule <$> v .:: "file" <*> ((fmap project) <$> (v .:: "project"))) <|>
 		(CabalModule <$> v .:: "cabal" <*> (fmap (join . fmap readMaybe) (v .:: "package")) <*> v .:: "name") <|>
-		(OtherModuleSource <$> v .:: "source")
+		(ModuleSource <$> v .:: "source")
 
 data Position = Position {
 	positionLine :: Int,
src/HsDev/Symbols/Util.hs view
@@ -60,7 +60,7 @@ -- | Check if module in source
 inModuleSource :: Maybe String -> ModuleId -> Bool
 inModuleSource src m = case moduleIdLocation m of
-	OtherModuleSource src' -> src' == src
+	ModuleSource src' -> src' == src
 	_ -> False
 
 -- | Check if declaration is in module
+ src/HsDev/Tools/Ghc/Worker.hs view
@@ -0,0 +1,57 @@+module HsDev.Tools.Ghc.Worker (
+	Worker(..),
+	startWorker,
+	waitWork,
+	evaluate,
+	try,
+
+	Ghc
+	) where
+
+import Control.Arrow (left)
+import Control.Concurrent
+import Control.Exception (SomeException)
+import Control.Monad
+import Control.Monad.Error
+import Data.Dynamic
+import Exception (gtry)
+import GHC
+import GHC.Paths
+import Packages
+
+data Worker = Worker {
+	ghcSendWork :: Ghc () -> IO (),
+	ghcWorkerChan :: Chan (Ghc ()) }
+
+startWorker :: IO Worker
+startWorker = do
+	ch <- newChan
+	void $ forkIO $ runGhc (Just libdir) $ do
+		fs <- getSessionDynFlags
+		defaultCleanupHandler fs $ do
+			(fs', _, _) <- parseDynamicFlags fs (map noLoc [])
+			let fs'' = fs' {
+				ghcMode = CompManager,
+				ghcLink = LinkInMemory,
+				hscTarget = HscInterpreted }
+			_ <- setSessionDynFlags fs''
+			_ <- liftIO $ initPackages fs''
+			mapM parseImportDecl ["import " ++ m | m <- startMods] >>= setContext . map IIDecl
+			liftIO (getChanContents ch) >>= mapM_ try
+	return $ Worker (writeChan ch) ch
+	where
+		startMods :: [String]
+		startMods = ["Prelude", "Data.List", "Control.Monad"]
+
+waitWork :: Worker -> Ghc a -> ErrorT String IO a
+waitWork w act = ErrorT $ do
+	var <- newEmptyMVar
+	ghcSendWork w $ try act >>= liftIO . putMVar var
+	takeMVar var
+
+evaluate :: String -> Ghc String
+evaluate expr = liftM fromDynamic (dynCompileExpr $ "show (" ++ expr ++ ")") >>=
+	maybe (fail "evaluate fail") return
+
+try :: Ghc a -> Ghc (Either String a)
+try = liftM (left (show :: SomeException -> String)) . gtry
src/HsDev/Tools/GhcMod.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ConstraintKinds, FlexibleContexts #-}
 
 module HsDev.Tools.GhcMod (
 	list,
@@ -8,7 +8,9 @@ 	typeOf,
 	OutputMessage(..),
 	check,
-	lint
+	lint,
+
+	runGhcMod
 	) where
 
 import Control.Applicative
@@ -16,6 +18,7 @@ import Control.DeepSeq
 import Control.Exception
 import Control.Monad.Error
+import Control.Monad.CatchIO (MonadCatchIO)
 import Data.Aeson
 import Data.Char
 import Data.Maybe
@@ -34,35 +37,27 @@ import HsDev.Symbols
 import HsDev.Symbols.Location
 import HsDev.Tools.Base
-import HsDev.Util ((.::), liftException)
+import HsDev.Util ((.::), liftException, liftIOErrors)
 
 list :: [String] -> Cabal -> ErrorT String IO [ModuleLocation]
-list opts cabal = liftException $ do
-	cradle <- cradle cabal Nothing
-	ms <- (map splitPackage . lines) <$> GhcMod.listModules
-		(GhcMod.defaultOptions { GhcMod.ghcOpts = opts })
-		cradle
+list opts cabal = runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = opts }) $ do
+	ms <- (map splitPackage . lines) <$> GhcMod.modules
 	return [CabalModule cabal (readMaybe p) m | (m, p) <- ms]
 	where
 		splitPackage :: String -> (String, String)
 		splitPackage = second (drop 1) . break isSpace
 
 browse :: [String] -> Cabal -> String -> Maybe ModulePackage -> ErrorT String IO InspectedModule
-browse opts cabal mname mpackage = inspect mloc (return $ browseInspection opts) $ liftException $ do
-	cradle <- cradle cabal Nothing
-	ts <- lines <$> GhcMod.browseModule
-		(GhcMod.defaultOptions {
-			GhcMod.detailed = True,
-			GhcMod.ghcOpts = packageOpt mpackage ++ opts })
-		cradle
-		mpkgname
-	return $ Module {
-		moduleName = mname,
-		moduleDocs = Nothing,
-		moduleLocation = mloc,
-		moduleExports = [],
-		moduleImports = [],
-		moduleDeclarations = decls ts }
+browse opts cabal mname mpackage = inspect mloc (return $ browseInspection opts) $ runGhcMod
+	(GhcMod.defaultOptions { GhcMod.detailed = True, GhcMod.ghcUserOptions = packageOpt mpackage ++ opts }) $ do
+		ts <- lines <$> GhcMod.browse mpkgname
+		return $ Module {
+			moduleName = mname,
+			moduleDocs = Nothing,
+			moduleLocation = mloc,
+			moduleExports = [],
+			moduleImports = [],
+			moduleDeclarations = decls ts }
 	where
 		mpkgname = maybe mname (\p -> packageName p ++ ":" ++ mname) mpackage
 		mloc = CabalModule cabal mpackage mname
@@ -82,9 +77,8 @@ 
 info :: [String] -> Cabal -> FilePath -> Maybe Project -> String -> String -> ErrorT String IO Declaration
 info opts cabal file mproj mname sname = do
-	rs <- liftException $ do
-		cradle <- cradle cabal mproj
-		GhcMod.infoExpr (GhcMod.defaultOptions { GhcMod.ghcOpts = cabalOpt cabal ++ opts }) cradle file sname
+	rs <- runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $
+		GhcMod.info file sname
 	toDecl rs
 	where
 		toDecl s = maybe (throwError $ "Can't parse info: '" ++ s ++ "'") return $ parseData s `mplus` parseFunction s
@@ -123,15 +117,9 @@ 		v .:: "type"
 
 typeOf :: [String] -> Cabal -> FilePath -> Maybe Project -> String -> Int -> Int -> ErrorT String IO [TypedRegion]
-typeOf opts cabal file mproj mname line col = liftException $ do
-	fileCts <- readFile file
-	cradle <- cradle cabal mproj
-	ts <- lines <$> GhcMod.typeExpr
-		(GhcMod.defaultOptions { GhcMod.ghcOpts = cabalOpt cabal ++ opts })
-		cradle
-		file
-		line
-		col
+typeOf opts cabal file mproj mname line col = runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
+	fileCts <- liftIO $ readFile file
+	ts <- lines <$> GhcMod.types file line col
 	return $ mapMaybe (toRegionType fileCts) ts
 	where
 		toRegionType :: String -> String -> Maybe TypedRegion
@@ -175,29 +163,14 @@ 		errorMessage = groups `at` 5 }
 
 check :: [String] -> Cabal -> [FilePath] -> Maybe Project -> ErrorT String IO [OutputMessage]
-check opts cabal files mproj = liftException $ do
-	cradle <- cradle cabal mproj
-	msgs <- lines <$> GhcMod.checkSyntax
-		(GhcMod.defaultOptions { GhcMod.ghcOpts = cabalOpt cabal ++ opts })
-		cradle
-		files
+check opts cabal files mproj = runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
+	msgs <- lines <$> GhcMod.checkSyntax files
 	return $ mapMaybe parseOutputMessage msgs
 
 lint :: [String] -> FilePath -> ErrorT String IO [OutputMessage]
-lint opts file = liftException $ do
-	msgs <- lines <$> GhcMod.lintSyntax
-		(GhcMod.defaultOptions { GhcMod.hlintOpts = opts })
-		file
+lint opts file = runGhcMod (GhcMod.defaultOptions { GhcMod.hlintOpts = opts }) $ do
+	msgs <- lines <$> GhcMod.lint file
 	return $ mapMaybe parseOutputMessage msgs
 
-cradle :: Cabal -> Maybe Project -> IO GhcMod.Cradle
-cradle cabal Nothing = do
-	dir <- getCurrentDirectory
-	return $ GhcMod.Cradle dir dir Nothing []
-cradle cabal (Just proj) = do
-	dir <- getCurrentDirectory
-	return $ GhcMod.Cradle
-		dir
-		(projectPath proj)
-		(Just $ projectCabal proj)
-		[]
+runGhcMod :: (GhcMod.IOish m, MonadCatchIO m) => GhcMod.Options -> GhcMod.GhcModT m a -> ErrorT String m a
+runGhcMod opts act = liftIOErrors $ ErrorT $ liftM (left show . fst) $ GhcMod.runGhcModT opts act
src/HsDev/Tools/Hayoo.hs view
@@ -58,7 +58,7 @@ 	symbolName = hayooName
 	symbolQualifiedName f = hayooModule f ++ "." ++ hayooName f
 	symbolDocs = Just . hayooDescription
-	symbolLocation r = Location (OtherModuleSource $ Just $ hayooHackage r) Nothing where
+	symbolLocation r = Location (ModuleSource $ Just $ hayooHackage r) Nothing where
 
 instance Documented HayooFunction where
 	brief f
@@ -107,7 +107,7 @@ hayooAsDeclaration f = ModuleDeclaration {
 	declarationModuleId = ModuleId {
 		moduleIdName = hayooModule f,
-		moduleIdLocation = OtherModuleSource (Just $ hayooHackage f) },
+		moduleIdLocation = ModuleSource (Just $ hayooHackage f) },
 	moduleDeclaration = Declaration {
 		declarationName = hayooName f,
 		declarationDocs = Just (addOnline $ untagDescription $ hayooDescription f),
src/System/Console/Args.hs view
@@ -4,7 +4,7 @@ 	Args(..), Opts(..), Arg(..), Opt(..),
 	withOpts, defOpts, defArgs, selectOpts, splitOpts,
 	(%--), (%-?), hoist, has, arg, narg, iarg, listArg, flagSet,
-	flag, req, list,
+	flag, req, list, manyReq,
 	desc, alias, short,
 	parse, parse_, tryParse, toArgs, info,
 
@@ -20,7 +20,7 @@ import Control.Monad.Loops
 import Data.Aeson
 import Data.Char
-import qualified Data.HashMap.Strict as HM (HashMap, toList)
+import qualified Data.HashMap.Strict as HM
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as M
@@ -151,6 +151,11 @@ -- | List option
 list :: String -> String -> Opt
 list n v = Opt n [] [] Nothing (List v)
+
+-- | Convert req option to list
+manyReq :: Opt -> Opt
+manyReq o@(Opt { optArg = (Required n) }) = o { optArg = List n }
+manyReq _ = error "manyReq: invalid argument"
 
 -- | Set description
 --
src/System/Console/Cmd.hs view
@@ -7,16 +7,16 @@ 	module System.Console.Args
 	) where
 
-import Control.Arrow
-import Control.Monad (join, (>=>))
-import Data.List (stripPrefix, unfoldr, isPrefixOf)
+import Control.Arrow (Arrow((&&&)))
+import Control.Monad ()
+import Data.List (stripPrefix)
 import Control.Monad.Error
-import Data.Map (Map)
-import Data.Maybe (fromMaybe, mapMaybe, listToMaybe, maybeToList, isJust)
-import qualified Data.Map as M
+import Data.Map ()
+import Data.Maybe
+import qualified Data.Map as M (delete)
 
 import System.Console.Args
-import Text.Format
+import Text.Format ((~~), (%))
 
 type CmdAction a = ErrorT String Maybe a
tools/hsinspect.hs view
@@ -4,8 +4,10 @@ 	main
 	) where
 
+import Control.Monad.IO.Class
 import HsDev.Project (readProject)
 import HsDev.Scan (scanModule)
+import HsDev.Inspect (inspectContents)
 import HsDev.Symbols.Location (ModuleLocation(..), Cabal(..))
 
 import Tool
@@ -14,6 +16,7 @@ main = toolMain "hsinspect" [
 	jsonCmd "module" ["module name"] [ghcOpts] "inspect installed module" inspectModule',
 	jsonCmd "file" ["source file"] [ghcOpts] "inspect file" inspectFile',
+	jsonCmd "input" [] [ghcOpts] "inspect input" inspectInput',
 	jsonCmd_ "cabal" ["project file"] "inspect .cabal file" inspectCabal']
 	where
 		ghcOpts = list "ghc" "option" `short` ['g'] `desc` "options to pass to GHC"
@@ -24,6 +27,9 @@ 
 		inspectFile' (Args [fname] opts) = scanModule (ghcs opts) (FileModule fname Nothing)
 		inspectFile' _ = toolError "Specify source file name"
+
+		inspectInput' (Args [] opts) = liftIO getContents >>= inspectContents "stdin" (ghcs opts)
+		inspectInput' _ = toolError "Invalid arguments"
 
 		inspectCabal' [fcabal] = readProject fcabal
 		inspectCabal' _ = toolError "Specify project .cabal file"