hsdev (empty) → 0.1.0.0

raw patch · 44 files changed

+5579/−0 lines, 44 filesdep +Cabaldep +HTTPdep +MonadCatchIO-transformerssetup-changed

Dependencies added: Cabal, HTTP, MonadCatchIO-transformers, Win32, aeson, aeson-pretty, attoparsec, base, bytestring, containers, deepseq, directory, filepath, ghc, ghc-mod, ghc-paths, haddock, haskell-src-exts, hdocs, hsdev, monad-loops, mtl, network, process, regexpr, text, time, transformers, unix, unordered-containers, vector

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• hsdev.cabal +192/−0
• src/Data/Async.hs +44/−0
• src/Data/Group.hs +40/−0
• src/HsDev.hs +17/−0
• src/HsDev/Cabal.hs +65/−0
• src/HsDev/Cache.hs +49/−0
• src/HsDev/Cache/Structured.hs +76/−0
• src/HsDev/Commands.hs +175/−0
• src/HsDev/Database.hs +237/−0
• src/HsDev/Database/Async.hs +24/−0
• src/HsDev/Inspect.hs +252/−0
• src/HsDev/Project.hs +344/−0
• src/HsDev/Scan.hs +92/−0
• src/HsDev/Scan/Browse.hs +130/−0
• src/HsDev/Symbols.hs +531/−0
• src/HsDev/Symbols/Class.hs +17/−0
• src/HsDev/Symbols/Documented.hs +22/−0
• src/HsDev/Symbols/Location.hs +176/−0
• src/HsDev/Symbols/Util.hs +168/−0
• src/HsDev/Tools/Base.hs +74/−0
• src/HsDev/Tools/Cabal.hs +84/−0
• src/HsDev/Tools/ClearImports.hs +101/−0
• src/HsDev/Tools/GhcMod.hs +153/−0
• src/HsDev/Tools/GhcMod/InferType.hs +43/−0
• src/HsDev/Tools/HDocs.hs +50/−0
• src/HsDev/Tools/Hayoo.hs +138/−0
• src/HsDev/Util.hs +110/−0
• src/System/Win32/PowerShell.hs +193/−0
• tests/Test.hs +6/−0
• tools/Commands.hs +981/−0
• tools/Control/Concurrent/FiniteChan.hs +38/−0
• tools/System/Command.hs +209/−0
• tools/System/Win32/FileMapping/Memory.hs +58/−0
• tools/System/Win32/FileMapping/NamePool.hs +31/−0
• tools/Tool.hs +76/−0
• tools/Types.hs +210/−0
• tools/Update.hs +189/−0
• tools/hscabal.hs +11/−0
• tools/hsclearimports.hs +52/−0
• tools/hsdev.hs +45/−0
• tools/hshayoo.hs +15/−0
• tools/hsinspect.hs +29/−0

@@ -0,0 +1,30 @@+Copyright (c) 2013, Alexandr `Voidex` Ruchkin
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Alexandr `Voidex` Ruchkin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,192 @@+-- Initial hsdev.cabal generated by cabal init.  For further documentation,
+--  see http://haskell.org/cabal/users-guide/
+
+name:                hsdev
+version:             0.1.0.0
+synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
+-- description:
+homepage:            https://github.com/mvoidex/hsdev
+license:             BSD3
+license-file:        LICENSE
+author:              Alexandr `Voidex` Ruchkin
+maintainer:          voidex@live.com
+-- copyright:
+category:            Development
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  hs-source-dirs: src
+  ghc-options: -threaded
+  exposed-modules:
+    HsDev
+    HsDev.Cabal
+    HsDev.Cache
+    HsDev.Cache.Structured
+    HsDev.Commands
+    HsDev.Database
+    HsDev.Database.Async
+    HsDev.Inspect
+    HsDev.Project
+    HsDev.Scan
+    HsDev.Scan.Browse
+    HsDev.Symbols
+    HsDev.Symbols.Class
+    HsDev.Symbols.Location
+    HsDev.Symbols.Documented
+    HsDev.Symbols.Util
+    HsDev.Tools.Base
+    HsDev.Tools.Cabal
+    HsDev.Tools.ClearImports
+    HsDev.Tools.GhcMod
+    HsDev.Tools.GhcMod.InferType
+    HsDev.Tools.Hayoo
+    HsDev.Tools.HDocs
+    HsDev.Util
+
+  if os(windows)
+    exposed-modules:
+      System.Win32.PowerShell
+
+  other-modules:
+    Data.Group
+    Data.Async
+
+  build-depends:
+    base >= 4.7 && < 5,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    Cabal >= 1.18.0,
+    containers >= 0.5.0,
+    deepseq >= 1.3.0,
+    directory >= 1.2.0,
+    filepath >= 1.3.0,
+    ghc >= 7.8.1,
+    ghc-mod >= 4.0.0,
+    ghc-paths >= 0.1.0,
+    haddock >= 2.14.0,
+    haskell-src-exts >= 1.14.0,
+    hdocs >= 0.4.0,
+    HTTP >= 4000.2.0,
+    MonadCatchIO-transformers >= 0.3.0,
+    mtl >= 2.1.0,
+    transformers >= 0.3.0,
+    process >= 1.2.0,
+    regexpr >= 0.5.0,
+    time >= 1.4.0,
+    attoparsec >= 0.11.0,
+    unordered-containers >= 0.2.0,
+    text >= 1.1.0
+
+executable hsdev
+  main-is: hsdev.hs
+  hs-source-dirs: tools
+  ghc-options: -threaded
+  other-modules:
+    Control.Concurrent.FiniteChan
+    Commands
+    System.Command
+    Types
+    Update
+
+  if os(windows)
+    other-modules:
+      System.Win32.FileMapping.Memory
+      System.Win32.FileMapping.NamePool
+  else
+    build-depends:
+      unix >= 2.7.0
+
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    containers >= 0.5.0,
+    deepseq >= 1.3.0,
+    directory >= 1.2.0,
+    filepath >= 1.3.0,
+    monad-loops >= 0.4.0,
+    MonadCatchIO-transformers >= 0.3.0,
+    mtl >= 2.1.0,
+    network >= 2.4.0,
+    process >= 1.2.0,
+    text >= 1.1.0,
+    transformers >= 0.3.0,
+    unordered-containers >= 0.2.0,
+    vector >= 0.10.0
+
+  if os(windows)
+    build-depends:
+      Win32 >= 2.3.0
+
+executable hsinspect
+  main-is: hsinspect.hs
+  hs-source-dirs: tools
+  other-modules:
+    System.Command
+    Tool
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    containers >= 0.5.0,
+    mtl >= 2.1.0,
+    transformers >= 0.3.0
+
+executable hsclearimports
+  main-is: hsclearimports.hs
+  hs-source-dirs: tools
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    directory >= 1.2.0,
+    ghc >= 7.8.1,
+    haskell-src-exts >= 1.14.0,
+    containers >= 0.5.0,
+    mtl >= 2.1.0
+
+executable hscabal
+  main-is: hscabal.hs
+  hs-source-dirs: tools
+  other-modules:
+    System.Command
+    Tool
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    containers >= 0.5.0,
+    mtl >= 2.1.0
+
+executable hshayoo
+  main-is: hshayoo.hs
+  hs-source-dirs: tools
+  other-modules:
+    System.Command
+    Tool
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    containers >= 0.5.0,
+    mtl >= 2.1.0
+
+test-suite test
+  main-is: Test.hs
+  hs-source-dirs: tests
+  type: exitcode-stdio-1.0
+  build-depends:
+    base >= 4.7 && < 5
+
+source-repository head
+  type: git
+  location: git://github.com/mvoidex/hsdev

@@ -0,0 +1,44 @@+module Data.Async (
+	Event(..),
+	event,
+	Async(..),
+	newAsync, readAsync, modifyAsync
+	) where
+
+import Control.DeepSeq (NFData, force)
+import Control.Monad (forM_)
+import Control.Concurrent
+
+import Data.Group (Group(..))
+
+-- | Event on async value
+data Event a = Append a | Remove a | Clear | Modify (a -> a) | Action (a -> IO a)
+
+-- | Event to function
+event :: Group a => Event a -> a -> IO a
+event (Append v) x = return $ add x v
+event (Remove v) x = return $ sub x v
+event Clear _ = return zero
+event (Modify p) x = return $ p x
+event (Action p) x = p x
+
+data Async a = Async {
+	asyncVar :: MVar a,
+	asyncEvents :: Chan (Event a) }
+
+newAsync :: (NFData a, Group a) => IO (Async a)
+newAsync = do
+	var <- newMVar zero
+	events <- newChan
+	forkIO $ do
+		evs <- getChanContents events
+		forM_ evs $ \e -> modifyMVar_ var $ \val -> do
+			x' <- event e val
+			force x' `seq` return x'
+	return $ Async var events
+
+readAsync :: Async a -> IO a
+readAsync = readMVar . asyncVar
+
+modifyAsync :: Async a -> Event a -> IO ()
+modifyAsync avar = writeChan (asyncEvents avar)

@@ -0,0 +1,40 @@+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Data.Group (
+	Group(..),
+	groupSum
+	) where
+
+import Data.List ((\\))
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Set (Set)
+import qualified Data.Set as S
+
+-- | Group is monoid with invertibility
+-- But for our purposes we prefer two functions: `add` and `sub`.
+class Eq a => Group a where
+	add :: a -> a -> a
+	sub :: a -> a -> a
+	zero :: a
+
+instance Eq a => Group [a] where
+	add = (++)
+	sub = (\\)
+	zero = []
+
+instance Ord a => Group (Set a) where
+	add = S.union
+	sub = S.difference
+	zero = S.empty
+
+instance (Ord k, Group a) => Group (Map k a) where
+	add = M.unionWith add
+	sub = M.differenceWith sub' where
+		sub' x y = if z == zero then Nothing else Just z where
+			z = sub x y
+	zero = M.empty
+
+-- | Sums list
+groupSum :: Group a => [a] -> a
+groupSum = foldr add zero

@@ -0,0 +1,17 @@+module HsDev (
+	module HsDev.Symbols,
+	module HsDev.Database,
+	module HsDev.Tools.GhcMod,
+	module HsDev.Scan,
+	module HsDev.Project,
+	module HsDev.Cache,
+	module HsDev.Commands
+	) where
+
+import HsDev.Symbols
+import HsDev.Database
+import HsDev.Tools.GhcMod
+import HsDev.Scan
+import HsDev.Project
+import HsDev.Cache
+import HsDev.Commands

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Cabal (
+	Cabal(..), sandbox,
+	findPackageDb, locateSandbox,
+	cabalOpt
+	) where
+
+import Control.Applicative
+import Control.DeepSeq (NFData(..))
+import Control.Monad.Error
+import Data.Aeson
+import Data.List
+import System.Directory
+import System.FilePath ((</>))
+
+-- | Cabal or sandbox
+data Cabal = Cabal | Sandbox FilePath deriving (Eq, Ord)
+
+-- | Get sandbox
+sandbox :: Cabal -> Maybe FilePath
+sandbox Cabal = Nothing
+sandbox (Sandbox f) = Just f
+
+instance NFData Cabal where
+	rnf Cabal = ()
+	rnf (Sandbox p) = rnf p
+
+instance Show Cabal where
+	show Cabal = "<cabal>"
+	show (Sandbox p) = p
+
+instance ToJSON Cabal where
+	toJSON Cabal = toJSON ("cabal" :: String)
+	toJSON (Sandbox p) = toJSON $ object [
+		"sandbox" .= p]
+
+instance FromJSON Cabal where
+	parseJSON v = cabalP v <|> sandboxP v where
+		cabalP = withText "cabal" cabalText where
+			cabalText "cabal" = return Cabal
+			cabalText _ = fail "Unknown cabal string"
+		sandboxP = withObject "sandbox" sandboxPath where
+			sandboxPath obj = fmap Sandbox $ obj .: "sandbox"
+
+-- | Find -package-db path for sandbox
+findPackageDb :: FilePath -> IO (Maybe FilePath)
+findPackageDb sand = do
+	cts <- getDirectoryContents sand
+	return $ fmap (sand </>) $
+		find cabalDev cts <|> find cabalSandbox cts
+	where
+		cabalDev p = "packages-" `isPrefixOf` p && ".conf" `isSuffixOf` p
+		cabalSandbox p = "-packages.conf.d" `isSuffixOf` p
+
+-- | Create sandbox by parent directory
+locateSandbox :: FilePath -> ErrorT String IO Cabal
+locateSandbox p = liftIO (findPackageDb p) >>= maybe
+	(throwError $ "Can't locate package-db in sandbox: " ++ p)
+	(return . Sandbox)
+
+-- | Cabal ghc option
+cabalOpt :: Cabal -> [String]
+cabalOpt Cabal = []
+cabalOpt (Sandbox p) = ["-package-db " ++ p]

@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Cache (
+	escapePath,
+	cabalCache,
+	projectCache,
+	standaloneCache,
+	dump,
+	load,
+	) where
+
+import Control.DeepSeq (force)
+import Data.Aeson (eitherDecode)
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.ByteString.Lazy.Char8 as BS
+import Data.Char (isAlphaNum)
+import Data.List (intercalate)
+import System.FilePath
+
+import HsDev.Symbols (Cabal(..))
+import HsDev.Project
+import HsDev.Database (Database)
+
+-- | Escape path
+escapePath :: FilePath -> FilePath
+escapePath = intercalate "." . map (filter isAlphaNum) . splitDirectories
+
+-- | Name of cache for cabal
+cabalCache :: Cabal -> FilePath
+cabalCache Cabal = "cabal" <.> "json"
+cabalCache (Sandbox p) = escapePath p <.> "json"
+
+-- | Name of cache for projects
+projectCache :: Project -> FilePath
+projectCache p = (escapePath . projectPath $ p) <.> "json"
+
+-- | Name of cache for standalone files
+standaloneCache :: FilePath
+standaloneCache = "standalone" <.> "json"
+
+-- | Dump database to file
+dump :: FilePath -> Database -> IO ()
+dump file = BS.writeFile file . encodePretty
+
+-- | Load database from file, strict
+load :: FilePath -> IO (Either String Database)
+load file = do
+	cts <- BS.readFile file
+	return $ force $ eitherDecode cts

@@ -0,0 +1,76 @@+module HsDev.Cache.Structured (
+	dump, load,
+	loadCabal, loadProject, loadFiles
+	) where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad.Error
+import qualified Data.Map as M (assocs)
+import Data.Monoid
+import System.Directory
+import System.FilePath
+
+import Data.Group (Group(zero))
+import qualified HsDev.Cache as Cache
+import HsDev.Cabal (Cabal)
+import HsDev.Database
+import HsDev.Symbols
+import HsDev.Project (project)
+import HsDev.Util
+
+-- | Write cache
+dump :: FilePath -> Structured -> IO ()
+dump dir db = do
+	createDirectoryIfMissing True (dir </> "cabal")
+	createDirectoryIfMissing True (dir </> "projects")
+	forM_ (M.assocs $ structuredCabals db) $ \(c, cdb) -> Cache.dump
+		(dir </> "cabal" </> Cache.cabalCache c)
+		cdb
+	forM_ (M.assocs $ structuredProjects db) $ \(p, pdb) -> Cache.dump
+		(dir </> "projects" </> Cache.projectCache (project p))
+		pdb
+	files' <- either (const zero) id <$>
+		handle wrapIO
+		(Cache.load (dir </> Cache.standaloneCache))
+	Cache.dump (dir </> Cache.standaloneCache) $
+		files' `mappend` structuredFiles db
+	where
+		wrapIO :: SomeException -> IO (Either String Database)
+		wrapIO = return . Left . show
+
+-- | Load all cache
+load :: FilePath -> IO (Either String Structured)
+load dir = runErrorT $ join $ either throwError return <$> (structured <$> loadCabals <*> loadProjects <*> loadFiles) where
+	loadCabals = loadDir (dir </> "cabal")
+	loadProjects = loadDir (dir </> "projects")
+	loadFiles = ErrorT $ Cache.load (dir </> Cache.standaloneCache)
+
+	loadDir p = do
+		fs <- liftIO $ liftM (filter ((== ".json") . takeExtension)) $ directoryContents p
+		mapM (ErrorT . Cache.load) fs
+
+-- | Load data from cache
+loadData :: FilePath -> ErrorT String IO Database
+loadData = liftExceptionM . ErrorT . Cache.load
+
+-- | Load cabal from cache
+loadCabal :: Cabal -> FilePath -> ErrorT String IO Structured
+loadCabal c dir = do
+	dat <- loadData (dir </> "cabal" </> Cache.cabalCache c)
+	ErrorT $ return $ structured [dat] [] mempty
+
+-- | Load project from cache
+loadProject :: FilePath -> FilePath -> ErrorT String IO Structured
+loadProject p dir = do
+	dat <- loadData (dir </> "projects" </> Cache.projectCache (project p))
+	ErrorT $ return $ structured [] [dat] mempty
+
+-- | Load standalone files
+loadFiles :: [FilePath] -> FilePath -> ErrorT String IO Structured
+loadFiles fs dir = do
+	dat <- loadData (dir </> Cache.standaloneCache)
+	ErrorT $ return $ structured [] [] $ filterDB inFiles (const False) dat
+	where
+		inFiles = maybe False (`elem` fs') . moduleSource . moduleLocation
+		fs' = map normalise fs

@@ -0,0 +1,175 @@+{-# LANGUAGE RankNTypes, FlexibleContexts #-}
+
+module HsDev.Commands (
+	-- * Commands
+	findDeclaration, findModule,
+	fileModule,
+	lookupSymbol,
+	whois,
+	scopeModules, scope,
+	completions,
+	moduleCompletions,
+
+	-- * Filters
+	checkModule, checkDeclaration, restrictCabal, visibleFrom,
+	splitIdentifier,
+
+	-- * Helpers
+	fileCtx, fileCtxMaybe
+	) where
+
+import Control.Applicative
+import Control.Arrow (Arrow(second))
+import Control.Monad.Error
+import Data.List
+import Data.Maybe
+import qualified Data.Map as M (lookup)
+import Data.Traversable (traverse)
+import System.Directory (canonicalizePath)
+
+import HsDev.Database
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Symbols.Util
+
+-- | Find declaration by name
+findDeclaration :: Database -> String -> ErrorT String IO [ModuleDeclaration]
+findDeclaration db ident = return $ selectDeclarations ((== ident) . declarationName . moduleDeclaration) db
+
+-- | Find module by name
+findModule :: Database -> String -> ErrorT String IO [Module]
+findModule db mname = return $ selectModules ((== mname) . moduleName) db
+
+-- | Find module in file
+fileModule :: Database -> FilePath -> ErrorT String IO Module
+fileModule db src = do
+	src' <- liftIO $ canonicalizePath src
+	maybe (throwError $ "File '" ++ src' ++ "' not found") return $ lookupFile src' db
+
+-- | Find project of module
+getProject :: Database -> Project -> ErrorT String IO Project
+getProject db p = do
+	p' <- liftIO $ canonicalizePath $ projectCabal p
+	maybe (throwError $ "Project " ++ p' ++ " not found") return $
+		M.lookup p' $ databaseProjects db
+
+-- | Lookup visible symbol
+lookupSymbol :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
+lookupSymbol db cabal file ident = do
+	(_, mthis, mproj) <- fileCtx db file
+	liftM
+		(filter $ checkModule $ allOf [
+			restrictCabal cabal,
+			visibleFrom mproj mthis,
+			maybe (const True) inModule qname])
+		(findDeclaration db iname)
+	where
+		(qname, iname) = splitIdentifier ident
+
+-- | Whois symbol in scope
+whois :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
+whois db cabal file ident = do
+	(_, mthis, _) <- fileCtx db file
+	liftM
+		(filter $ checkModule $ allOf [
+			restrictCabal cabal,
+			inScope mthis qname])
+		(findDeclaration db iname)
+	where
+		(qname, iname) = splitIdentifier ident
+
+-- | Accessible modules
+scopeModules :: Database -> Cabal -> FilePath -> ErrorT String IO [Module]
+scopeModules db cabal file = do
+	(file', mthis, mproj) <- fileCtxMaybe db file
+	case mproj of
+		Nothing -> return $ maybe id (:) mthis $ selectModules (inCabal cabal . moduleId) db
+		Just proj -> let deps' = deps file' proj in
+			return $ concatMap (\p -> selectModules (p . moduleId) db) [
+				inProject proj,
+				\m -> any (`inPackage` m) deps']
+	where
+		deps f p = maybe [] infoDepends $ fileTarget p f
+
+-- | Symbols in scope
+scope :: Database -> Cabal -> FilePath -> Bool -> ErrorT String IO [ModuleDeclaration]
+scope db cabal file False = do
+	(_, mthis, _) <- fileCtx db file
+	depModules <- liftM (filter ((`imported` (moduleImports' mthis)) . moduleId)) $
+		scopeModules db cabal file
+	return $ concatMap moduleModuleDeclarations $ mthis : depModules
+scope db cabal file True = concatMap moduleModuleDeclarations <$> scopeModules db cabal file
+
+-- | Completions
+completions :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
+completions db cabal file prefix = do
+	(_, mthis, _) <- fileCtx db file
+	decls <- scope db cabal file False
+	return [decl |
+		decl <- decls,
+		imp <- filter ((== moduleIdName (declarationModuleId decl)) . importModuleName) $
+			moduleImports' mthis,
+		qname `elem` catMaybes [
+			if not (importIsQualified imp) then Just Nothing else Nothing,
+			Just $ Just $ importModuleName imp,
+			fmap Just $ importAs imp],
+		iname `isPrefixOf` (declarationName . moduleDeclaration $ decl)]
+	where
+		(qname, iname) = splitIdentifier prefix
+
+-- | Module completions
+moduleCompletions :: Database -> [Module] -> String -> ErrorT String IO [String]
+moduleCompletions _ ms prefix = return $ nub $ completions' $ map moduleName ms where
+	completions' = mapMaybe getNext where
+		getNext m
+			| prefix `isPrefixOf` m = listToMaybe $ map snd $ dropWhile (uncurry (==)) $ zip (splitBy '.' prefix) (splitBy '.' m)
+			| otherwise = Nothing
+
+-- | Check module
+checkModule :: (ModuleId -> Bool) -> (ModuleDeclaration -> Bool)
+checkModule = (. declarationModuleId)
+
+-- | Check declaration
+checkDeclaration :: (Declaration -> Bool) -> (ModuleDeclaration -> Bool)
+checkDeclaration = (. moduleDeclaration)
+
+-- | Allow only selected cabal sandbox
+restrictCabal :: Cabal -> ModuleId -> Bool
+restrictCabal cabal m = inCabal cabal m || not (byCabal m)
+
+-- | Check whether module is visible from source file
+visibleFrom :: Maybe Project -> Module -> ModuleId -> Bool
+visibleFrom (Just p) this m = visible p (moduleId this) m
+visibleFrom Nothing this m = (moduleId this) == m || byCabal m
+
+splitBy :: Char -> String -> [String]
+splitBy ch = takeWhile (not . null) . unfoldr (Just . second (drop 1) . break (== ch))
+
+-- | Get module imports with Prelude and self import
+moduleImports' :: Module -> [Import]
+moduleImports' m = Import "Prelude" False Nothing Nothing : Import (moduleName m) False Nothing Nothing : moduleImports m
+
+-- | 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
+
+-- | Get context file and project
+fileCtx :: Database -> FilePath -> ErrorT String IO (FilePath, Module, Maybe Project)
+fileCtx db file = do
+	file' <- liftIO $ canonicalizePath file
+	mthis <- fileModule db file'
+	mproj <- traverse (getProject db) $ projectOf $ moduleId mthis
+	return (file', mthis, mproj)
+
+-- | Try get context file
+fileCtxMaybe :: Database -> FilePath -> ErrorT String IO (FilePath, Maybe Module, Maybe Project)
+fileCtxMaybe db file = ((\(f, m, p) -> (f, Just m, p)) <$> fileCtx db file) <|> onlyProj where
+	onlyProj = do
+		file' <- liftIO $ canonicalizePath file
+		mproj <- liftIO $ locateProject file'
+		mproj' <- traverse (getProject db) mproj
+		return (file', Nothing, mproj')

@@ -0,0 +1,237 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Database (
+	Database(..),
+	databaseIntersection, nullDatabase, databaseLocals, allModules, allDeclarations,
+	fromModule, fromProject,
+	filterDB,
+	projectDB, cabalDB, standaloneDB,
+	selectModules, selectDeclarations, lookupModule, lookupFile,
+	getInspected,
+
+	append, remove,
+
+	Structured(..),
+	structured, structurize, merge
+	) where
+
+import Control.Applicative
+import Control.Monad (msum, join)
+import Control.DeepSeq (NFData(..))
+import Data.Aeson
+import Data.Either (rights)
+import Data.Function (on)
+import Data.Group (Group(..))
+import Data.List (nub)
+import Data.Map (Map)
+import Data.Maybe
+import Data.Monoid (Monoid(..))
+import qualified Data.Map as M
+
+import HsDev.Symbols
+import HsDev.Symbols.Util
+import HsDev.Project
+import HsDev.Util ((.::))
+
+-- | HsDev database
+data Database = Database {
+	databaseModules :: Map ModuleLocation InspectedModule,
+	databaseProjects :: Map FilePath Project }
+		deriving (Eq, Ord)
+
+instance NFData Database where
+	rnf (Database ms ps) = rnf ms `seq` rnf ps
+
+instance Group Database where
+	add old new = Database {
+		databaseModules = databaseModules new `M.union` databaseModules old,
+		databaseProjects = M.unionWith mergeProject (databaseProjects new) (databaseProjects old) }
+		where
+			mergeProject pl pr = pl {
+				projectDescription = msum [projectDescription pl, projectDescription pr] }
+	sub old new = Database {
+		databaseModules = databaseModules old `M.difference` databaseModules new,
+		databaseProjects = databaseProjects old `M.difference` databaseProjects new }
+	zero = Database M.empty M.empty
+
+instance Monoid Database where
+	mempty = zero
+	mappend = add
+
+instance ToJSON Database where
+	toJSON (Database ms ps) = object [
+		"modules" .= M.elems ms,
+		"projects" .= M.elems ps]
+
+instance FromJSON Database where
+	parseJSON = withObject "database" $ \v -> Database <$>
+		((M.unions . map mkModule) <$> v .:: "modules") <*>
+		((M.unions . map mkProject) <$> v .:: "projects")
+		where
+			mkModule m = M.singleton (inspectedId m) m
+			mkProject p = M.singleton (projectCabal p) p
+
+-- | Database intersection, prefers first database data
+databaseIntersection :: Database -> Database -> Database
+databaseIntersection l r = mempty {
+	databaseModules = databaseModules l `M.intersection` databaseModules r,
+	databaseProjects = databaseProjects l `M.intersection` databaseProjects r }
+
+-- | Check if database is empty
+nullDatabase :: Database -> Bool
+nullDatabase db = M.null (databaseModules db) && M.null (databaseProjects db)
+
+-- | Bring all locals to scope
+databaseLocals :: Database -> Database
+databaseLocals db = db {
+	databaseModules = M.map (fmap moduleLocals) (databaseModules db) }
+
+-- | All modules
+allModules :: Database -> [Module]
+allModules = rights . map inspectionResult . M.elems . databaseModules
+
+-- | All declarations
+allDeclarations :: Database -> [ModuleDeclaration]
+allDeclarations db = do
+	m <- allModules db
+	moduleModuleDeclarations m
+
+-- | Make database from module
+fromModule :: InspectedModule -> Database
+fromModule m = zero {
+	databaseModules = M.singleton (inspectedId m) m }
+
+-- | Make database from project
+fromProject :: Project -> Database
+fromProject p = zero {
+	databaseProjects = M.singleton (projectCabal p) p }
+
+-- | Filter database by predicate
+filterDB :: (Module -> Bool) -> (Project -> Bool) -> Database -> Database
+filterDB m p db = mempty {
+	databaseModules = M.filter (either (const False) m . inspectionResult) (databaseModules db),
+	databaseProjects = M.filter p (databaseProjects db) }
+
+-- | Project database
+projectDB :: Project -> Database -> Database
+projectDB proj = filterDB (inProject proj . moduleId) (((==) `on` projectCabal) proj)
+
+-- | Cabal database
+cabalDB :: Cabal -> Database -> Database
+cabalDB cabal = filterDB (inCabal cabal . moduleId) (const False)
+
+-- | Standalone database
+standaloneDB :: Database -> Database
+standaloneDB db = filterDB (noProject . moduleId) (const False) db where
+	noProject m = all (not . flip inProject m) ps
+	ps = M.elems $ databaseProjects db
+
+-- | Select module by predicate
+selectModules :: (Module -> Bool) -> Database -> [Module]
+selectModules p = filter p . allModules
+
+-- | Select declaration by predicate
+selectDeclarations :: (ModuleDeclaration -> Bool) -> Database -> [ModuleDeclaration]
+selectDeclarations p = filter p . allDeclarations
+
+-- | Lookup module by its location and name
+lookupModule :: ModuleLocation -> Database -> Maybe Module
+lookupModule mloc db = do
+	m <- M.lookup mloc $ databaseModules db
+	either (const Nothing) Just $ inspectionResult m
+
+-- | Lookup module by its source file
+lookupFile :: FilePath -> Database -> Maybe Module
+lookupFile f = listToMaybe . selectModules (inFile f . moduleId)
+
+-- | Get inspected module
+getInspected :: Database -> Module -> InspectedModule
+getInspected db m = fromMaybe err $ M.lookup (moduleLocation m) $ databaseModules db where
+	err = error "Impossible happened: getInspected"
+
+-- | Append database
+append :: Database -> Database -> Database
+append = add
+
+-- | Remove database
+remove :: Database -> Database -> Database
+remove = sub
+
+-- | Structured database
+data Structured = Structured {
+	structuredCabals :: Map Cabal Database,
+	structuredProjects :: Map FilePath Database,
+	structuredFiles :: Database }
+		deriving (Eq, Ord)
+
+instance NFData Structured where
+	rnf (Structured cs ps fs) = rnf cs `seq` rnf ps `seq` rnf fs
+
+instance Group Structured where
+	add old new = Structured {
+		structuredCabals = structuredCabals new `M.union` structuredCabals old,
+		structuredProjects = structuredProjects new `M.union` structuredProjects old,
+		structuredFiles = structuredFiles old `add` structuredFiles new }
+	sub old new = Structured {
+		structuredCabals = structuredCabals old `M.difference` structuredCabals new,
+		structuredProjects = structuredProjects old `M.difference` structuredProjects new,
+		structuredFiles = structuredFiles old `sub` structuredFiles new }
+	zero = Structured zero zero zero
+
+instance Monoid Structured where
+	mempty = zero
+	mappend = add
+
+instance ToJSON Structured where
+	toJSON (Structured cs ps fs) = object [
+		"cabals" .= M.elems cs,
+		"projects" .= M.elems ps,
+		"files" .= fs]
+
+instance FromJSON Structured where
+	parseJSON = withObject "structured" $ \v -> join $
+		either fail return <$> (structured <$>
+			(v .:: "cabals") <*>
+			(v .:: "projects") <*>
+			(v .:: "files"))
+
+structured :: [Database] -> [Database] -> Database -> Either String Structured
+structured cs ps fs = Structured <$> mkMap keyCabal cs <*> mkMap keyProj ps <*> pure fs where
+	mkMap :: Ord a => (Database -> Either String a) -> [Database] -> Either String (Map a Database)
+	mkMap key dbs = do
+		keys <- mapM key dbs
+		return $ M.fromList $ zip keys dbs
+	keyCabal :: Database -> Either String Cabal
+	keyCabal db = unique
+		"No cabal"
+		"Different module cabals"
+		(nub <$> mapM getCabal (allModules db))
+		where
+			getCabal m = case moduleLocation m of
+				CabalModule c _ _ -> Right c
+				_ -> Left "Module have no cabal"
+	keyProj :: Database -> Either String FilePath
+	keyProj db = unique
+		"No project"
+		"Different module projects"
+		(return (M.keys (databaseProjects db)))
+	-- Check that list results in one element
+	unique :: (Eq a) => String -> String -> Either String [a] -> Either String a
+	unique _ _ (Left e) = Left e
+	unique no _ (Right []) = Left no
+	unique _ _ (Right [x]) = Right x
+	unique _ much (Right _) = Left much
+
+structurize :: Database -> Structured
+structurize db = Structured cs ps fs where
+	cs = M.fromList [(c, cabalDB c db) | c <- nub (mapMaybe modCabal (allModules db))]
+	ps = M.fromList [(pname, projectDB (project pname) db) | pname <- M.keys (databaseProjects db)]
+	fs = standaloneDB db
+
+merge :: Structured -> Database
+merge (Structured cs ps fs) = mconcat $ M.elems cs ++ M.elems ps ++ [fs]
+
+modCabal :: Module -> Maybe Cabal
+modCabal m = case moduleLocation m of
+	CabalModule c _ _ -> Just c
+	_ -> Nothing

@@ -0,0 +1,24 @@+module HsDev.Database.Async (
+	update, wait,
+	module Data.Async
+	) where
+
+import Control.Concurrent.MVar
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.DeepSeq (force)
+
+import Data.Async
+
+import HsDev.Database (Database)
+
+update :: MonadIO m => Async Database -> m Database -> m ()
+update db act = do
+	db' <- act
+	force db' `seq` liftIO (modifyAsync db (Append db'))
+
+-- | This function is used to ensure that all previous updates were applied
+wait :: MonadIO m => Async Database -> m ()
+wait db = liftIO $ do
+	waitVar <- newEmptyMVar
+	modifyAsync db (Action $ \d -> putMVar waitVar () >> return d)
+	takeMVar waitVar

@@ -0,0 +1,252 @@+{-# LANGUAGE TypeSynonymInstances #-}
+
+module HsDev.Inspect (
+	analyzeModule,
+	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.List (intercalate, find)
+import Data.Map (Map)
+import Data.Maybe (fromMaybe, mapMaybe, catMaybes)
+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 Language.Haskell.Exts.Extension as H
+import qualified Documentation.Haddock as Doc
+import qualified System.Directory as Dir
+import System.IO
+import System.FilePath
+
+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) _ _ _ imports declarations) -> Right $ Module {
+			moduleName = mname,
+			moduleDocs =  Nothing,
+			moduleLocation = OtherModuleSource Nothing,
+			moduleExports = [],
+			moduleImports = map getImport imports,
+			moduleDeclarations = M.fromList $ map (declarationName &&& id) $ getDecls declarations }
+	where
+		pmode :: H.ParseMode
+		pmode = H.defaultParseMode {
+			H.parseFilename = fromMaybe (H.parseFilename H.defaultParseMode) file,
+			H.baseLanguage = H.Haskell2010,
+			H.extensions = map H.parseExtension exts }
+
+getImport :: H.ImportDecl -> Import
+getImport d = Import (mname (H.importModule d)) (H.importQualified d) (fmap mname $ H.importAs d) (Just $ toPosition $ H.importLoc d) where
+	mname (H.ModuleName n) = n
+
+getDecls :: [H.Decl] -> [Declaration]
+getDecls decls = map addLocals infos ++ filter noInfo defs where
+	infos = concatMap getDecl decls
+	addLocals :: Declaration -> Declaration
+	addLocals decl = decl `where_` maybe [] locals def where
+		def = find (\d -> declarationName d == declarationName decl) defs
+	defs = concatMap getDef decls
+	noInfo :: Declaration -> Bool
+	noInfo d = declarationName d `notElem` names
+	names = map declarationName infos
+
+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 -> map
+		(\n -> setPosition loc (Declaration (identOfName n) Nothing Nothing (Function (Just $ H.prettyPrint typeSignature) [])))
+		names
+	H.TypeDecl loc n args _ -> [setPosition loc $ Declaration (identOfName n) Nothing Nothing (Type $ TypeInfo Nothing (map H.prettyPrint args) Nothing)]
+	H.DataDecl loc dataOrNew ctx n args _ _ -> [setPosition loc $ Declaration (identOfName n) Nothing Nothing (ctor dataOrNew $ TypeInfo (makeCtx ctx) (map H.prettyPrint args) Nothing)]
+	H.GDataDecl loc dataOrNew ctx n args _ _ _ -> [setPosition loc $ Declaration (identOfName n) Nothing Nothing (ctor dataOrNew $ TypeInfo (makeCtx ctx) (map H.prettyPrint args) Nothing)]
+	H.ClassDecl loc ctx n args _ _ -> [setPosition loc $ Declaration (identOfName n) Nothing Nothing (Class $ TypeInfo (makeCtx ctx) (map H.prettyPrint args) Nothing)]
+	_ -> []
+	where
+		ctor :: H.DataOrNew -> TypeInfo -> DeclarationInfo
+		ctor H.DataType = Data
+		ctor H.NewType = NewType
+
+		makeCtx [] = Nothing
+		makeCtx ctx = Just $ intercalate ", " $ map H.prettyPrint ctx
+
+getDef :: H.Decl -> [Declaration]
+getDef (H.FunBind []) = []
+getDef (H.FunBind matches@(H.Match loc n _ _ _ _ : _)) = [setPosition loc $ Declaration (identOfName n) Nothing Nothing fun] where
+	fun = Function Nothing $ concatMap (getBinds . matchBinds) matches
+	matchBinds (H.Match _ _ _ _ _ binds) = binds
+getDef (H.PatBind loc pat _ _ binds) = map (\name -> setPosition loc (Declaration (identOfName name) Nothing Nothing (Function Nothing $ getBinds binds))) (names pat) where
+	names :: H.Pat -> [H.Name]
+	names (H.PVar n) = [n]
+	names (H.PNeg n) = names 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) = [n]
+	fieldNames H.PFieldWildcard = []
+getDef _ = []
+
+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, _) = fmap 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 }
+
+-- | 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 file
+inspectFile :: [String] -> FilePath -> ErrorT String IO InspectedModule
+inspectFile opts file = do
+	let
+		noReturn :: E.SomeException -> IO [Doc.Interface]
+		noReturn _ = return []
+	proj <- liftIO $ locateProject file
+	absFilename <- liftIO $ Dir.canonicalizePath file
+	inspect (FileModule absFilename proj) (fileInspection absFilename opts) $ do
+		docsMap <- liftIO $ hdocsProcess absFilename opts
+		--docsMap <- liftIO $ 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) opts
+
+-- | Enumerate project dirs
+projectDirs :: Project -> ErrorT String IO [Extensions FilePath]
+projectDirs p = do
+	p' <- loadProject p
+	return $ map (fmap (projectPath p' </>)) $ maybe [] sourceDirs $ projectDescription p'
+
+-- | Enumerate project source files
+projectSources :: Project -> ErrorT String IO [Extensions FilePath]
+projectSources p = do
+	dirs <- projectDirs p
+	let
+		enumHs = liftM (filter haskellSource) . traverseDirectory
+	liftIO $ liftM 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

@@ -0,0 +1,344 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Project (
+	Project(..),
+	ProjectDescription(..), Target(..), Library(..), Executable(..), Test(..), Info(..),
+	readProject, loadProject,
+	project,
+	Extensions(..), withExtensions,
+	infos, inTarget, fileTarget, findSourceDir, sourceDirs,
+
+	-- * Helpers
+	showExtension, flagExtension, extensionFlag,
+	extensionsOpts
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.DeepSeq (NFData(..))
+import Control.Exception
+import Control.Monad.Error
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Foldable (Foldable(..))
+import Data.Traversable
+import qualified Distribution.Package as P
+import qualified Distribution.PackageDescription as PD
+import Distribution.PackageDescription.Parse
+import Distribution.ModuleName (components)
+import Distribution.Text
+import qualified Distribution.Text (Text)
+import Language.Haskell.Extension
+import System.FilePath
+
+import HsDev.Util
+
+-- | Cabal project
+data Project = Project {
+	projectName :: String,
+	projectPath :: FilePath,
+	projectCabal :: FilePath,
+	projectDescription :: Maybe ProjectDescription }
+		deriving (Read)
+
+instance NFData Project where
+	rnf (Project n p c _) = rnf n `seq` rnf p `seq` rnf c
+
+instance Eq Project where
+	l == r = projectCabal l == projectCabal r
+
+instance Ord Project where
+	compare l r = compare (projectName l, projectCabal l) (projectName r, projectCabal r)
+
+instance Show Project where
+	show p = unlines $ [
+		"project " ++ projectName p,
+		"\tcabal: " ++ projectCabal p,
+		"\tdescription:"] ++ concatMap (map (tab 2) . lines . show) (maybeToList $ projectDescription p)
+
+instance ToJSON Project where
+	toJSON p = object [
+		"name" .= projectName p,
+		"path" .= projectPath p,
+		"cabal" .= projectCabal p,
+		"description" .= projectDescription p]
+
+instance FromJSON Project where
+	parseJSON = withObject "project" $ \v -> Project <$>
+		v .:: "name" <*>
+		v .:: "path" <*>
+		v .:: "cabal" <*>
+		v .:: "description"
+
+data ProjectDescription = ProjectDescription {
+	projectLibrary :: Maybe Library,
+	projectExecutables :: [Executable],
+	projectTests :: [Test] }
+		deriving (Eq, Read)
+
+instance Show ProjectDescription where
+	show pd = unlines $
+		concatMap (lines . show) (maybeToList (projectLibrary pd)) ++
+		concatMap (lines . show) (projectExecutables pd) ++
+		concatMap (lines . show) (projectTests pd)
+
+instance ToJSON ProjectDescription where
+	toJSON d = object [
+		"library" .= projectLibrary d,
+		"executables" .= projectExecutables d,
+		"tests" .= projectTests d]
+
+instance FromJSON ProjectDescription where
+	parseJSON = withObject "project description" $ \v -> ProjectDescription <$>
+		v .:: "library" <*>
+		v .:: "executables" <*>
+		v .:: "tests"
+
+class Target a where
+	buildInfo :: a -> Info
+
+-- | Library in project
+data Library = Library {
+	libraryModules :: [[String]],
+	libraryBuildInfo :: Info }
+		deriving (Eq, Read)
+
+instance Target Library where
+	buildInfo = libraryBuildInfo
+
+instance Show Library where
+	show l = unlines $
+		["library", "\tmodules:"] ++
+		(map (tab 2 . intercalate ".") $ libraryModules l) ++
+		(map (tab 1) . lines . show $ libraryBuildInfo l)
+
+instance ToJSON Library where
+	toJSON l = object [
+		"modules" .= fmap (intercalate ".") (libraryModules l),
+		"info" .= libraryBuildInfo l]
+
+instance FromJSON Library where
+	parseJSON = withObject "library" $ \v -> Library <$> (fmap splitModule <$> v .:: "modules") <*> v .:: "info" where
+		splitModule :: String -> [String]
+		splitModule = takeWhile (not . null) . unfoldr (Just . second (drop 1) . break (== '.'))
+
+-- | Executable
+data Executable = Executable {
+	executableName :: String,
+	executablePath :: FilePath,
+	executableBuildInfo :: Info }
+		deriving (Eq, Read)
+
+instance Target Executable where
+	buildInfo = executableBuildInfo
+
+instance Show Executable where
+	show e = unlines $
+		["executable " ++ executableName e, "\tpath: " ++ executablePath e] ++
+		(map (tab 1) . lines . show $ executableBuildInfo e)
+
+instance ToJSON Executable where
+	toJSON e = object [
+		"name" .= executableName e,
+		"path" .= executablePath e,
+		"info" .= executableBuildInfo e]
+
+instance FromJSON Executable where
+	parseJSON = withObject "executable" $ \v -> Executable <$>
+		v .:: "name" <*>
+		v .:: "path" <*>
+		v .:: "info"
+
+-- | Test
+data Test = Test {
+	testName :: String,
+	testEnabled :: Bool,
+	testBuildInfo :: Info }
+		deriving (Eq, Read)
+
+instance Target Test where
+	buildInfo = testBuildInfo
+
+instance Show Test where
+	show t = unlines $
+		["test " ++ testName t, "\tenabled: " ++ show (testEnabled t)] ++
+		(map (tab 1) . lines . show $ testBuildInfo t)
+
+instance ToJSON Test where
+	toJSON t = object [
+		"name" .= testName t,
+		"enabled" .= testEnabled t,
+		"info" .= testBuildInfo t]
+
+instance FromJSON Test where
+	parseJSON = withObject "test" $ \v -> Test <$>
+		v .:: "name" <*>
+		v .:: "enabled" <*>
+		v .:: "info"
+
+-- | Build info
+data Info = Info {
+	infoDepends :: [String],
+	infoLanguage :: Maybe Language,
+	infoExtensions :: [Extension],
+	infoSourceDirs :: [FilePath] }
+		deriving (Eq, Read)
+
+instance Show Info where
+	show i = unlines $ lang ++ exts ++ sources where
+		lang = maybe [] (\l -> ["default-language: " ++ display l]) $ infoLanguage i
+		exts
+			| null (infoExtensions i) = []
+			| otherwise = ["extensions:"] ++ map (tab 1) (map display (infoExtensions i))
+		sources = ["source-dirs:"] ++
+			(map (tab 1) $ infoSourceDirs i)
+
+instance ToJSON Info where
+	toJSON i = object [
+		"build-depends" .= infoDepends i,
+		"language" .= fmap display (infoLanguage i),
+		"extensions" .= map display (infoExtensions i),
+		"source-dirs" .= infoSourceDirs i]
+
+instance FromJSON Info where
+	parseJSON = withObject "info" $ \v -> Info <$>
+		v .: "build-depends" <*>
+		((v .:: "language") >>= traverse (parseDT "Language")) <*>
+		((v .:: "extensions") >>= traverse (parseDT "Extension")) <*>
+		v .:: "source-dirs"
+
+-- | Analyze cabal file
+analyzeCabal :: String -> Either String ProjectDescription
+analyzeCabal source = case liftM flattenDescr $ parsePackageDescription source of
+	ParseOk _ r -> Right ProjectDescription {
+		projectLibrary = fmap toLibrary $ PD.library r,
+		projectExecutables = fmap toExecutable $ PD.executables r,
+		projectTests = fmap toTest $ PD.testSuites r }
+	ParseFailed e -> Left $ "Parse failed: " ++ show e
+	where
+		toLibrary (PD.Library exposeds _ info) = Library (map components exposeds) (toInfo info)
+		toExecutable (PD.Executable name path info) = Executable name path (toInfo info)
+		toTest (PD.TestSuite name _ info enabled) = Test name enabled (toInfo info)
+		toInfo info = Info {
+			infoDepends = map pkgName (PD.targetBuildDepends info),
+			infoLanguage = PD.defaultLanguage info,
+			infoExtensions = PD.defaultExtensions info,
+			infoSourceDirs = PD.hsSourceDirs info }
+
+		pkgName :: P.Dependency -> String
+		pkgName (P.Dependency (P.PackageName s) _) = s
+
+		flattenDescr :: PD.GenericPackageDescription -> PD.PackageDescription
+		flattenDescr (PD.GenericPackageDescription pkg _ mlib mexes mtests _) = pkg {
+			PD.library = flip fmap mlib $ flattenTree
+				(insert PD.libBuildInfo (\i l -> l { PD.libBuildInfo = i })),
+			PD.executables = flip fmap mexes $
+				second (flattenTree (insert PD.buildInfo (\i l -> l { PD.buildInfo = i }))) >>>
+				(\(n, e) -> e { PD.exeName = n }),
+			PD.testSuites = flip fmap mtests $
+				second (flattenTree (insert PD.testBuildInfo (\i l -> l { PD.testBuildInfo = i }))) >>>
+				(\(n, t) -> t { PD.testName = n }) }
+			where
+				insert :: (a -> PD.BuildInfo) -> (PD.BuildInfo -> a -> a) -> [P.Dependency] -> a -> a
+				insert f s deps x = s ((f x) { PD.targetBuildDepends = deps }) x
+
+		flattenTree :: Monoid a => (c -> a -> a) -> PD.CondTree v c a -> a
+		flattenTree f (PD.CondNode x cs cmps) = f cs x `mappend` mconcat (concatMap flattenBranch cmps) where
+			flattenBranch (_, t, mb) = flattenTree f t : map (flattenTree f) (maybeToList mb)
+
+-- | Read project info from .cabal
+readProject :: FilePath -> ErrorT String IO Project
+readProject file = do
+	source <- ErrorT $ handle (\e -> return (Left ("IO error: " ++ show (e :: IOException)))) (fmap Right $ readFile file)
+	length source `seq` either throwError (return . mkProject) $ analyzeCabal source
+	where
+		mkProject desc = (project file) {
+			projectDescription = Just desc }
+
+-- | Load project description
+loadProject :: Project -> ErrorT String IO Project
+loadProject p
+	| isJust (projectDescription p) = return p
+	| otherwise = readProject (projectCabal p)
+
+-- | Make project by .cabal file
+project :: FilePath -> Project
+project file = Project {
+	projectName = takeBaseName (takeDirectory file),
+	projectPath = takeDirectory file,
+	projectCabal = file,
+	projectDescription = Nothing }
+
+-- | Entity with project extensions
+data Extensions a = Extensions {
+	extensions :: [Extension],
+	entity :: a }
+
+instance Functor Extensions where
+	fmap f (Extensions e x) = Extensions e (f x)
+
+instance Applicative Extensions where
+	pure = Extensions []
+	(Extensions l f) <*> (Extensions r x) = Extensions (l ++ r) (f x)
+
+instance Foldable Extensions where
+	foldMap f (Extensions _ x) = f x
+
+instance Traversable Extensions where
+	traverse f (Extensions e x) = Extensions e <$> f x
+
+-- | Extensions for target
+withExtensions :: a -> Info -> Extensions a
+withExtensions x i = Extensions {
+	extensions = infoExtensions i,
+	entity = x }
+
+-- | Returns build targets infos
+infos :: ProjectDescription -> [Info]
+infos p =
+	maybe [] (return . libraryBuildInfo) (projectLibrary p) ++
+	map executableBuildInfo (projectExecutables p) ++
+	map testBuildInfo (projectTests p)
+
+-- | Check if source related to target, source must be relative to project directory
+inTarget :: FilePath -> Info -> Bool
+inTarget src info = any ((`isPrefixOf` normalise src) . normalise) $ infoSourceDirs info
+
+-- | Get target for source file
+fileTarget :: Project -> FilePath -> Maybe Info
+fileTarget p f = find (makeRelative (projectPath p) f `inTarget`) $
+	maybe [] infos $ projectDescription p
+
+-- | Finds source dir file belongs to
+findSourceDir :: Project -> FilePath -> Maybe FilePath
+findSourceDir p f = do
+	info <- fileTarget p f
+	listToMaybe $ filter (`isParent` f) $ map (projectPath p </>) $ infoSourceDirs info
+
+-- | Returns source dirs for library, executables and tests
+sourceDirs :: ProjectDescription -> [Extensions FilePath]
+sourceDirs = concatMap dirs . infos where
+	dirs i = map (`withExtensions` i) $ infoSourceDirs i
+
+parseDT :: Distribution.Text.Text a => String -> String -> Parser a
+parseDT typeName v = maybe err return (simpleParse v) where
+	err = fail $ "Can't parse " ++ typeName ++ ": " ++ v
+
+-- | Extension as flag name
+showExtension :: Extension -> String
+showExtension = display
+
+-- | Convert -Xext to ext
+flagExtension :: String -> Maybe String
+flagExtension = stripPrefix "-X"
+
+-- | Convert ext to -Xext
+extensionFlag :: String -> String
+extensionFlag = ("-X" ++)
+
+-- | Extensions as opts to GHC
+extensionsOpts :: [Extension] -> [String]
+extensionsOpts = map (extensionFlag . showExtension)

@@ -0,0 +1,92 @@+module HsDev.Scan (
+	-- * Enumerate functions
+	enumCabal, CompileFlag, ModuleToScan, ProjectToScan,
+	enumProject, enumDirectory,
+
+	-- * Scan
+	scanProjectFile,
+	scanModule, upToDate, rescanModule, changedModule, changedModules
+	) where
+
+import Control.Monad.Error
+import Data.List
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
+import Data.Traversable (traverse)
+
+import HsDev.Symbols
+import HsDev.Database
+import HsDev.Tools.GhcMod
+import HsDev.Tools.GhcMod.InferType (inferTypes)
+import HsDev.Tools.HDocs
+import HsDev.Inspect
+import HsDev.Project
+import HsDev.Util
+
+-- | Enum cabal modules
+enumCabal :: [String] -> Cabal -> ErrorT String IO [ModuleLocation]
+enumCabal = list
+
+-- | Compile flags
+type CompileFlag = String
+-- | Module with flags ready to scan
+type ModuleToScan = (ModuleLocation, [CompileFlag])
+-- | Project ready to scan
+type ProjectToScan = (Project, [ModuleToScan])
+
+-- | Enum project sources
+enumProject :: Project -> ErrorT String IO ProjectToScan
+enumProject p = do
+	p' <- loadProject p
+	srcs <- projectSources p'
+	return (p', [(FileModule (entity src) (Just p'), extensionsOpts (extensions src)) | src <- srcs])
+
+-- | Enum directory modules
+enumDirectory :: FilePath -> ErrorT String IO ([ProjectToScan], [ModuleToScan])
+enumDirectory dir = do
+	files <- liftException $ traverseDirectory dir
+	let
+		projects = filter cabalFile files
+		sources = filter haskellSource files
+	projs <- mapM (enumProject . project) projects
+	let
+		projPaths = map (projectPath . fst) projs
+		projSources = concatMap (mapMaybe (moduleSource . fst) . snd) projs
+		standalone = map (\f -> FileModule f Nothing) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
+	return (projs,  [(s, []) | s <- standalone])
+
+-- | Scan project file
+scanProjectFile :: [String] -> FilePath -> ErrorT String IO Project
+scanProjectFile opts f = do
+	proj <- (liftIO $ locateProject f) >>= maybe (throwError "Can't locate project") return
+	loadProject proj
+
+-- | Scan module
+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"
+
+-- | Is inspected module up to date?
+upToDate :: [String] -> InspectedModule -> ErrorT String IO Bool
+upToDate opts (Inspected insp m _) = case m of
+	FileModule f p -> liftM (== insp) $ fileInspection f opts
+	CabalModule c p n -> return $ insp == browseInspection opts
+	_ -> return False
+
+-- | Rescan inspected module
+rescanModule :: [String] -> InspectedModule -> ErrorT String IO (Maybe InspectedModule)
+rescanModule opts im = do
+	up <- upToDate opts im
+	if up
+		then return Nothing
+		else fmap Just $ scanModule opts (inspectedId im)
+
+-- | Is module new or recently changed
+changedModule :: Database -> [String] -> ModuleLocation -> ErrorT String IO Bool
+changedModule db opts m = maybe (return True) (liftM not . upToDate opts) m' where
+	m' = M.lookup m (databaseModules db)
+
+-- | Returns new (to scan) and changed (to rescan) modules
+changedModules :: Database -> [String] -> [ModuleLocation] -> ErrorT String IO [ModuleLocation]
+changedModules db opts ms = filterM (changedModule db opts) ms

@@ -0,0 +1,130 @@+module HsDev.Scan.Browse (
+	-- * Scan cabal modules
+	browseFilter, browse
+	) where
+
+import Control.Arrow
+import Control.Monad.Error
+import Data.Maybe
+import Data.Either
+import qualified Data.Map as M
+import Text.Read (readMaybe)
+
+import HsDev.Cabal
+import HsDev.Symbols
+import HsDev.Tools.Base (inspect)
+
+import qualified ConLike as GHC
+import qualified DataCon as GHC
+import qualified DynFlags as GHC
+import qualified Exception as GHC
+import qualified FastString as GHC
+import qualified GHC
+import qualified GhcMonad as GHC (liftIO)
+import qualified GHC.Paths as GHC
+import qualified Module as GHC
+import qualified Name as GHC
+import qualified Name as GHC
+import qualified Outputable as GHC
+import qualified Packages as GHC
+import qualified PatSyn as GHC
+import qualified TyCon as GHC
+import qualified Type as GHC
+import qualified Var as GHC
+import Pretty
+
+-- | Browse modules
+browseFilter :: [String] -> Cabal -> (ModuleLocation -> ErrorT String IO Bool) -> ErrorT String IO [InspectedModule]
+browseFilter opts cabal f = withPackages_ (cabalOpt cabal ++ opts) $ do
+	ms <- lift $ GHC.packageDbModules False
+	ms' <- filterM (mapErrorT GHC.liftIO . f . loc) ms
+	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)
+
+		browseModule' :: GHC.Module -> ErrorT String GHC.Ghc (Maybe InspectedModule)
+		browseModule' m = tryT $ inspect (loc m) (return $ InspectionAt 0 opts) (browseModule cabal m)
+
+-- | Browse all modules
+browse :: [String] -> Cabal -> ErrorT String IO [InspectedModule]
+browse opts cabal = browseFilter opts cabal (const $ return True)
+
+browseModule :: Cabal -> GHC.Module -> ErrorT String GHC.Ghc Module
+browseModule cabal m = do
+	mi <- lift (GHC.getModuleInfo m) >>= maybe (throwError "Can't find module info") return
+	ds <- mapM (toDecl mi) (GHC.modInfoExports mi)
+	return $ Module {
+		moduleName = GHC.moduleNameString (GHC.moduleName m),
+		moduleDocs = Nothing,
+		moduleLocation = mloc,
+		moduleExports = [],
+		moduleImports = [],
+		moduleDeclarations = M.fromList (map (declarationName &&& id) ds) }
+	where
+		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
+			dflag <- lift GHC.getSessionDynFlags
+			return $ Declaration
+				(GHC.getOccString n)
+				Nothing
+				Nothing
+				(fromMaybe (Function Nothing []) (tyResult >>= showResult dflag))
+		showResult :: GHC.DynFlags -> GHC.TyThing -> Maybe DeclarationInfo
+		showResult dflags (GHC.AnId i) = Just $ Function (Just $ formatType dflags GHC.varType i) []
+		showResult dflags (GHC.AConLike c) = case c of
+			GHC.RealDataCon d -> Just $ Function (Just $ formatType dflags GHC.dataConRepType d) []
+			GHC.PatSynCon p -> Just $ Function (Just $ formatType dflags GHC.patSynType p) []
+		showResult _ (GHC.ATyCon t) = Just $ tcon $ TypeInfo Nothing (map GHC.getOccString $ GHC.tyConTyVars t) Nothing where
+			tcon
+				| GHC.isAlgTyCon t && not (GHC.isNewTyCon t) && not (GHC.isClassTyCon t) = Data
+				| GHC.isNewTyCon t = NewType
+				| GHC.isClassTyCon t = Class
+				| GHC.isSynTyCon t = Type
+				| otherwise = Type
+
+withInitializedPackages :: [String] -> (GHC.DynFlags -> GHC.Ghc a) -> IO a
+withInitializedPackages ghcOpts cont = GHC.runGhc (Just GHC.libdir) $ do
+		fs <- GHC.getSessionDynFlags
+		GHC.defaultCleanupHandler fs $ do
+			(fs', _, _) <- GHC.parseDynamicFlags fs (map GHC.noLoc ghcOpts)
+			GHC.setSessionDynFlags fs'
+			(result, _) <- GHC.liftIO $ GHC.initPackages fs'
+			cont result
+
+withPackages :: [String] -> (GHC.DynFlags -> ErrorT String GHC.Ghc a) -> ErrorT String IO a
+withPackages ghcOpts cont = ErrorT $ withInitializedPackages ghcOpts (runErrorT . cont)
+
+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
+
+formatType :: GHC.NamedThing a => GHC.DynFlags -> (a -> GHC.Type) -> a -> String
+formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
+
+removeForAlls :: GHC.Type -> GHC.Type
+removeForAlls ty = removeForAlls' ty' tty' where
+	ty'  = GHC.dropForAlls ty
+	tty' = GHC.splitFunTy_maybe ty'
+
+removeForAlls' :: GHC.Type -> Maybe (GHC.Type, GHC.Type) -> GHC.Type
+removeForAlls' ty Nothing = ty
+removeForAlls' ty (Just (pre, ftype))
+	| GHC.isPredTy pre = GHC.mkFunTy pre (GHC.dropForAlls ftype)
+	| otherwise = ty
+
+showOutputable :: GHC.Outputable a => GHC.DynFlags -> a -> String
+showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . GHC.ppr
+
+showUnqualifiedPage :: GHC.DynFlags -> GHC.SDoc -> String
+showUnqualifiedPage dflag = Pretty.showDoc Pretty.LeftMode 0 . GHC.withPprStyleDoc dflag styleUnqualified
+
+styleUnqualified :: GHC.PprStyle
+styleUnqualified = GHC.mkUserStyle GHC.neverQualify GHC.AllTheWay
+
+tryT :: (Monad m, Error e) => ErrorT e m a -> ErrorT e m (Maybe a)
+tryT act = catchError (liftM Just $ act) (const $ return Nothing)

@@ -0,0 +1,531 @@+{-# LANGUAGE  TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module HsDev.Symbols (
+	-- * Information
+	Import(..),
+	Symbol(..),
+	ModuleId(..), Module(..), moduleLocals, moduleLocalDeclarations, moduleModuleDeclarations, moduleId,
+	Locals(..),
+	Declaration(..), declarationLocals,
+	TypeInfo(..),
+	DeclarationInfo(..),
+	ModuleDeclaration(..),
+	Inspection(..), inspectionOpts,
+	Inspected(..), InspectedModule,
+
+	-- * Functions
+	showTypeInfo,
+	declarationInfo, declarationTypeInfo, declarationTypeCtor, declarationTypeName,
+	qualifiedName,
+	importQualifier,
+
+	-- * Utility
+	Canonicalize(..),
+	locateProject,
+	locateSourceDir,
+
+	-- * Modifiers
+	addDeclaration,
+
+	-- * Other
+	unalias, moduleContents,
+
+	-- * Reexports
+	module HsDev.Symbols.Class,
+	module HsDev.Symbols.Documented
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.DeepSeq (NFData(..))
+import Control.Monad.Trans.Maybe
+import Control.Monad.Error
+import Data.Aeson
+import Data.List
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
+import Data.Monoid (Monoid(mempty))
+import Data.Time.Clock.POSIX (POSIXTime)
+import Data.Foldable (Foldable(..))
+import Data.Traversable (Traversable(..))
+import System.Directory
+import System.FilePath
+
+import HsDev.Symbols.Class
+import HsDev.Symbols.Documented (Documented(..))
+import HsDev.Project
+import HsDev.Util (tab, tabs, (.::))
+
+-- | Module import
+data Import = Import {
+	importModuleName :: String,
+	importIsQualified :: Bool,
+	importAs :: Maybe String,
+	importPosition :: Maybe Position }
+		deriving (Eq, Ord)
+
+instance NFData Import where
+	rnf (Import m q a l) = rnf m `seq` rnf q `seq` rnf a `seq` rnf l
+
+instance Show Import where
+	show i = "import " ++ (if importIsQualified i then "qualified " else "") ++ importModuleName i ++ maybe "" (" as " ++) (importAs i)
+
+instance ToJSON Import where
+	toJSON i = object [
+		"name" .= importModuleName i,
+		"qualified" .= importIsQualified i,
+		"as" .= importAs i,
+		"pos" .= importPosition i]
+
+instance FromJSON Import where
+	parseJSON = withObject "import" $ \v -> Import <$>
+		v .:: "name" <*>
+		v .:: "qualified" <*>
+		v .:: "as" <*>
+		v .:: "pos"
+
+-- | Imported module can be accessed via qualifier
+importQualifier :: Maybe String -> Import -> Bool
+importQualifier Nothing i
+	| not (importIsQualified i) = True
+	| otherwise = False
+importQualifier (Just q) i
+	| q == importModuleName i = True
+	| Just q == importAs i = True
+	| otherwise = False
+
+instance Symbol Module where
+	symbolName = moduleName
+	symbolQualifiedName = moduleName
+	symbolDocs = moduleDocs
+	symbolLocation m = Location (moduleLocation m) Nothing
+
+instance Symbol ModuleId where
+	symbolName = moduleIdName
+	symbolQualifiedName = moduleIdName
+	symbolDocs = const Nothing
+	symbolLocation m = Location (moduleIdLocation m) Nothing
+
+instance Symbol Declaration where
+	symbolName = declarationName
+	symbolQualifiedName = declarationName
+	symbolDocs = declarationDocs
+	symbolLocation d = Location (OtherModuleSource Nothing) (declarationPosition d)
+
+instance Symbol ModuleDeclaration where
+	symbolName = declarationName . moduleDeclaration
+	symbolQualifiedName d = qualifiedName (declarationModuleId d) (moduleDeclaration d)
+	symbolDocs = declarationDocs . moduleDeclaration
+	symbolLocation d = (symbolLocation $ declarationModuleId d) {
+		locationPosition = declarationPosition $ moduleDeclaration d }
+
+-- | Module id
+data ModuleId = ModuleId {
+	moduleIdName :: String,
+	moduleIdLocation :: ModuleLocation }
+		deriving (Eq, Ord)
+
+instance NFData ModuleId where
+	rnf (ModuleId n l) = rnf n `seq` rnf l
+
+instance Show ModuleId where
+	show (ModuleId n l) = "module " ++ n ++ " from " ++ show l
+
+instance ToJSON ModuleId where
+	toJSON m = object [
+		"name" .= moduleIdName m,
+		"location" .= moduleIdLocation m]
+
+instance FromJSON ModuleId where
+	parseJSON = withObject "module id" $ \v -> ModuleId <$>
+		v .:: "name" <*>
+		v .:: "location"
+
+-- | Module
+data Module = Module {
+	moduleName :: String,
+	moduleDocs :: Maybe String,
+	moduleLocation :: ModuleLocation,
+	moduleExports :: [String],
+	moduleImports :: [Import],
+	moduleDeclarations :: Map String Declaration }
+		deriving (Ord)
+
+instance ToJSON Module where
+	toJSON m = object [
+		"name" .= moduleName m,
+		"docs" .= moduleDocs m,
+		"location" .= moduleLocation m,
+		"exports" .= moduleExports m,
+		"imports" .= moduleImports m,
+		"declarations" .= M.elems (moduleDeclarations m)]
+
+instance FromJSON Module where
+	parseJSON = withObject "module" $ \v -> Module <$>
+		v .:: "name" <*>
+		v .:: "docs" <*>
+		v .:: "location" <*>
+		v .:: "exports" <*>
+		v .:: "imports" <*>
+		((M.fromList . map (declarationName &&& id)) <$>v .:: "declarations")
+
+instance NFData Module where
+	rnf (Module n d s e i ds) = rnf n `seq` rnf d `seq` rnf s `seq` rnf e `seq` rnf i `seq` rnf ds
+
+instance Eq Module where
+	l == r = moduleName l == moduleName r && moduleLocation l == moduleLocation r
+
+instance Show Module where
+	show m = unlines $ filter (not . null) [
+		"module " ++ moduleName m,
+		"\tlocation: " ++ show (moduleLocation m),
+		"\texports: " ++ intercalate ", " (moduleExports m),
+		"\timports:",
+		unlines $ map (tab 2 . show) $ moduleImports m,
+		"\tdeclarations:",
+		unlines $ map (tabs 2 . show) $ M.elems (moduleDeclarations m),
+		maybe "" ("\tdocs: " ++) (moduleDocs m)]
+
+-- | Bring locals to top
+moduleLocals :: Module -> Module
+moduleLocals m = m { moduleDeclarations = moduleLocalDeclarations m }
+
+-- | Get declarations with locals
+moduleLocalDeclarations :: Module -> Map String Declaration
+moduleLocalDeclarations =
+	M.fromList .
+	map (declarationName &&& id) . 
+	concatMap declarationLocals' .
+	M.elems .
+	moduleDeclarations
+	where
+		declarationLocals' :: Declaration -> [Declaration]
+		declarationLocals' d = d : declarationLocals d
+
+-- | Get list of declarations as ModuleDeclaration
+moduleModuleDeclarations :: Module -> [ModuleDeclaration]
+moduleModuleDeclarations m = [ModuleDeclaration (moduleId m) d | d <- M.elems (moduleDeclarations m)]
+
+-- Make ModuleId by Module
+moduleId :: Module -> ModuleId
+moduleId m = ModuleId {
+	moduleIdName = moduleName m,
+	moduleIdLocation = moduleLocation m }
+
+class Locals a where
+	locals :: a -> [Declaration]
+	where_ :: a -> [Declaration] -> a
+
+-- | Declaration
+data Declaration = Declaration {
+	declarationName :: String,
+	declarationDocs :: Maybe String,
+	declarationPosition :: Maybe Position,
+	declaration :: DeclarationInfo }
+		deriving (Eq, Ord)
+
+instance NFData Declaration where
+	rnf (Declaration n d l x) = rnf n `seq` rnf d `seq` rnf l `seq` rnf x
+
+instance Show Declaration where
+	show d = unlines $ filter (not . null) [
+		brief d,
+		maybe "" ("\tdocs: " ++) $ declarationDocs d,
+		maybe "" (("\tlocation: " ++ ) . show) $ declarationPosition d]
+
+instance ToJSON Declaration where
+	toJSON d = object [
+		"name" .= declarationName d,
+		"docs" .= declarationDocs d,
+		"pos" .= declarationPosition d,
+		"decl" .= declaration d]
+
+instance FromJSON Declaration where
+	parseJSON = withObject "declaration" $ \v -> Declaration <$>
+		v .:: "name" <*>
+		v .:: "docs" <*>
+		v .:: "pos" <*>
+		v .:: "decl"
+
+instance Locals Declaration where
+	locals = locals . declaration
+	where_ d ds = d { declaration = where_ (declaration d) ds }
+
+declarationLocals :: Declaration -> [Declaration]
+declarationLocals d = map prefix' $ locals $ declaration d where
+	prefix' decl = decl { declarationName = declarationName decl }
+
+-- | Common info for type/newtype/data/class
+data TypeInfo = TypeInfo {
+	typeInfoContext :: Maybe String,
+	typeInfoArgs :: [String],
+	typeInfoDefinition :: Maybe String }
+		deriving (Eq, Ord, Read, Show)
+
+instance NFData TypeInfo where
+	rnf (TypeInfo c a d) = rnf c `seq` rnf a `seq` rnf d
+
+instance ToJSON TypeInfo where
+	toJSON t = object [
+		"ctx" .= typeInfoContext t,
+		"args" .= typeInfoArgs t,
+		"def" .= typeInfoDefinition t]
+
+instance FromJSON TypeInfo where
+	parseJSON = withObject "type info" $ \v -> TypeInfo <$>
+		v .:: "ctx" <*>
+		v .:: "args" <*>
+		v .:: "def"
+
+showTypeInfo :: TypeInfo -> String -> String -> String
+showTypeInfo ti pre name = pre ++ maybe "" (++ " =>") (typeInfoContext ti) ++ " " ++ name ++ " " ++ unwords (typeInfoArgs ti) ++ maybe "" (" = " ++) (typeInfoDefinition ti)
+
+-- | Declaration info
+data DeclarationInfo =
+	Function { functionType :: Maybe String, localDeclarations :: [Declaration] } |
+	Type { typeInfo :: TypeInfo } |
+	NewType { newTypeInfo :: TypeInfo } |
+	Data { dataInfo :: TypeInfo } |
+	Class { classInfo :: TypeInfo }
+		deriving (Ord)
+
+instance NFData DeclarationInfo where
+	rnf (Function f ds) = rnf f `seq` rnf ds
+	rnf (Type i) = rnf i
+	rnf (NewType i) = rnf i
+	rnf (Data i) = rnf i
+	rnf (Class i) = rnf i
+
+instance Eq DeclarationInfo where
+	(Function l lds) == (Function r rds) = l == r && lds == rds
+	(Type _) == (Type _) = True
+	(NewType _) == (NewType _) = True
+	(Data _) == (Data _) = True
+	(Class _) == (Class _) = True
+	_ == _ = False
+
+instance ToJSON DeclarationInfo where
+	toJSON i = case declarationInfo i of
+		Left (t, ds) -> object ["what" .= ("function" :: String), "type" .= t, "locals" .= ds]
+		Right ti -> object ["what" .= declarationTypeName i, "info" .= ti]
+
+instance FromJSON DeclarationInfo where
+	parseJSON = withObject "declaration info" $ \v -> do
+		w <- fmap (id :: String -> String) $ v .:: "what"
+		if w == "function"
+			then Function <$> v .:: "type" <*> v .:: "locals"
+			else declarationTypeCtor w <$> v .:: "info"
+
+instance Locals DeclarationInfo where
+	locals (Function _ ds) = ds
+	locals _ = []
+	where_ (Function n s) ds = Function n (s ++ ds)
+	where_ d _ = d
+
+-- | Get function type of type info
+declarationInfo :: DeclarationInfo -> Either (Maybe String, [Declaration]) TypeInfo
+declarationInfo (Function t ds) = Left (t, ds)
+declarationInfo (Type ti) = Right ti
+declarationInfo (NewType ti) = Right ti
+declarationInfo (Data ti) = Right ti
+declarationInfo (Class ti) = Right ti
+
+-- | Get type info of declaration
+declarationTypeInfo :: DeclarationInfo -> Maybe TypeInfo
+declarationTypeInfo = either (const Nothing) Just . declarationInfo
+
+declarationTypeCtor :: String -> TypeInfo -> DeclarationInfo
+declarationTypeCtor "type" = Type
+declarationTypeCtor "newtype" = NewType
+declarationTypeCtor "data" = Data
+declarationTypeCtor "class" = Class
+declarationTypeCtor "" = error "Invalid type constructor name"
+
+declarationTypeName :: DeclarationInfo -> Maybe String
+declarationTypeName (Type _) = Just "type"
+declarationTypeName (NewType _) = Just "newtype"
+declarationTypeName (Data _) = Just "data"
+declarationTypeName (Class _) = Just "class"
+declarationTypeName _ = Nothing
+
+-- | Symbol in module
+data ModuleDeclaration = ModuleDeclaration {
+	declarationModuleId :: ModuleId,
+	moduleDeclaration :: Declaration }
+		deriving (Eq, Ord)
+
+instance NFData ModuleDeclaration where
+	rnf (ModuleDeclaration m s) = rnf m `seq` rnf s
+
+instance Show ModuleDeclaration where
+	show (ModuleDeclaration m s) = unlines $ filter (not . null) [
+		show s,
+		"\tmodule: " ++ show (moduleIdLocation m)]
+
+instance ToJSON ModuleDeclaration where
+	toJSON d = object [
+		"module-id" .= declarationModuleId d,
+		"declaration" .= moduleDeclaration d]
+
+instance FromJSON ModuleDeclaration where
+	parseJSON = withObject "module declaration" $ \v -> ModuleDeclaration <$>
+		v .:: "module-id" <*>
+		v .:: "declaration"
+
+-- | Returns qualified name of symbol
+qualifiedName :: ModuleId -> Declaration -> String
+qualifiedName m d = moduleIdName m ++ "." ++ declarationName d
+
+class Canonicalize a where
+	canonicalize :: a -> IO a
+
+instance Canonicalize Cabal where
+	canonicalize Cabal = return Cabal
+	canonicalize (Sandbox p) = fmap Sandbox $ canonicalizePath p
+
+instance Canonicalize Project where
+	canonicalize (Project nm p c desc) = liftM3 (Project nm) (canonicalizePath p) (canonicalizePath c) (return desc)
+
+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
+
+-- | Find project file is related to
+locateProject :: FilePath -> IO (Maybe Project)
+locateProject file = do
+	file' <- canonicalizePath file
+	isDir <- doesDirectoryExist file'
+	if isDir then locateHere file' else locateParent (takeDirectory file')
+	where
+		locateHere path = do
+			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents path
+			return $ fmap (project . (path </>)) $ find ((== ".cabal") . takeExtension) cts
+		locateParent dir = do
+			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents dir
+			case find ((== ".cabal") . takeExtension) cts of
+				Nothing -> if isDrive dir then return Nothing else locateParent (takeDirectory dir)
+				Just cabalf -> return $ Just $ project (dir </> cabalf)
+
+-- | Locate source dir of file
+locateSourceDir :: FilePath -> IO (Maybe FilePath)
+locateSourceDir f = runMaybeT $ do
+	file <- liftIO $ canonicalizePath f
+	p <- MaybeT $ locateProject file
+	proj <- MaybeT $ fmap (either (const Nothing) Just) $ runErrorT $ loadProject p
+	MaybeT $ return $ findSourceDir proj file
+
+-- | Add declaration to module
+addDeclaration :: Declaration -> Module -> Module
+addDeclaration decl m = m { moduleDeclarations = decls' } where
+	decls' = M.insert (declarationName decl) decl $ moduleDeclarations m
+
+-- | Unalias import name
+unalias :: Module -> String -> [String]
+unalias m alias = [importModuleName i | i <- moduleImports m, importAs i == Just alias]
+
+instance Documented ModuleId where
+	brief m = moduleIdName m ++ " in " ++ show (moduleIdLocation m)
+
+instance Documented Module where
+	brief m = moduleName m ++ " in " ++ show (moduleLocation m)
+	detailed m = unlines $ header ++ docs ++ cts where
+		header = [brief m, ""]
+		docs = maybe [] return $ moduleDocs m
+		cts = moduleContents m
+
+instance Documented Declaration where
+	brief d = case declarationInfo $ declaration d of
+		Left (f, _) -> name ++ maybe "" (" :: " ++) f
+		Right ti -> showTypeInfo ti (fromMaybe err $ declarationTypeName $ declaration d) name
+		where
+			name = declarationName d
+			err = error "Impossible happened: declarationTypeName"
+
+instance Documented ModuleDeclaration where
+	brief = brief . moduleDeclaration
+
+-- | Module contents
+moduleContents :: Module -> [String]
+moduleContents = map showDecl . M.elems . moduleDeclarations where
+	showDecl d = brief d ++ maybe "" (" -- " ++) (declarationDocs d)
+
+-- | Inspection data
+data Inspection =
+	-- | No inspection
+	InspectionNone |
+	-- | Time and flags of inspection
+	InspectionAt POSIXTime [String]
+		deriving (Eq, Ord)
+
+-- | Get inspection opts
+inspectionOpts :: Inspection -> [String]
+inspectionOpts InspectionNone = []
+inspectionOpts (InspectionAt _ opts) = opts
+
+instance NFData Inspection where
+	rnf InspectionNone = ()
+	rnf (InspectionAt t fs) = rnf t `seq` rnf fs
+
+instance Show Inspection where
+	show InspectionNone = "none"
+	show (InspectionAt tm fs) = "mtime " ++ show tm ++ ", flags [" ++ intercalate ", " fs ++ "]"
+
+instance Read POSIXTime where
+	readsPrec i = map (first (fromIntegral :: Integer -> POSIXTime)) . readsPrec i
+
+instance ToJSON Inspection where
+	toJSON InspectionNone = object ["inspected" .= False]
+	toJSON (InspectionAt tm fs) = object [
+		"mtime" .= (floor tm :: Integer),
+		"flags" .= fs]
+
+instance FromJSON Inspection where
+	parseJSON = withObject "inspection" $ \v ->
+		((const InspectionNone :: Bool -> Inspection) <$> v .:: "inspected") <|>
+		(InspectionAt <$> (fromInteger <$> v .:: "mtime") <*> (v .:: "flags"))
+
+-- | Inspected entity
+data Inspected i a = Inspected {
+	inspection :: Inspection,
+	inspectedId :: i,
+	inspectionResult :: Either String a }
+		deriving (Eq, Ord)
+
+instance Functor (Inspected i) where
+	fmap f insp = insp {
+		inspectionResult = fmap f (inspectionResult insp) }
+
+instance Foldable (Inspected i) where
+	foldMap f = either mempty f . inspectionResult
+
+instance Traversable (Inspected i) where
+	traverse f (Inspected insp i r) = Inspected insp i <$> either (pure . Left) (liftA Right . f) r
+
+instance (NFData i, NFData a) => NFData (Inspected i a) where
+	rnf (Inspected t i r) = rnf t `seq` rnf i `seq` rnf r
+
+-- | Inspected module
+type InspectedModule = Inspected ModuleLocation Module
+
+instance Show InspectedModule where
+	show (Inspected i mi m) = unlines [either showError show m, "\tinspected: " ++ show i] where
+		showError :: String -> String
+		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]
+
+instance ToJSON InspectedModule where
+	toJSON im = object [
+		"inspection" .= inspection im,
+		"location" .= inspectedId im,
+		either ("error" .=) ("module" .=) (inspectionResult im)]
+
+instance FromJSON InspectedModule where
+	parseJSON = withObject "inspected module" $ \v -> Inspected <$>
+		v .:: "inspection" <*>
+		v .:: "location" <*>
+		((Left <$> v .:: "error") <|> (Right <$> v .:: "module"))

@@ -0,0 +1,17 @@+module HsDev.Symbols.Class (
+	Symbol(..),
+	symbolModuleLocation,
+
+	module HsDev.Symbols.Location
+	) where
+
+import HsDev.Symbols.Location
+
+class Symbol a where
+	symbolName :: a -> String
+	symbolQualifiedName :: a -> String
+	symbolDocs :: a -> Maybe String
+	symbolLocation :: a -> Location
+
+symbolModuleLocation :: Symbol a => a -> ModuleLocation
+symbolModuleLocation = locationModule . symbolLocation

@@ -0,0 +1,22 @@+module HsDev.Symbols.Documented (
+	Documented(..),
+	defaultDetailed
+	) where
+
+import HsDev.Symbols.Class
+
+-- | Documented symbol
+class Symbol a => Documented a where
+	brief :: a -> String
+	detailed :: a -> String
+	detailed = unlines . defaultDetailed
+
+-- | Default detailed docs
+defaultDetailed :: Documented a => a -> [String]
+defaultDetailed s = header ++ docs ++ loc where
+	header = [brief s, ""]
+	docs = maybe [] return $ symbolDocs s
+	loc
+		| null mloc = []
+		| otherwise = ["Defined at " ++ mloc]
+	mloc = show (symbolLocation s)

@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Symbols.Location (
+	ModulePackage(..), ModuleLocation(..), moduleSource, moduleCabalPackage,
+	Position(..), Region(..), region, regionLines, regionStr,
+	Location(..),
+
+	packageOpt,
+
+	module HsDev.Cabal
+	) where
+
+import Control.Applicative
+import Control.DeepSeq (NFData(..))
+import Control.Monad (join)
+import Data.Aeson
+import Data.Char (isSpace, isDigit)
+import Data.List (intercalate)
+import Data.Maybe
+import Text.Read (readMaybe)
+
+import HsDev.Cabal
+import HsDev.Project
+import HsDev.Util ((.::))
+
+data ModulePackage = ModulePackage {
+	packageName :: String,
+	packageVersion :: String }
+		deriving (Eq, Ord)
+
+instance NFData ModulePackage where
+	rnf (ModulePackage n v) = rnf n `seq` rnf v
+
+instance Show ModulePackage where
+	show (ModulePackage n "") = n
+	show (ModulePackage n v) = n ++ "-" ++ v
+
+instance Read ModulePackage where
+	readsPrec _ str = case pkg of
+		"" -> []
+		_ -> [(ModulePackage n v, str')]
+		where
+			(pkg, str') = break isSpace str
+			(rv, rn) = span versionChar $ reverse pkg
+			v = reverse rv
+			n = reverse $ dropWhile (== '-') rn
+
+			versionChar ch = isDigit ch || ch == '.'
+
+instance ToJSON ModulePackage where
+	toJSON (ModulePackage n v) = object [
+		"name" .= n,
+		"version" .= v]
+
+instance FromJSON ModulePackage where
+	parseJSON = withObject "module package" $ \v ->
+		ModulePackage <$> (v .:: "name") <*> (v .:: "version")
+
+-- | Location of module
+data ModuleLocation =
+	FileModule { moduleFile :: FilePath, moduleProject :: Maybe Project } |
+	CabalModule { moduleCabal :: Cabal, modulePackage :: Maybe ModulePackage, cabalModuleName :: String } |
+	OtherModuleSource { moduleOtherSource :: Maybe String }
+		deriving (Eq, Ord)
+
+moduleSource :: ModuleLocation -> Maybe FilePath
+moduleSource (FileModule f _) = Just f
+moduleSource _ = Nothing
+
+moduleCabalPackage :: ModuleLocation -> Maybe ModulePackage
+moduleCabalPackage (CabalModule _ p _) = p
+moduleCabalPackage _ = Nothing
+
+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
+
+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
+
+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]
+
+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")
+
+data Position = Position {
+	positionLine :: Int,
+	positionColumn :: Int }
+		deriving (Eq, Ord, Read)
+
+instance NFData Position where
+	rnf (Position l c) = rnf l `seq` rnf c
+
+instance Show Position where
+ 	show (Position l c) = show l ++ ":" ++ show c
+
+instance ToJSON Position where
+	toJSON (Position l c) = object [
+		"line" .= l,
+		"column" .= c]
+
+instance FromJSON Position where
+	parseJSON = withObject "position" $ \v -> Position <$>
+		v .:: "line" <*>
+		v .:: "column"
+
+data Region = Region {
+	regionFrom :: Position,
+	regionTo :: Position }
+		deriving (Eq, Ord, Read)
+
+region :: Position -> Position -> Region
+region f t = Region (min f t) (max f t)
+
+regionLines :: Region -> Int
+regionLines (Region f t) = succ $ positionLine t - positionLine f
+
+-- | Get string at region
+regionStr :: Region -> String -> String
+regionStr r@(Region f t) s = intercalate "\n" $ drop (pred $ positionColumn f) fline' : tl where
+	s' = take (regionLines r) $ drop (pred (positionLine f)) $ lines s
+	(fline:tl) = init s' ++ [take (pred $ positionColumn t) (last s')]
+	fline' = concatMap untab fline where
+		untab :: Char -> String
+		untab '\t' = replicate 8 ' '
+		untab ch = [ch]
+
+instance NFData Region where
+	rnf (Region f t) = rnf f `seq` rnf t
+
+instance Show Region where
+	show (Region f t) = show f ++ "-" ++ show t
+
+instance ToJSON Region where
+	toJSON (Region f t) = object [
+		"from" .= f,
+		"to" .= t]
+
+instance FromJSON Region where
+	parseJSON = withObject "region" $ \v -> Region <$>
+		v .:: "from" <*>
+		v .:: "to"
+
+-- | Location of symbol
+data Location = Location {
+	locationModule :: ModuleLocation,
+	locationPosition :: Maybe Position }
+		deriving (Eq, Ord)
+
+instance NFData Location where
+	rnf (Location m p) = rnf m `seq` rnf p
+
+instance Show Location where
+	show (Location m p) = show m ++ ":" ++ show p
+
+instance ToJSON Location where
+	toJSON (Location ml p) = object [
+		"module" .= ml,
+		"pos" .= p]
+
+instance FromJSON Location where
+	parseJSON = withObject "location" $ \v -> Location <$>
+		v .:: "module" <*>
+		v .:: "pos"
+
+packageOpt :: Maybe ModulePackage -> [String]
+packageOpt = maybeToList . fmap (("-package " ++) . packageName)

@@ -0,0 +1,168 @@+module HsDev.Symbols.Util (
+	packageOf, projectOf,
+	inProject, inCabal, inPackage, inVersion, inFile, inModuleSource, inModule, byFile, byCabal, standalone,
+	imports, qualifier, imported, visible, inScope,
+	newestPackage,
+	sourceModule, visibleModule, preferredModule, uniqueModules,
+	allOf, anyOf
+	) where
+
+import Control.Arrow ((***), (&&&), second)
+import Control.Monad (join)
+import Data.Function (on)
+import Data.Maybe
+import Data.List (maximumBy, groupBy, sortBy, partition)
+import Data.Ord (comparing)
+import System.FilePath (normalise)
+
+import HsDev.Symbols
+import HsDev.Project
+
+-- | Get module project
+projectOf :: ModuleId -> Maybe Project
+projectOf m = case moduleIdLocation m of
+	FileModule _ proj -> proj
+	_ -> Nothing
+
+-- | Get module package
+packageOf :: ModuleId -> Maybe ModulePackage
+packageOf m = case moduleIdLocation m of
+	CabalModule _ package _ -> package
+	_ -> Nothing
+
+-- | Check if module in project
+inProject :: Project -> ModuleId -> Bool
+inProject p m = projectOf m == Just p
+
+-- | Check if module in cabal
+inCabal :: Cabal -> ModuleId -> Bool
+inCabal c m = case moduleIdLocation m of
+	CabalModule cabal _ _ -> cabal == c
+	_ -> False
+
+-- | Check if module in package
+inPackage :: String -> ModuleId -> Bool
+inPackage p m = case moduleIdLocation m of
+	CabalModule _ package _ -> Just p == fmap packageName package
+	_ -> False
+
+inVersion :: String -> ModuleId -> Bool
+inVersion v m = case moduleIdLocation m of
+	CabalModule _ package _ -> Just v == fmap packageVersion package
+	_ -> False
+
+-- | Check if module in file
+inFile :: FilePath -> ModuleId -> Bool
+inFile fpath m = case moduleIdLocation m of
+	FileModule f _ -> f == normalise fpath
+	_ -> False
+
+-- | Check if module in source
+inModuleSource :: Maybe String -> ModuleId -> Bool
+inModuleSource src m = case moduleIdLocation m of
+	OtherModuleSource src' -> src' == src
+	_ -> False
+
+-- | Check if declaration is in module
+inModule :: String -> ModuleId -> Bool
+inModule mname m = mname == moduleIdName m
+
+-- | Check if module defined in file
+byFile :: ModuleId -> Bool
+byFile m = case moduleIdLocation m of
+	FileModule _ _ -> True
+	_ -> False
+
+-- | Check if module got from cabal database
+byCabal :: ModuleId -> Bool
+byCabal m = case moduleIdLocation m of
+	CabalModule _ _ _ -> True
+	_ -> False
+
+-- | Check if module is standalone
+standalone :: ModuleId -> Bool
+standalone m = case moduleIdLocation m of
+	FileModule _ Nothing -> True
+	_ -> False
+
+-- | Get list of imports
+imports :: Module -> [Import]
+imports = moduleImports
+
+-- | Get list of imports, which can be accessed with specified qualifier or unqualified
+qualifier :: Module -> Maybe String -> [Import]
+qualifier m q = filter (importQualifier q) $ (Import "Prelude" False Nothing Nothing : Import (moduleName m) False Nothing Nothing : imports m)
+
+-- | Check if module imported via imports specified
+imported :: ModuleId -> [Import] -> Bool
+imported m = any (\i -> moduleIdName m == importModuleName i)
+
+-- | Check if module visible from this module within this project
+visible :: Project -> ModuleId -> ModuleId -> Bool
+visible p (ModuleId _ (FileModule src _)) m =
+	inProject p m || any (`inPackage` m) deps || maybe False ((`elem` deps) . projectName) (projectOf m)
+	where
+		deps = maybe [] infoDepends $ fileTarget p src
+visible _ _ _ = False
+
+-- | Check if module is in scope with qualifier
+inScope :: Module -> Maybe String -> ModuleId -> Bool
+inScope this q m = m `imported` qualifier this q
+
+-- | Select modules with last package version
+newestPackage :: Symbol a => [a] -> [a]
+newestPackage =
+	uncurry (++) .
+	(selectNewest *** map fst) .
+	partition (isJust . snd) .
+	map (id &&& (moduleNamePackage . symbolModuleLocation))
+	where
+		moduleNamePackage (CabalModule _ (Just p) mname) = Just (mname, p)
+		moduleNamePackage _ = Nothing
+		pname = fmap (second packageName) . snd
+		pver = fmap (packageVersion . snd) . snd
+		selectNewest :: Symbol a => [(a, Maybe (String, ModulePackage))] -> [a]
+		selectNewest =
+			map (fst . maximumBy (comparing pver)) .
+			groupBy ((==) `on` pname) .
+			sortBy (comparing pname)
+
+-- | Select module, defined by sources
+sourceModule :: Maybe Project -> [Module] -> Maybe Module
+sourceModule proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (byFile . moduleId) ms
+
+-- | Select module, visible in project or cabal
+visibleModule :: Cabal -> Maybe Project -> [Module] -> Maybe Module
+visibleModule cabal proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (inCabal cabal . moduleId) ms
+
+-- | Select preferred visible module
+preferredModule :: Cabal -> Maybe Project -> [ModuleId] -> Maybe ModuleId
+preferredModule cabal proj ms = listToMaybe $ concatMap (`filter` ms) order where
+	order = [
+		maybe (const False) inProject proj,
+		byFile,
+		inCabal cabal,
+		const True]
+
+-- | Remove duplicate modules, leave only `preferredModule`
+uniqueModules :: Cabal -> Maybe Project -> [ModuleId] -> [ModuleId]
+uniqueModules cabal proj =
+	catMaybes .
+	map (preferredModule cabal proj) .
+	groupBy ((==) `on` moduleIdName) .
+	sortBy (comparing moduleIdName)
+
+-- | Select value, satisfying to all predicates
+allOf :: [a -> Bool] -> a -> Bool
+allOf ps x = all ($ x) ps
+
+-- | Select value, satisfying one of predicates
+anyOf :: [a -> Bool] -> a -> Bool
+anyOf ps x = any ($ x) ps
+
+-- | Is file info actual?
+--isActual :: Symbol a -> IO Bool
+--isActual = maybe (return False) checkStamp . symbolLocation where
+--	checkStamp l = do
+--		actualStamp <- getModificationTime (locationFile l)
+--		return $ Just actualStamp == locationTimeStamp l

@@ -0,0 +1,74 @@+module HsDev.Tools.Base (
+	Result, ToolM,
+	runWait, runWait_,
+	tool, tool_,
+	match,
+	at,
+	inspect,
+	-- * Read parse utils
+	ReadM,
+	readParse, parseReads, parseRead
+	) where
+
+import Control.Monad.Error
+import Control.Monad.State
+import Data.Maybe (fromMaybe, listToMaybe)
+import System.Exit
+import System.Process
+import Text.RegexPR (matchRegexPR)
+
+import HsDev.Symbols
+import HsDev.Util (liftIOErrors)
+
+type Result = Either String String
+type ToolM a = ErrorT String IO a
+
+-- | Run command and wait for result
+runWait :: FilePath -> [String] -> String -> IO Result
+runWait name args input = do
+	(code, out, err) <- readProcessWithExitCode name args input
+	return $ if code == ExitSuccess && not (null out) then Right out else Left err
+
+-- | Run command with no input
+runWait_ :: FilePath -> [String] -> IO Result
+runWait_ name args = runWait name args ""
+
+-- | Tool
+tool :: FilePath -> [String] -> String -> ToolM String
+tool name args input = liftIOErrors $ ErrorT $ runWait name args input
+
+-- | Tool with no input
+tool_ :: FilePath -> [String] -> ToolM String
+tool_ name args = tool name args ""
+
+match :: String -> String -> Maybe (Int -> Maybe String)
+match pat str = do
+	(_, groups) <- matchRegexPR pat str
+	return $ \i -> lookup i groups
+
+at :: (Int -> Maybe String) -> Int -> String
+at g i = fromMaybe (error $ "Can't find group " ++ show i) $ g i
+
+inspect :: Monad m => ModuleLocation -> ErrorT String m Inspection -> ErrorT String m Module -> ErrorT String m InspectedModule
+inspect mloc insp act = lift $ execStateT inspect' (Inspected InspectionNone mloc (Left "not inspected")) where
+	inspect' = runErrorT $ do
+		i <- mapErrorT lift insp
+		modify (\im -> im { inspection = i })
+		v <- mapErrorT lift act
+		modify (\im -> im { inspectionResult = Right v })
+		`catchError`
+		\e -> modify (\im -> im { inspectionResult = Left e })
+
+type ReadM a = StateT String [] a
+
+-- | Parse readable value
+readParse :: Read a => ReadM a
+readParse = StateT reads
+
+-- | Run parser
+parseReads :: String -> ReadM a -> [a]
+parseReads = flip evalStateT
+
+-- | Run parser and select first result
+parseRead :: String -> ReadM a -> Maybe a
+parseRead s = listToMaybe . parseReads s

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings, CPP #-}
+
+module HsDev.Tools.Cabal (
+	CabalPackage(..),
+	cabalList
+	) where
+
+import Control.Arrow
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error
+import Data.Aeson
+import Data.Char (isSpace)
+import Data.Maybe
+import Distribution.License
+import Distribution.Text
+import Distribution.Version
+
+import HsDev.Tools.Base
+import HsDev.Util
+
+data CabalPackage = CabalPackage {
+	cabalPackageName :: String,
+	cabalPackageSynopsis :: Maybe String,
+	cabalPackageDefaultVersion :: Maybe Version,
+	cabalPackageInstalledVersions :: [Version],
+	cabalPackageHomepage :: Maybe String,
+	cabalPackageLicense :: Maybe License }
+		deriving (Eq, Read, Show)
+
+instance ToJSON CabalPackage where
+	toJSON cp = object [
+		"name" .= cabalPackageName cp,
+		"synopsis" .= cabalPackageSynopsis cp,
+		"default-version" .= fmap display (cabalPackageDefaultVersion cp),
+		"installed-versions" .= map display (cabalPackageInstalledVersions cp),
+		"homepage" .= cabalPackageHomepage cp,
+		"license" .= fmap display (cabalPackageLicense cp)]
+
+instance FromJSON CabalPackage where
+	parseJSON = withObject "cabal-package" $ \v -> CabalPackage <$>
+		(v .:: "name") <*>
+		(v .:: "synopsis") <*>
+		((join . fmap simpleParse) <$> (v .:: "default-version")) <*>
+		((mapMaybe simpleParse) <$> (v .:: "installed-versions")) <*>
+		(v .:: "homepage") <*>
+		((join . fmap simpleParse) <$> (v .:: "license"))
+
+cabalList :: [String] -> ToolM [CabalPackage]
+cabalList queries = do
+#if mingw32_HOST_OS
+	rs <- liftM (split (all isSpace) . lines) $ tool_ "powershell" [
+		"-Command",
+		unwords (["&", "{", "chcp 65001 | out-null;", "cabal list"] ++ queries ++ ["}"])]
+#else
+	rs <- liftM (split (all isSpace) . lines) $ tool_ "cabal" ("list" : queries)
+#endif
+	return $ map toPackage $ mapMaybe parseFields rs
+	where
+		toPackage :: (String, [(String, String)]) -> CabalPackage
+		toPackage (name, fs) = CabalPackage {
+			cabalPackageName = name,
+			cabalPackageSynopsis = lookup "Synopsis" fs,
+			cabalPackageDefaultVersion = (lookup "Default available version" fs >>= simpleParse),
+			cabalPackageInstalledVersions = fromMaybe [] (lookup "Installed versions" fs >>= mapM (simpleParse . trim) . split (== ',')),
+			cabalPackageHomepage = lookup "Homepage" fs,
+			cabalPackageLicense = lookup "License" fs >>= simpleParse }
+
+		parseFields :: [String] -> Maybe (String, [(String, String)])
+		parseFields [] = Nothing
+		parseFields (('*':name):fs) = Just (trim name, mapMaybe parseField' fs) where
+			parseField' :: String -> Maybe (String, String)
+			parseField' str = case parseField str of
+				(fname, Just fval) -> Just (fname, fval)
+				_ -> Nothing
+		parseFields _ = Nothing
+
+		-- foo: bar → (foo, bar)
+		parseField :: String -> (String, Maybe String)
+		parseField = (trim *** (parseValue . trim . drop 1)) . break (== ':')
+		-- [ ... ] → Nothing, ... → Just ...
+		parseValue :: String -> Maybe String
+		parseValue ('[':_) = Nothing
+		parseValue v = Just v

@@ -0,0 +1,101 @@+module HsDev.Tools.ClearImports (
+	dumpMinimalImports, waitImports, cleanTmpImports,
+	findMinimalImports,
+	groupImports, splitImport,
+	clearImports
+	) where
+
+import Control.Arrow
+import Control.Concurrent (threadDelay)
+import Control.Exception
+import Control.Monad.Error
+import Data.Char
+import Data.List
+import System.Directory
+import System.FilePath
+import qualified Language.Haskell.Exts as Exts
+
+import GHC
+import GHC.Paths (libdir)
+
+-- | Dump minimal imports
+dumpMinimalImports :: [String] -> FilePath -> ErrorT String IO String
+dumpMinimalImports opts f = do
+	cur <- liftIO getCurrentDirectory
+	file <- liftIO $ canonicalizePath f
+
+	m <- liftIO $ Exts.parseFile file
+	mname <- case m of
+		Exts.ParseFailed loc err -> throwError $
+			"Failed to parse file at " ++
+			Exts.prettyPrint loc ++ ":" ++ err
+		Exts.ParseOk (Exts.Module _ (Exts.ModuleName mname) _ _ _ _ _) -> return mname
+
+	ErrorT $ handle onError $ liftM Right $ void $ liftIO $ runGhc (Just libdir) $ do
+		df <- getSessionDynFlags
+		let
+			df' = df {
+				ghcLink = NoLink,
+				hscTarget = HscNothing,
+				dumpDir = Just cur,
+				stubDir = Just cur,
+				objectDir = Just cur,
+				hiDir = Just cur }
+		(df'', _, _) <- parseDynamicFlags df' (map noLoc ("-ddump-minimal-imports" : opts))
+		setSessionDynFlags df''
+		defaultCleanupHandler df'' $ do
+			t <- guessTarget file Nothing
+			setTargets [t]
+			load LoadAllTargets
+
+	length mname `seq` return mname
+	where
+		onError :: SomeException -> IO (Either String ())
+		onError = return . Left . show
+
+-- | Read imports from file
+waitImports :: FilePath -> IO [String]
+waitImports f = retry 1000 $ do
+	is <- liftM lines $ readFile f
+	length is `seq` return is
+
+-- | Clean temporary files
+cleanTmpImports :: FilePath -> IO ()
+cleanTmpImports dir = do
+	dumps <- liftM (map (dir </>) . filter ((== ".imports") . takeExtension)) $ getDirectoryContents dir
+	forM_ dumps $ handle ignoreIO . retry 1000 . removeFile
+	where
+		ignoreIO :: IOException -> IO ()
+		ignoreIO _ = return ()
+
+-- | Dump and read imports
+findMinimalImports :: [String] -> FilePath -> ErrorT String IO [String]
+findMinimalImports opts f = do
+	file <- liftIO $ canonicalizePath f
+	mname <- dumpMinimalImports opts file
+	is <- liftIO $ waitImports (mname <.> "imports")
+	tmp <- liftIO getCurrentDirectory
+	liftIO $ cleanTmpImports tmp
+	return is
+
+-- | Groups several lines related to one import by indents
+groupImports :: [String] -> [[String]]
+groupImports = unfoldr getPack where
+	getPack [] = Nothing
+	getPack (s:ss) = Just $ first (s:) $ break (null . takeWhile isSpace) ss
+
+-- | Split import to import and import-list
+splitImport :: [String] -> (String, String)
+splitImport = splitBraces . unwords . map trim where
+	trim = twice $ reverse . dropWhile isSpace
+	cut = twice $ reverse . drop 1
+	twice f = f . f
+	splitBraces = (trim *** (trim . cut)) . break (== '(')
+
+-- | Returns minimal imports for file specified
+clearImports :: [String] -> FilePath -> ErrorT String IO [(String, String)]
+clearImports opts = liftM (map splitImport . groupImports) . findMinimalImports opts
+
+-- | Retry action on fail
+retry :: (MonadPlus m, MonadIO m) => Int -> m a -> m a
+retry dt act = msum $ act : repeat ((liftIO (threadDelay dt) >>) act)

@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Tools.GhcMod (
+	list,
+	browse, browseInspection,
+	info,
+	TypedRegion(..),
+	typeOf
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.DeepSeq
+import Control.Exception
+import Control.Monad.Error
+import Data.Aeson
+import Data.Char
+import Data.Maybe
+import Data.List (sort, nub)
+import qualified Data.Map as M
+import Exception (ghandle)
+import GHC (Ghc, runGhc, getSessionDynFlags, defaultCleanupHandler)
+import GHC.Paths (libdir)
+import Text.Read (readMaybe)
+import System.Directory (getCurrentDirectory)
+
+import qualified Language.Haskell.GhcMod as GhcMod
+
+import HsDev.Cabal
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Symbols.Location
+import HsDev.Tools.Base
+import HsDev.Util ((.::))
+
+list :: [String] -> Cabal -> ErrorT String IO [ModuleLocation]
+list opts cabal = do
+	cradle <- liftIO $ cradle cabal Nothing
+	ms <- tryGhc $ GhcMod.listMods (GhcMod.defaultOptions { GhcMod.ghcOpts = opts }) cradle
+	return [CabalModule cabal (readMaybe p) m | (m, p) <- ms]
+
+browse :: [String] -> Cabal -> String -> Maybe ModulePackage -> ErrorT String IO InspectedModule
+browse opts cabal mname mpackage = inspect mloc (return $ browseInspection opts) $ do
+	cradle <- liftIO $ cradle cabal Nothing
+	ts <- tryGhc $ GhcMod.browse (GhcMod.defaultOptions { GhcMod.detailed = True, GhcMod.ghcOpts = packageOpt mpackage ++ opts, GhcMod.packageId = mpackagename }) cradle mname
+	return $ Module {
+		moduleName = mname,
+		moduleDocs = Nothing,
+		moduleLocation = mloc,
+		moduleExports = [],
+		moduleImports = [],
+		moduleDeclarations = decls ts }
+	where
+		mpackagename = fmap packageName mpackage
+		mloc = CabalModule cabal mpackage mname
+		decls rs = M.fromList $ map (declarationName &&& id) $ mapMaybe parseDecl rs
+		parseFunction s = do
+			groups <- match "(\\w+)\\s+::\\s+(.*)" s
+			return $ Declaration (groups `at` 1) Nothing Nothing (Function (Just $ groups `at` 2) [])
+		parseType s = do
+			groups <- match "(class|type|data|newtype)\\s+(\\w+)(\\s+(\\w+(\\s+\\w+)*))?" s
+			let
+				args = maybe [] words $ groups 3
+			return $ Declaration (groups `at` 2) Nothing Nothing (declarationTypeCtor (groups `at` 1) $ TypeInfo Nothing args Nothing)
+		parseDecl s = parseFunction s `mplus` parseType s
+
+browseInspection :: [String] -> Inspection
+browseInspection = InspectionAt 0
+
+info :: [String] -> Cabal -> FilePath -> Maybe Project -> String -> String -> ErrorT String IO Declaration
+info opts cabal file mproj mname sname = do
+	cradle <- liftIO $ cradle cabal mproj
+	rs <- tryGhc $ GhcMod.info (GhcMod.defaultOptions { GhcMod.ghcOpts = cabalOpt cabal ++ opts }) cradle file mname sname
+	toDecl rs
+	where
+		toDecl s = maybe (throwError $ "Can't parse info: '" ++ s ++ "'") return $ parseData s `mplus` parseFunction s
+		parseFunction s = do
+			groups <- match (sname ++ "\\s+::\\s+(.*?)(\\s+--(.*))?$") s
+			return $ Declaration sname Nothing Nothing (Function (Just $ groups `at` 1) [])
+		parseData s = do
+			groups <- match "(newtype|type|data)\\s+((.*)=>\\s+)?(\\S+)\\s+((\\w+\\s+)*)=(\\s*(.*)\\s+-- Defined)?" s
+			let
+				args = maybe [] words $ groups 5
+				ctx = fmap trim $ groups 3
+				def = groups 8
+			return $ Declaration sname Nothing Nothing (declarationTypeCtor (groups `at` 1) $ TypeInfo ctx args def)
+		trim = p . p where
+			p = reverse . dropWhile isSpace
+
+data TypedRegion = TypedRegion {
+	typedRegion :: Region,
+	typedExpr :: String,
+	typedType :: String }
+		deriving (Eq, Ord, Read, Show)
+
+instance NFData TypedRegion where
+	rnf (TypedRegion r e t) = rnf r `seq` rnf e `seq` rnf t
+
+instance ToJSON TypedRegion where
+	toJSON (TypedRegion r e t) = object [
+		"region" .= r,
+		"expr" .= e,
+		"type" .= t]
+
+instance FromJSON TypedRegion where
+	parseJSON = withObject "typed region" $ \v -> TypedRegion <$>
+		v .:: "region" <*>
+		v .:: "expr" <*>
+		v .:: "type"
+
+typeOf :: [String] -> Cabal -> FilePath -> Maybe Project -> String -> Int -> Int -> ErrorT String IO [TypedRegion]
+typeOf opts cabal file mproj mname line col = do
+	fileCts <- liftIO $ readFile file
+	cradle <- liftIO $ cradle cabal mproj
+	ts <- fmap lines $ tryGhc $ GhcMod.typeOf (GhcMod.defaultOptions { GhcMod.ghcOpts = cabalOpt cabal ++ opts }) cradle file mname line col
+	return $ mapMaybe (toRegionType fileCts) ts
+	where
+		toRegionType :: String -> String -> Maybe TypedRegion
+		toRegionType fstr s = do
+			(r, tp) <- parseRead s $ (,) <$> parseRegion <*> readParse
+			return $ TypedRegion r (regionStr r fstr) tp
+		parseRegion :: ReadM Region
+		parseRegion = Region <$> parsePosition <*> parsePosition
+		parsePosition :: ReadM Position
+		parsePosition = Position <$> readParse <*> readParse
+
+tryGhc :: Ghc a -> ErrorT String IO a
+tryGhc act = ErrorT $ ghandle rethrow $ liftM Right $ runGhc (Just libdir) $ do
+	dflags <- getSessionDynFlags
+	defaultCleanupHandler dflags act
+	where
+		rethrow :: SomeException -> IO (Either String a)
+		rethrow = return . Left . show
+
+cradle :: Cabal -> Maybe Project -> IO GhcMod.Cradle
+cradle cabal Nothing = do
+	dir <- getCurrentDirectory
+	return $ GhcMod.Cradle dir dir Nothing (sandbox cabal) []
+cradle cabal (Just proj) = do
+	dir <- getCurrentDirectory
+	return $ GhcMod.Cradle
+		dir
+		(projectPath proj)
+		(Just $ projectCabal proj)
+		(sandbox cabal)
+		(zip deps (repeat Nothing))
+	where
+		deps = fromMaybe [] $ do
+			desc <- projectDescription proj
+			return $ nub $ sort $ concatMap infoDepends $ concat [
+					map buildInfo (maybeToList (projectLibrary desc)),
+					map buildInfo (projectExecutables desc),
+					map buildInfo (projectTests desc)]

@@ -0,0 +1,43 @@+module HsDev.Tools.GhcMod.InferType (
+	untyped, inferType, inferTypes
+	) where
+
+import Control.Monad.Error
+import Data.Traversable (traverse)
+
+import HsDev.Cabal
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Tools.GhcMod
+
+-- | Is declaration untyped
+untyped :: DeclarationInfo -> Bool
+untyped (Function Nothing _) = True
+untyped _ = False
+
+-- | Infer type of declaration
+inferType :: [String] -> Cabal -> FilePath -> Maybe Project -> String -> Declaration -> ErrorT String IO Declaration
+inferType opts cabal src mproj mname decl
+	| untyped (declaration decl) = infer
+	| otherwise = return decl
+	where
+		infer = do
+			inferred <- liftM declaration $ info opts cabal src mproj mname (declarationName decl)
+			return decl {
+				declaration = setType (declaration decl) (getType inferred) }
+
+		setType :: DeclarationInfo -> Maybe String -> DeclarationInfo
+		setType (Function _ ds) newType = Function newType ds
+		setType info _ = info
+
+		getType :: DeclarationInfo -> Maybe String
+		getType (Function fType _) = fType
+		getType _ = Nothing
+
+-- | Infer types for module
+inferTypes :: [String] -> Cabal -> Module -> ErrorT String IO Module
+inferTypes opts cabal m = case moduleLocation m of
+	FileModule src p -> do
+		inferredDecls <- traverse (inferType opts cabal src p (moduleName m)) $ moduleDeclarations m
+		return m { moduleDeclarations = inferredDecls }
+	_ -> throwError "Type infer works only for source files"

@@ -0,0 +1,50 @@+module HsDev.Tools.HDocs (
+	hdocs, hdocsCabal,
+	setDocs,
+	loadDocs,
+
+	hdocsProcess
+	) where
+
+import Control.Exception
+import Control.Monad ()
+import Control.Monad.Error
+
+import Data.Aeson (decode)
+import qualified Data.ByteString.Lazy.Char8 as L (pack)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe ()
+import System.Process (readProcess)
+
+import qualified HDocs.Module as HDocs
+import qualified HDocs.Haddock as HDocs ()
+
+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
+
+-- | Get all docs
+hdocsCabal :: Cabal -> [String] -> ErrorT String IO (Map String (Map String String))
+hdocsCabal cabal opts = liftM (M.map HDocs.formatDocs) $ HDocs.installedDocs (cabalOpt cabal ++ opts)
+
+-- | Set docs for module
+setDocs :: Map String String -> Module -> Module
+setDocs d m = m { moduleDeclarations = M.mapWithKey setDoc $ moduleDeclarations m } where
+	setDoc name decl = decl { declarationDocs = M.lookup name d }
+
+-- | Load docs for module
+loadDocs :: [String] -> Module -> IO Module
+loadDocs opts m = do
+	d <- hdocs (moduleName m) opts
+	return $ setDocs d m
+
+hdocsProcess :: String -> [String] -> IO (Maybe (Map String String))
+hdocsProcess mname opts = handle onErr $ liftM (decode . L.pack) $ readProcess "hdocs" opts' "" where
+	opts' = mname : concat [["-g", opt] | opt <- opts]
+	onErr :: SomeException -> IO (Maybe a)
+	onErr _ = return Nothing

@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Tools.Hayoo (
+	-- * Types
+	HayooResult(..), HayooFunction(..), HayooCompletion(..), HayooName(..),
+	hayooAsDeclaration,
+	-- * Search help online
+	hayoo,
+	-- * Utils
+	untagDescription
+	) where
+
+import Control.Arrow
+import Control.Applicative
+import Control.Monad.Error
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Encoding as T
+import Network.HTTP
+import Text.RegexPR (gsubRegexPR)
+
+import HsDev.Symbols
+import HsDev.Symbols.Documented
+import HsDev.Util
+
+-- | Hayoo response
+data HayooResult = HayooResult {
+	hayooMessage :: String,
+	hayooHits :: Int,
+	hayooFunctions :: [HayooFunction],
+	hayooCompletions :: [HayooCompletion],
+	hayooModules :: [HayooName],
+	hayooPackages :: [HayooName] }
+		deriving (Eq, Ord, Read, Show)
+
+instance FromJSON HayooResult where
+	parseJSON = withObject "hayoo response" $ \v -> HayooResult <$>
+		(v .:: "message") <*>
+		(v .:: "hits") <*>
+		(v .:: "functions") <*>
+		(v .:: "completions") <*>
+		(v .:: "modules") <*>
+		(v .:: "packages")
+
+-- | Hayoo function information
+data HayooFunction = HayooFunction {
+	hayooName :: String,
+	hayooSignature :: String,
+	hayooModule :: String,
+	hayooPackage :: String,
+	hayooHackage :: String,
+	hayooDescription :: String }
+		deriving (Eq, Ord, Read, Show)
+
+instance Symbol HayooFunction where
+	symbolName = hayooName
+	symbolQualifiedName f = hayooModule f ++ "." ++ hayooName f
+	symbolDocs = Just . hayooDescription
+	symbolLocation r = Location (OtherModuleSource $ Just $ hayooHackage r) Nothing where
+
+instance Documented HayooFunction where
+	brief f
+		| hayooSignature f `elem` ["type", "newtype", "data", "class"] =
+			hayooSignature f ++ " " ++ hayooName f
+		| otherwise = hayooName f ++ " :: " ++ hayooSignature f
+	detailed f = unlines $ defaultDetailed f ++ online where
+		online = [
+			"", "Hayoo online documentation", "",
+			"Package: " ++ hayooPackage f,
+			"Hackage URL: " ++ hayooHackage f]
+
+instance FromJSON HayooFunction where
+	parseJSON = withObject "function" $ \v -> HayooFunction <$>
+		(v .:: "name") <*>
+		(v .:: "signature") <*>
+		(v .:: "module") <*>
+		(v .:: "package") <*>
+		(v .:: "uri") <*>
+		(v .:: "description")
+
+-- | Hayoo completions
+data HayooCompletion = HayooCompletion {
+	completionWord :: String,
+	completionCount :: Int }
+		deriving (Eq, Ord, Read, Show)
+
+instance FromJSON HayooCompletion where
+	parseJSON = withObject "completion" $ \v -> HayooCompletion <$>
+		(v .:: "word") <*>
+		(v .:: "count")
+
+-- | Hayoo name
+data HayooName = HayooName {
+	nameName :: String,
+	nameCount :: Int }
+		deriving (Eq, Ord, Read, Show)
+
+instance FromJSON HayooName where
+	parseJSON = withObject "name" $ \v -> HayooName <$>
+		(v .:: "name") <*>
+		(v .:: "count")
+
+-- | 'HayooFunction' as 'Declaration'
+hayooAsDeclaration :: HayooFunction -> ModuleDeclaration
+hayooAsDeclaration f = ModuleDeclaration {
+	declarationModuleId = ModuleId {
+		moduleIdName = hayooModule f,
+		moduleIdLocation = OtherModuleSource (Just $ hayooHackage f) },
+	moduleDeclaration = Declaration {
+		declarationName = hayooName f,
+		declarationDocs = Just (addOnline $ untagDescription $ hayooDescription f),
+		declarationPosition = Nothing,
+		declaration = declInfo } }
+	where
+		-- Add other info
+		addOnline d = unlines $ [
+			d, "",
+			"Hayoo online documentation",
+			"",
+			"Package: " ++ hayooPackage f,
+			"Hackage URL: " ++ hayooHackage f]
+
+		declInfo
+			| hayooSignature f `elem` ["type", "newtype", "data", "class"]
+				= declarationTypeCtor (hayooSignature f) $ TypeInfo Nothing [] Nothing
+			| otherwise = Function (Just $ hayooSignature f) []
+
+-- | Search hayoo
+hayoo :: String -> ErrorT String IO HayooResult
+hayoo q = do
+	resp <- ErrorT $ fmap (show +++ rspBody) $ simpleHTTP (getRequest $ "http://holumbus.fh-wedel.de/hayoo/hayoo.json?query=" ++ urlEncode q)
+	ErrorT $ return $ eitherDecode $ L.pack resp
+
+-- | Remove tags in description
+untagDescription :: String -> String
+untagDescription = gsubRegexPR "</?\\w+[^>]*>" ""

@@ -0,0 +1,110 @@+module HsDev.Util (
+	directoryContents,
+	traverseDirectory,
+	isParent,
+	haskellSource,
+	cabalFile,
+	-- * String utils
+	tab, tabs, trim, split,
+	-- * Helper
+	(.::),
+	-- * Exceptions
+	liftException, liftExceptionM, liftIOErrors,
+	-- * UTF-8
+	fromUtf8, toUtf8
+	) where
+
+import Control.Arrow (second)
+import Control.Exception
+import Control.Monad
+import Control.Monad.Error
+import qualified Control.Monad.CatchIO as C
+import Data.Aeson
+import Data.Aeson.Types (Parser)
+import Data.Char (isSpace)
+import Data.List (isPrefixOf, unfoldr)
+import qualified Data.HashMap.Strict as HM (HashMap, toList)
+import Data.ByteString.Lazy (ByteString)
+import Data.Text (Text)
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Encoding as T
+import System.Directory
+import System.FilePath
+
+-- | Get directory contents safely
+directoryContents :: FilePath -> IO [FilePath]
+directoryContents p = handle ignore $ do
+	b <- doesDirectoryExist p
+	if b
+		then liftM (map (p </>) . filter (`notElem` [".", ".."])) (getDirectoryContents p)
+		else return []
+	where
+		ignore :: SomeException -> IO [FilePath]
+		ignore _ = return []
+
+-- | Collect all file names in directory recursively
+traverseDirectory :: FilePath -> IO [FilePath]
+traverseDirectory path = handle onError $ do
+	cts <- directoryContents path
+	liftM concat $ forM cts $ \c -> do
+		isDir <- doesDirectoryExist c
+		if isDir
+			then traverseDirectory c
+			else return [c]
+	where
+		onError :: IOException -> IO [FilePath]
+		onError _ = return []
+
+-- | Is one path parent of another
+isParent :: FilePath -> FilePath -> Bool
+isParent dir file = norm dir `isPrefixOf` norm file where
+	norm = splitDirectories . normalise
+
+-- | Is haskell source?
+haskellSource :: FilePath -> Bool
+haskellSource f = takeExtension f `elem` [".hs", ".lhs"]
+
+-- | Is cabal file?
+cabalFile :: FilePath -> Bool
+cabalFile f = takeExtension f == ".cabal"
+
+-- | Add N tabs to line
+tab :: Int -> String -> String
+tab n s = replicate n '\t' ++ s
+
+-- | Add N tabs to multiline
+tabs :: Int -> String -> String
+tabs n = unlines . map (tab n) . lines
+
+-- | Trim string
+trim :: String -> String
+trim = p . p where
+	p = reverse . dropWhile isSpace
+
+-- | Split list
+split :: (a -> Bool) -> [a] -> [[a]]
+split p = takeWhile (not . null) . unfoldr (Just . second (drop 1) . break p)
+
+-- | Workaround, sometimes we get HM.lookup "foo" v == Nothing, but lookup "foo" (HM.toList v) == Just smth
+(.::) :: FromJSON a => HM.HashMap Text Value -> Text -> Parser a
+v .:: name = maybe (fail $ "key " ++ show name ++ " not present") parseJSON $ lookup name $ HM.toList v
+
+-- | Lift IO exception to ErrorT
+liftException :: C.MonadCatchIO m => m a -> ErrorT String m a
+liftException act = ErrorT $ C.catch (liftM Right act) onError where
+	onError = return . Left . (show :: SomeException -> String)
+
+-- | Lift IO exception to MonadError
+liftExceptionM :: (C.MonadCatchIO m, Error e, MonadError e m) => m a -> m a
+liftExceptionM act = C.catch act onError where
+	onError = throwError . strMsg . (show :: SomeException -> String)
+
+-- | Lift IO exceptions to ErrorT
+liftIOErrors :: C.MonadCatchIO m => ErrorT String m a -> ErrorT String m a
+liftIOErrors act = liftException (runErrorT act) >>= either throwError return
+
+fromUtf8 :: ByteString -> String
+fromUtf8 = T.unpack . T.decodeUtf8
+
+toUtf8 :: String -> ByteString
+toUtf8 = T.encodeUtf8 . T.pack

@@ -0,0 +1,193 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances, GeneralizedNewtypeDeriving #-}
+
+module System.Win32.PowerShell (
+	-- * Run PowerShell
+	ps,
+	-- * PowerShell functions
+	startProcess, codepage, outNull,
+	-- * PowerShell monad
+	PS(..), seqPS, emit, emit_, (=:), invoke,
+	-- * Expression
+	Args(..), CmdLet(..), Expr(..), compile,
+	raw, name, lit, var, bra, (.=), flag, named, call, cmdlet, invoke, lambda, (.|), foreach, filter,
+	-- * Convertible
+	ToPS(..),
+	-- * Escape functions
+	translate, translateArg
+	) where
+
+import Prelude hiding (filter)
+
+import Control.Applicative (Applicative(..))
+import Control.Monad
+import Control.Monad.Writer
+import Data.Char (isAlphaNum)
+import Data.List (intercalate)
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import HsDev.Tools.Base (ToolM, tool_)
+
+ps :: PS a -> ToolM String
+ps script = tool_ "powershell" ["-Command", compile $ seqPS script]
+
+-- start-process
+startProcess :: String -> [String] -> CmdLet
+startProcess n as = cmdlet "start-process" [name n, lit $ intercalate ", " (map translateArg as)] [named "WindowStyle" $ lit "Hidden"]
+
+-- chcp
+codepage :: Int -> CmdLet
+codepage n = cmdlet "chcp" [lit n] []
+
+-- out-null
+outNull :: CmdLet
+outNull = cmdlet "out-null" [] []
+
+newtype PS a = PS { unPS :: Writer [Expr] a }
+	deriving (Applicative, Functor, Monad, MonadWriter [Expr])
+
+seqPS :: PS a -> Expr
+seqPS (PS act) = case execWriter act of
+	[] -> error "No expressions"
+	es -> foldr1 Sequence es
+
+emit :: Expr -> PS Expr
+emit e = PS $ tell [e] >> return e
+
+emit_ :: Expr -> PS ()
+emit_ = void . emit
+
+infixr 6 =:
+(=:) :: String -> Expr -> PS Expr
+name =: expr = emit_ (name .= expr) >> return (var name)
+
+-- | Invoke cmdlet
+invoke :: CmdLet -> PS ()
+invoke = emit_ . Invoke
+
+-- | Positional and named args
+data Args = Args [Expr] (Map String (Maybe Expr))
+
+instance Monoid Args where
+	mempty = Args [] M.empty
+	mappend (Args lp ln) (Args rp rn) = Args (lp ++ rp) (M.union ln rn)
+
+-- | Call to cmdlet
+data CmdLet = CmdLet {
+	cmdLet :: Expr,
+	cmdArgs :: Args }
+
+-- | Expression
+data Expr =
+	Emit String |
+	-- ^ native expression
+	Literal String |
+	-- ^ literal
+	Var String |
+	-- ^ $name
+	Bracket Expr |
+	-- ^ (expr)
+	Assign [String] [Expr] |
+	-- ^ $x, $y, ... = expr1, expr2, ...
+	Invoke CmdLet |
+	-- ^ cmd args... named...
+	Lambda [String] ([Expr] -> Expr) |
+	-- ^ { param($...); expr }
+	Sequence Expr Expr |
+	-- ^ expr1; expr2
+	Pipe Expr CmdLet
+	-- ^ expr | cmd
+
+compile :: Expr -> String
+compile (Emit s) = s
+compile (Literal l) = l
+compile (Var v) = '$':v
+compile (Bracket e) = "(" ++ compile e ++ ")"
+compile (Assign vs es) = intercalate ", " (map ('$':) vs) ++ " = " ++ intercalate ", " (map (compile . bra) es)
+compile (Invoke (CmdLet e (Args ps ns))) = unwords [invoke', ps', ns'] where
+	invoke' = case e of
+		Var n -> n
+		_ -> unwords ["&", compile $ bra e]
+	ps' = intercalate " " $ map (compile . bra) ps
+	ns' = intercalate " " $ concatMap named' $ M.toList ns where
+		named' :: (String, Maybe Expr) -> [String]
+		named' (n, Just v) = [n, compile $ bra v]
+		named' (n, Nothing) = [n]
+-- { param($File); $args[0]; }
+compile (Lambda ns body) = unwords ["{", param', body', "}"] where
+	param' = "param(" ++ intercalate "," ns ++ ");"
+	body' = compile $ body (map var ns)
+compile (Sequence l r) = compile l ++ "; " ++ compile r
+compile (Pipe e c) = compile e ++ " | " ++ compile (Invoke c)
+
+raw :: String -> Expr
+raw = Emit
+
+name :: String -> Expr
+name = Literal
+
+lit :: ToPS a => a -> Expr
+lit = Literal . toPS
+
+var :: String -> Expr
+var = Var
+
+bra :: Expr -> Expr
+bra = Bracket
+
+infixr 6 .= 
+(.=) :: String -> Expr -> Expr
+v .= e = Assign [v] [e]
+
+flag :: String -> (String, Maybe Expr)
+flag n = (n, Nothing)
+
+named :: String -> Expr -> (String, Maybe Expr)
+named n e = (n, Just e)
+
+call :: Expr -> [Expr] -> [(String, Maybe Expr)] -> CmdLet
+call f pos named = CmdLet f $ Args pos (M.fromList named)
+
+cmdlet :: String -> [Expr] -> [(String, Maybe Expr)] -> CmdLet
+cmdlet n pos = call (name n) pos
+
+lambda :: [String] -> ([Expr] -> Expr) -> Expr
+lambda = Lambda
+
+infixr 6 .|
+(.|) :: Expr -> CmdLet -> Expr
+e .| c = Pipe e c
+
+foreach :: (Expr -> Expr) -> CmdLet
+foreach f = cmdlet "%" [f $ var "_"] []
+
+filter :: (Expr -> Expr) -> CmdLet
+filter p = cmdlet "?" [p $ var "_"] []
+
+class ToPS a where
+	toPS :: a -> String
+
+instance ToPS Int where
+	toPS = show
+
+instance ToPS String where
+	toPS = translate
+
+instance ToPS Bool where
+	toPS True = "$true"
+	toPS False = "$false"
+
+instance ToPS a => ToPS [a] where
+	toPS = intercalate ", " . map toPS
+
+translate :: String -> String
+translate str = '"' : snd (foldr escape (True, "\"") str) where
+	escape '"' (b, str) = (True, '\\' : '"' : str)
+	escape '\\' (True, str) = (True, '\\' : '\\' : str)
+	escape '\\' (False, str) = (False, '\\' : str)
+	escape c (b, str) = (False, c : str)
+
+translateArg :: String -> String
+translateArg str
+	| all isAlphaNum str = str
+	| otherwise = "'" ++ translate str ++ "'"

@@ -0,0 +1,6 @@+module Main (
+	main
+	) where
+
+main :: IO ()
+main = return ()

@@ -0,0 +1,981 @@+{-# LANGUAGE OverloadedStrings, CPP #-}
+
+module Commands (
+	mainCommands, commands
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Control.Monad.Error
+import Control.Monad.Trans.Maybe
+import Control.Exception
+import Control.Concurrent
+import Data.Aeson
+import Data.Aeson.Encode.Pretty
+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.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.Timeout
+import System.FilePath
+import Text.Read (readMaybe)
+
+import qualified HsDev.Database.Async as DB
+import HsDev.Commands
+import HsDev.Database
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Symbols.Util
+import HsDev.Util
+import HsDev.Scan
+import qualified HsDev.Tools.Cabal as Cabal
+import qualified HsDev.Tools.GhcMod as GhcMod (typeOf)
+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 System.Command
+
+#if mingw32_HOST_OS
+import System.Win32.FileMapping.Memory (withMapFile, readMapFile)
+import System.Win32.FileMapping.NamePool
+#else
+import System.Posix.Process
+import System.Posix.IO
+#endif
+
+import qualified Update
+import Types
+
+#if mingw32_HOST_OS
+
+translate :: String -> String
+translate str = '"' : snd (foldr escape (True,"\"") str) where
+	escape '"'  (b, str) = (True,  '\\' : '"'  : str)
+	escape '\\' (True, str) = (True,  '\\' : '\\' : str)
+	escape '\\' (False, str) = (False, '\\' : str)
+	escape c (b, str) = (False, c : str)
+
+powershell :: String -> String
+powershell str
+	| all isAlphaNum str = str
+	| otherwise = "'" ++ translate str ++ "'"
+
+#endif
+
+-- | Main commands
+mainCommands :: [Command (IO ())]
+mainCommands = addHelp "hsdev" id $ srvCmds ++ map wrapCmd commands where
+	wrapCmd :: Command CommandAction -> Command (IO ())
+	wrapCmd = fmap sendCmd . addClientOpts . fmap withOptsArgs
+	srvCmds = [
+		cmd_ ["run"] [] "run interactive" runi',
+		cmd ["server", "start"] [] "start remote server" serverOpts start',
+		cmd ["server", "run"] [] "start server" serverOpts run',
+		cmd ["server", "stop"] [] "stop remote server" clientOpts stop']
+
+	runi' _ = do
+		dir <- getCurrentDirectory
+		db <- DB.newAsync
+		forever $ do
+			s <- getLine
+			processCmd (CommandOptions db (const $ return ()) (const $ return Nothing) dir putStrLn getLine (error "Not supported") exitSuccess) 1000 s (L.putStrLn . encode)
+	start' sopts _ = do
+#if mingw32_HOST_OS
+		let
+			args = ["server", "run"] ++ serverOptsToArgs sopts
+		myExe <- getExecutablePath
+		r <- readProcess "powershell" [
+			"-Command",
+			unwords [
+				"&", "{", "start-process",
+				powershell myExe,
+				intercalate ", " (map powershell args),
+				"-WindowStyle Hidden",
+				"}"]] ""
+		if all isSpace r
+			then putStrLn $ "Server started at port " ++ show (fromJust $ getFirst $ serverPort sopts)
+			else putStrLn $ "Failed to start server: " ++ r
+#else
+		let
+			forkError :: SomeException -> IO ()
+			forkError e  = putStrLn $ "Failed to start server: " ++ show e
+
+			proxy :: IO ()
+			proxy = do
+				createSession
+				forkProcess serverAction
+				exitImmediately ExitSuccess
+
+			serverAction :: IO ()
+			serverAction = do
+				mapM_ closeFd [stdInput, stdOutput, stdError]
+				nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags
+				mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError]
+				closeFd nullFd
+				run' sopts []
+
+		handle forkError $ do
+			forkProcess proxy
+			putStrLn $ "Server started at port " ++ show (fromJust $ getFirst $ serverPort sopts)
+#endif
+	run' sopts _ = do
+		msgs <- F.newChan
+		outputDone <- newEmptyMVar
+		forkIO $ finally
+			(F.readChan msgs >>= mapM_ (logMsg sopts))
+			(putMVar outputDone ())
+
+		let
+			outputStr = F.putChan msgs
+			waitOutput = F.closeChan msgs >> takeMVar outputDone
+			withCache :: a -> (FilePath -> IO a) -> IO a
+			withCache v onCache = case getFirst (serverCache sopts) of
+				Nothing -> return v
+				Just cdir -> onCache cdir
+			writeCache :: Database -> IO ()
+			writeCache d = withCache () $ \cdir -> do
+				outputStr "writing cache"
+				SC.dump cdir (structurize d)
+			readCache :: (FilePath -> ErrorT String IO Structured) -> IO (Maybe Database)
+			readCache act = withCache Nothing $ join . liftM (either cacheErr cacheOk) . runErrorT . act where
+				cacheErr e = outputStr ("Unable read cache: " ++ e) >> return Nothing
+				cacheOk s = do
+					forM_ (M.keys (structuredCabals s)) $ \c -> outputStr ("cache read: cabal " ++ show c)
+					forM_ (M.keys (structuredProjects s)) $ \p -> outputStr ("cache read: project " ++ p)
+					case allModules (structuredFiles s) of
+						[] -> return ()
+						ms -> outputStr $ "cache read: " ++ show (length ms) ++ " files"
+					return $ Just $ merge s
+
+		outputStr $ "Server started at port " ++ show (fromJust $ getFirst $ serverPort sopts)
+
+		logIO "server exception: " outputStr $ flip finally waitOutput $ do
+			db <- DB.newAsync
+
+			when (getAny $ serverLoadCache sopts) $ withCache () $ \cdir -> do
+				outputStr $ "Loading cache from " ++ cdir
+				dbCache <- liftA merge <$> SC.load cdir
+				case dbCache of
+					Left err -> outputStr $ "Failed to load cache: " ++ err
+					Right dbCache' -> DB.update db (return dbCache')
+
+			waitListen <- newEmptyMVar
+			clientChan <- F.newChan
+
+			linkChan <- F.newChan
+			let
+				linkToSrv :: IO ()
+				linkToSrv = do
+					v <- newEmptyMVar
+					F.putChan linkChan (putMVar v ())
+					takeMVar v
+
+#if mingw32_HOST_OS
+			mmapPool <- createPool "hsdev"
+			let
+				-- | Send response as is or via memory mapped file
+				sendResponse :: Handle -> Response -> IO ()
+				sendResponse h r@(ResponseMapFile _) = L.hPutStrLn h $ encode r
+				sendResponse h r
+					| L.length msg <= 1024 = L.hPutStrLn h msg
+					| otherwise = do
+						sync <- newEmptyMVar
+						forkIO $ void $ withName mmapPool $ \mmapName -> do
+							runErrorT $ flip catchError
+								(\e -> liftIO $ do
+									sendResponse h $ Response $ object ["error" .= e]
+									putMVar sync ())
+								(withMapFile mmapName (L.toStrict msg) $ liftIO $ do
+									sendResponse h $ ResponseMapFile mmapName
+									putMVar sync ()
+									-- Dirty: give 10 seconds for client to read it
+									threadDelay 10000000)
+						takeMVar sync
+					where
+						msg = encode r
+#else
+			let
+				sendResponse h = L.hPutStrLn h . encode
+#endif
+
+			forkIO $ do
+				accepter <- myThreadId
+
+				let
+					serverStop = void $ forkIO $ do
+						void $ tryPutMVar waitListen ()
+						killThread accepter
+
+				s <- socket AF_INET Stream defaultProtocol
+				bind s (SockAddrInet (fromIntegral $ fromJust $ getFirst $ serverPort sopts) iNADDR_ANY)
+				listen s maxListenQueue
+				forever $ logIO "accept client exception: " outputStr $ do
+					s' <- fmap fst $ accept s
+					outputStr $ show s' ++ " connected"
+					void $ forkIO $ logIO (show s' ++ " exception: ") outputStr $
+						bracket (socketToHandle s' ReadWriteMode) hClose $ \h -> do
+							bracket newEmptyMVar (`putMVar` ()) $ \done -> do
+								me <- myThreadId
+								let
+									timeoutWait = do
+										notDone <- isEmptyMVar done
+										when notDone $ do
+											void $ forkIO $ do
+												threadDelay 10000000
+												tryPutMVar done ()
+												killThread me
+											void $ takeMVar done
+								F.putChan clientChan timeoutWait
+								req <- hGetLine' h
+								outputStr $ show s' ++ ": " ++ fromUtf8 req
+								case fmap extractCurrentDir $ eitherDecode req of
+									Left reqErr -> sendResponse h $ Response $ object [
+										"error" .= ("Invalid request" :: String),
+										"request" .= fromUtf8 req,
+										"what" .= reqErr]
+									Right (clientDir, reqArgs) -> processCmdArgs
+										(CommandOptions
+											db
+											writeCache
+											readCache
+											clientDir
+											outputStr
+											(fromUtf8 <$> hGetLine' h)
+											linkToSrv
+											serverStop)
+										(fromJust $ getFirst $ serverTimeout sopts) reqArgs (sendResponse h)
+								-- Send 'end' message and wait client
+								L.hPutStrLn h L.empty
+								outputStr $ "waiting " ++ show s'
+								ignoreIO $ void $ timeout 10000000 $ hGetLine' h
+								outputStr $ show s' ++ " disconnected"
+
+			takeMVar waitListen
+			withCache () $ \cdir -> do
+				outputStr $ "saving cache to " ++ cdir
+				logIO "cache saving exception: " outputStr $ do
+					dbval <- DB.readAsync db
+					SC.dump cdir $ structurize dbval
+				outputStr "cache saved"
+			outputStr "closing links"
+			F.stopChan linkChan >>= sequence_
+			outputStr "waiting for clients"
+			F.stopChan clientChan >>= sequence_
+			outputStr "server shutdown"
+	stop' copts _ = run (map wrapCmd' commands) onDef onError ["exit"] where
+		onDef = putStrLn "Command 'exit' not found"
+		onError es = putStrLn $ "Failed to stop server: " ++ intercalate ", " es
+		wrapCmd' = fmap (sendCmd . fmap ((,) copts) . withOptsArgs)
+
+	logIO :: String -> (String -> IO ()) -> IO () -> IO ()
+	logIO pre out act = handle onIO act where
+		onIO :: IOException -> IO ()
+		onIO e = out $ pre ++ show e
+
+	ignoreIO :: IO () -> IO ()
+	ignoreIO = handle (const (return ()) :: IOException -> IO ())
+
+	logMsg :: ServerOpts -> String -> IO ()
+	logMsg sopts s = ignoreIO $ do
+		putStrLn s
+		case getFirst (serverLog sopts) of
+			Nothing -> return ()
+			Just f -> withFile f AppendMode (`hPutStrLn` s)
+
+	-- Send command to server
+	sendCmd :: IO (ClientOpts, [String]) -> IO ()
+	sendCmd get' = do
+		svar <- newEmptyMVar
+		race [takeMVar svar, waitResponse >> putMVar svar ()]
+		where
+			waitResponse = do
+				curDir <- getCurrentDirectory
+				(p, as) <- get'
+				stdinData <- if getAny (clientData p)
+					then do
+						cdata <- liftM eitherDecode L.getContents
+						case cdata of
+							Left cdataErr -> do
+								putStrLn $ "Invalid data: " ++ cdataErr
+								exitFailure
+							Right dataValue -> return $ Just dataValue
+					else return Nothing
+
+				s <- socket AF_INET Stream defaultProtocol
+				addr' <- inet_addr "127.0.0.1"
+				connect s (SockAddrInet (fromIntegral $ fromJust $ getFirst $ clientPort p) addr')
+				h <- socketToHandle s ReadWriteMode
+				L.hPutStrLn h $ encode $ ["--current-directory=" ++ curDir] ++ setData stdinData as
+				responses <- liftM (takeWhile (not . L.null) . L.lines) $ L.hGetContents h
+				forM_ responses $
+					parseResponse >=>
+					(L.putStrLn . encodeValue (getAny $ clientPretty p))
+
+			setData :: Maybe ResultValue -> [String] -> [String]
+			setData Nothing = id
+			setData (Just d) = (++ ["--data=" ++ (fromUtf8 $ encode d)])
+
+			parseResponse r = fmap (either err' id) $ runErrorT $ do
+				v <- errT (eitherDecode r) `orFail` (\e -> "Can't decode response")
+				case v of
+					Response rv -> return rv
+					ResponseStatus sv -> return sv
+#if mingw32_HOST_OS
+					ResponseMapFile viewFile -> do
+						str <- fmap L.fromStrict (readMapFile viewFile) `orFail`
+							(\e -> "Can't read map view of file")
+						lift $ parseResponse str
+#else
+					ResponseMapFile viewFile -> return $ err' ("Not supported" :: String)
+#endif
+				where
+					errT act = ErrorT $ return act
+					orFail act msg = act `catchError` (throwError . msg)
+					err' msg = object ["error" .= msg]
+
+			encodeValue True = encodePretty
+			encodeValue False = encode
+
+	-- Add parsing 'ClieptOpts'
+	addClientOpts :: Command (IO [String]) -> Command (IO (ClientOpts, [String]))
+	addClientOpts c = c { commandRun = run' } where
+		run' args = fmap (fmap (fmap $ (,) p)) $ commandRun c args' where
+			(ps, args', _) = getOpt RequireOrder clientOpts args
+			p = mconcat ps `mappend` defaultConfig
+
+	extractCurrentDir :: [String] -> (FilePath, [String])
+	extractCurrentDir as = (head $ cur ++ ["."], as') where
+		(cur, as', _) = getOpt RequireOrder curDirOpts as
+		curDirOpts = [Option [] ["current-directory"] (ReqArg id "path") "current directory"]
+
+commands :: [Command CommandAction]
+commands = map wrapErrors $ map (fmap (fmap timeout')) cmds ++ map (fmap (fmap noTimeout)) linkCmd where
+	timeout' :: (CommandOptions -> IO CommandResult) -> (Int -> CommandOptions -> IO CommandResult)
+	timeout' f tm copts = fmap (fromMaybe $ err "timeout") $ timeout (tm * 1000) $ f copts
+	noTimeout :: (CommandOptions -> IO CommandResult) -> (Int -> CommandOptions -> IO CommandResult)
+	noTimeout f _ copts = f copts
+
+	handleErrors :: (Int -> CommandOptions -> IO CommandResult) -> (Int -> CommandOptions -> IO CommandResult)
+	handleErrors act tm copts = handle onCmdErr (act tm copts) where
+		onCmdErr :: SomeException -> IO CommandResult
+		onCmdErr = return . err . show
+
+	wrapErrors :: Command CommandAction -> Command CommandAction
+	wrapErrors = fmap (fmap handleErrors)
+
+	cmds = [
+		-- Ping command
+		cmd_' ["ping"] [] "ping server" ping',
+		-- Database commands
+		cmd' ["add"] [] "add info to database" [dataArg] add',
+		cmd' ["scan", "cabal"] [] "scan modules installed in cabal" [
+			sandbox, ghcOpts, wait, status] scanCabal',
+		cmd' ["scan", "module"] ["module name"] "scan module in cabal" [sandbox, ghcOpts] scanModule',
+		cmd' ["scan"] [] "scan sources" [
+			projectArg "project path or .cabal",
+			fileArg "source file",
+			pathArg "directory to scan for files and projects",
+			ghcOpts, wait, status] scan',
+		cmd' ["rescan"] [] "rescan sources" [
+			projectArg "project path or .cabal",
+			fileArg "source file",
+			pathArg "path to rescan",
+			ghcOpts, wait, status] rescan',
+		cmd' ["remove"] [] "remove modules info" [
+			sandbox,
+			projectArg "module project",
+			fileArg "module source file",
+			moduleArg,
+			packageArg, noLastArg, packageVersionArg,
+			allFlag] remove',
+		-- | Context free commands
+		cmd' ["list", "modules"] [] "list modules" [
+			projectArg "project to list modules from",
+			noLastArg,
+			packageArg,
+			sandbox, sourced, standaloned] listModules',
+		cmd_' ["list", "packages"] [] "list packages" listPackages',
+		cmd_' ["list", "projects"] [] "list projects" listProjects',
+		cmd' ["symbol"] ["name"] "get symbol info" (matches ++ [
+			projectArg "related project",
+			fileArg "source file",
+			moduleArg, localsArg,
+			packageArg, noLastArg, packageVersionArg,
+			sandbox, sourced, standaloned]) symbol',
+		cmd' ["module"] [] "get module info" [
+			moduleArg, localsArg,
+			packageArg, noLastArg, packageVersionArg,
+			projectArg "module project",
+			fileArg "module source file",
+			sandbox, sourced] modul',
+		cmd' ["project"] [] "get project info" [
+			projectArg "project path or name"] project',
+		-- Context commands
+		cmd' ["lookup"] ["symbol"] "lookup for symbol" ctx lookup',
+		cmd' ["whois"] ["symbol"] "get info for symbol" ctx whois',
+		cmd' ["scope", "modules"] [] "get modules accessible from module or within a project" ctx scopeModules',
+		cmd' ["scope"] [] "get declarations accessible from module or within a project" (ctx ++ matches ++ [globalArg]) scope',
+		cmd' ["complete"] ["input"] "show completions for input" ctx complete',
+		-- Tool commands
+		cmd' ["hayoo"] ["query"] "find declarations online via Hayoo" [] hayoo',
+		cmd' ["cabal", "list"] ["packages..."] "list cabal packages" [] cabalList',
+		cmd' ["ghc-mod", "type"] ["line", "column"] "infer type with 'ghc-mod type'" ctx ghcmodType',
+		-- Dump/load commands
+		cmd' ["dump", "cabal"] [] "dump cabal modules" [sandbox, cacheDir, cacheFile] dumpCabal',
+		cmd' ["dump", "projects"] [] "dump projects" [projectArg "project", cacheDir, cacheFile] dumpProjects',
+		cmd' ["dump", "files"] [] "dump standalone files" [cacheDir, cacheFile] dumpFiles',
+		cmd' ["dump"] [] "dump whole database" [cacheDir, cacheFile] dump',
+		cmd' ["load"] [] "load data" [cacheDir, cacheFile, dataArg, wait] load',
+		-- Exit
+		cmd_' ["exit"] [] "exit" exit']
+	linkCmd = [cmd' ["link"] [] "link to server" [] link']
+
+	-- Command arguments and flags
+	allFlag = option_ ['a'] "all" flag "remove all"
+	cacheDir = pathArg "cache path"
+	cacheFile = fileArg "cache file"
+	ctx = [fileArg "source file", sandbox]
+	dataArg = option_ [] "data" (req "contents") "data to pass to command"
+	fileArg = option_ ['f'] "file" (req "file")
+	findArg = option_ [] "find" (req "find") "infix match"
+	ghcOpts = option_ ['g'] "ghc" (req "ghc options") "options to pass to GHC"
+	globalArg = option_ [] "global" flag "scope of project"
+	localsArg = option_ ['l'] "locals" flag "look in local declarations"
+	noLastArg = option_ [] "no-last" flag "don't select last package version"
+	matches = [prefixArg, findArg]
+	moduleArg = option_ ['m'] "module" (req "module name") "module name"
+	packageArg = option_ [] "package" (req "package") "module package"
+	pathArg = option_ ['p'] "path" (req "path")
+	prefixArg = option_ [] "prefix" (req "prefix") "prefix match"
+	projectArg = option [] "project" ["proj"] (req "project")
+	packageVersionArg = option_ ['v'] "version" (req "version") "package version"
+	sandbox = option_ [] "sandbox" (noreq "path") "path to cabal sandbox"
+	sourced = option_ [] "src" flag "source files"
+	standaloned = option_ [] "stand" flag "standalone files"
+	status = option_ ['s'] "status" flag "show status of operation, works only with --wait"
+	wait = option_ ['w'] "wait" flag "wait for operation to complete"
+
+	-- ping server
+	ping' _ copts = return $ ResultOk $ ResultString "pong"
+	-- add data
+	add' as _ copts = do
+		dbval <- getDb copts
+		res <- runErrorT $ do
+			jsonData <- maybe (throwError $ err "Specify --data") return $ askOpt "data" as
+			decodedData <- either
+				(\err -> throwError (errArgs "Unable to decode data" [
+					("why", ResultString err),
+					("data", ResultString jsonData)]))
+				return $
+				eitherDecode $ toUtf8 jsonData
+			let
+				updateData (ResultDeclaration d) = throwError $ errArgs "Can't insert declaration" [("declaration", ResultDeclaration d)]
+				updateData (ResultModuleDeclaration md) = do
+					let
+						ModuleId mname mloc = declarationModuleId md
+						defMod = Module mname Nothing mloc [] mempty mempty
+						defInspMod = Inspected InspectionNone mloc (Right defMod)
+						dbmod = maybe
+							defInspMod
+							(\i -> i { inspectionResult = inspectionResult i <|> (Right defMod) }) $
+							M.lookup mloc (databaseModules dbval)
+						updatedMod = dbmod {
+							inspectionResult = fmap (addDeclaration $ moduleDeclaration md) (inspectionResult dbmod) }
+					DB.update (dbVar copts) $ return $ fromModule updatedMod
+				updateData (ResultModuleId (ModuleId mname mloc)) = when (M.notMember mloc $ databaseModules dbval) $
+					DB.update (dbVar copts) $ return $ fromModule $ Inspected InspectionNone mloc (Right $ Module mname Nothing mloc [] mempty mempty)
+				updateData (ResultModule m) = DB.update (dbVar copts) $ return $ fromModule $ Inspected InspectionNone (moduleLocation m) (Right m)
+				updateData (ResultInspectedModule m) = DB.update (dbVar copts) $ return $ fromModule m
+				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) = throwError $ err "Can't insert string"
+				updateData ResultNone = return ()
+			updateData decodedData
+		return $ either id (const (ResultOk ResultNone)) res
+	-- scan
+	scan' as _ copts = updateProcess copts as $
+		mapM_ (\(n, f) -> forM_ (askOpts n as) (canonicalizePath' copts >=> f (getGhcOpts as))) [
+			("project", Update.scanProject),
+			("file", Update.scanFile),
+			("path", Update.scanDirectory)]
+	-- scan cabal
+	scanCabal' as _ copts = error_ $ do
+		cabal <- getCabal copts as
+		lift $ updateProcess copts as $ Update.scanCabal (getGhcOpts as) cabal
+	-- scan cabal module
+	scanModule' as [] copts = return $ err "Module name not specified"
+	scanModule' as ms copts = error_ $ do
+		cabal <- getCabal copts as
+		lift $ updateProcess copts as $
+			forM_ ms (Update.scanModule (getGhcOpts as) . CabalModule cabal Nothing)
+	-- rescan
+	rescan' as _ copts = do
+		dbval <- getDb copts
+		let
+			fileMap = M.fromList $ mapMaybe toPair $
+				selectModules (byFile . moduleId) dbval
+
+		(errors, filteredMods) <- liftM partitionEithers $ mapM runErrorT $ concat [
+			do
+				p <- askOpts "project" as
+				return $ do
+					p' <- getProject copts p
+					return $ M.fromList $ mapMaybe toPair $
+						selectModules (inProject p' . moduleId) dbval,
+			do
+				f <- askOpts "file" as
+				return $ maybe
+					(throwError $ "Unknown file: " ++ f)
+					(return . M.singleton f)
+					(lookupFile f dbval),
+			do
+				d <- askOpts "path" as
+				return $ return $ M.filterWithKey (\f _ -> isParent d f) fileMap]
+		let
+			rescanMods = map (getInspected dbval) $
+				M.elems $ if null filteredMods then fileMap else M.unions filteredMods
+
+		if not (null errors)
+			then return $ err $ intercalate ", " errors
+			else updateProcess copts as $ Update.runTask (toJSON $ ("rescanning modules" :: String)) $ do
+				needRescan <- Update.liftErrorT $ filterM (changedModule dbval (getGhcOpts as) . inspectedId) rescanMods
+				Update.scanModules (getGhcOpts as) (map (inspectedId &&& inspectionOpts . inspection) needRescan)
+	-- remove
+	remove' as _ copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		cabal <- askCabal copts as
+		proj <- askProject copts as
+		file <- traverse (canonicalizePath' copts) $ askOpt "file" as
+		let
+			cleanAll = hasOpt "all" as
+			filters = catMaybes [
+				fmap inProject proj,
+				fmap inFile file,
+				fmap inModule (askOpt "module" as),
+				fmap inPackage (askOpt "package" as),
+				fmap inVersion (askOpt "version" as),
+				fmap inCabal cabal]
+			toClean = newest as $ filter (allOf filters . moduleId) (allModules dbval)
+			action
+				| null filters && cleanAll = liftIO $ do
+					DB.modifyAsync (dbVar copts) DB.Clear
+					return ResultNone
+				| null filters && not cleanAll = throwError "Specify filter or explicitely set flag --all"
+				| cleanAll = throwError "--all flag can't be set with filters"
+				| otherwise = liftIO $ do
+					DB.modifyAsync (dbVar copts) $ DB.Remove $ mconcat $ map (fromModule . getInspected dbval) toClean
+					return $ ResultList $ map (ResultModuleId . moduleId) toClean
+		action
+	-- list modules
+	listModules' as _ copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		proj <- askProject copts as
+		cabal <- askCabal copts as
+		let
+			filters = allOf $ catMaybes [
+				fmap inProject proj,
+				fmap inPackage (askOpt "package" as),
+				fmap inCabal cabal,
+				if hasOpt "src" as then Just byFile else Nothing,
+				if hasOpt "stand" as then Just standalone else Nothing]
+		return $ ResultList $ map (ResultModuleId . moduleId) $ newest as $ selectModules (filters . moduleId) dbval
+	-- list packages
+	listPackages' _ copts = do
+		dbval <- getDb copts
+		return $ ResultOk $ ResultList $
+			map ResultPackage $ nub $ sort $
+			mapMaybe (moduleCabalPackage . moduleLocation) $
+			allModules dbval
+	-- list projects
+	listProjects' _ copts = do
+		dbval <- getDb copts
+		return $ ResultOk $ ResultList $ map ResultProject $ M.elems $ databaseProjects dbval
+	-- get symbol info
+	symbol' as ns copts = errorT $ do
+		dbval <- liftM (localsDatabase as) $ liftIO $ getDb copts
+		proj <- askProject copts as
+		file <- traverse (canonicalizePath' copts) $ askOpt "file" as
+		cabal <- askCabal copts as
+		let
+			filters = checkModule $ allOf $ catMaybes [
+				fmap inProject proj,
+				fmap inFile file,
+				fmap inModule (askOpt "module" as),
+				fmap inPackage (askOpt "package" as),
+				fmap inVersion (askOpt "version" as),
+				fmap inCabal cabal,
+				if hasOpt "src" as then Just byFile else Nothing,
+				if hasOpt "stand" as then Just standalone else Nothing]
+			toResult = ResultList . map ResultModuleDeclaration . newest as . filterMatch as . filter filters
+		case ns of
+			[] -> return $ toResult $ allDeclarations dbval
+			[nm] -> liftM toResult (findDeclaration dbval nm) `catchError` (\e ->
+				throwError ("Can't find symbol: " ++ e))
+			_ -> throwError "Too much arguments"
+	-- get module info
+	modul' as _ copts = errorT' $ do
+		dbval <- liftM (localsDatabase as) $ liftIO $ getDb copts
+		proj <- mapErrorT (fmap $ strMsg +++ id) $ askProject copts as
+		cabal <- mapErrorT (fmap $ strMsg +++ id) $ askCabal copts as
+		file' <- traverse (canonicalizePath' copts) $ askOpt "file" as
+		let
+			filters = allOf $ catMaybes [
+				fmap inProject proj,
+				fmap inCabal cabal,
+				fmap inFile file',
+				fmap inModule (askOpt "module" as),
+				fmap inPackage (askOpt "package" as),
+				fmap inVersion (askOpt "version" as),
+				if hasOpt "src" as then Just byFile else Nothing]
+		rs <- mapErrorT (fmap $ strMsg +++ id) $
+			(newest as . filter (filters . moduleId)) <$> maybe
+				(return $ allModules dbval)
+				(findModule dbval)
+				(askOpt "module" as)
+		case rs of
+			[] -> throwError $ err "Module not found"
+			[m] -> return $ ResultModule m
+			ms' -> throwError $ errArgs "Ambiguous modules" [("modules", ResultList $ map (ResultModuleId . moduleId) ms')]
+	-- get project info
+	project' as _ copts = errorT $ do
+		proj <- askProject copts as
+		proj' <- maybe (throwError "Specify project name of .cabal file") return proj
+		return $ ResultProject proj'
+	-- lookup info about symbol
+	lookup' as [nm] copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		liftM (ResultList . map ResultModuleDeclaration) $ lookupSymbol dbval cabal srcFile nm
+	lookup' as _ copts = return $ err "Invalid arguments"
+	-- get detailed info about symbol in source file
+	whois' as [nm] copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		liftM (ResultList . map ResultModuleDeclaration) $ whois dbval cabal srcFile nm
+	whois' as _ copts = return $ err "Invalid arguments"
+	-- get modules accessible from module
+	scopeModules' as [] copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		liftM (ResultList . map (ResultModuleId . moduleId)) $ scopeModules dbval cabal srcFile
+	scopeModules' as _ copts = return $ err "Invalid arguments"
+	-- get declarations accessible from module
+	scope' as [] copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		liftM (ResultList . map ResultModuleDeclaration . filterMatch as) $ scope dbval cabal srcFile (hasOpt "global" as)
+	scope' as _ copts = return $ err "Invalid arguments"
+	-- completion
+	complete' as [] copts = complete' as [""] copts
+	complete' as [input] copts = errorT $ do
+		dbval <- getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		liftM (ResultList . map ResultModuleDeclaration) $ completions dbval cabal srcFile input
+	complete' as _ copts = return $ err "Invalid arguments"
+	-- hayoo
+	hayoo' as [] copts = return $ err "Query not specified"
+	hayoo' as [query] copts = errorT $
+		liftM
+			(ResultList . map (ResultModuleDeclaration . Hayoo.hayooAsDeclaration) . Hayoo.hayooFunctions) $
+			Hayoo.hayoo query
+	hayoo' as _ copts = return $ err "Too much arguments"
+	-- cabal list
+	cabalList' as qs copts = errorT $ do
+		ps <- Cabal.cabalList qs
+		return $ ResultList $ map (ResultJSON . toJSON) ps
+	-- ghc-mod type
+	ghcmodType' as [line] copts = ghcmodType' as [line, "1"] copts
+	ghcmodType' as [line, column] copts = errorT $ do
+		line' <- maybe (throwError "line must be a number") return $ readMaybe line
+		column' <- maybe (throwError "column must be a number") return $ readMaybe column
+		dbval <- liftIO $ getDb copts
+		(srcFile, cabal) <- askCtx copts as
+		(srcFile', m, mproj) <- fileCtx dbval srcFile
+		tr <- GhcMod.typeOf (getGhcOpts as) cabal srcFile' mproj (moduleName m) line' column'
+		return $ ResultList $ map ResultTyped tr
+	ghcmodType' as [] copts = return $ err "Specify line"
+	ghcmodType' as _ copts = return $ err "Too much arguments"
+	-- dump cabal modules
+	dumpCabal' as _ copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		cabal <- getCabal copts as
+		let
+			dat = cabalDB cabal dbval
+		liftM (fromMaybe (ResultDatabase dat)) $ runMaybeT $ msum [
+			maybeOpt "path" as $ canonicalizePath' copts >=> \p ->
+				fork (dump (p </> cabalCache cabal) dat),
+			maybeOpt "file" as $ canonicalizePath' copts >=> \f ->
+				fork (dump f dat)]
+	-- dump projects
+	dumpProjects' as [] copts = errorT $ do
+		dbval <- liftIO $ getDb copts
+		ps' <- traverse (getProject copts) $ askOpts "project" as
+		let
+			ps = if null ps' then M.elems (databaseProjects dbval) else ps'
+			dats = map (id &&& flip projectDB dbval) ps
+		liftM (fromMaybe (ResultList $ map (ResultDatabase . snd) dats)) $
+			runMaybeT $ msum [
+				maybeOpt "path" as $ canonicalizePath' copts >=> \p ->
+					fork (forM_ dats $ \(proj, dat) -> (dump (p </> projectCache proj) dat)),
+				maybeOpt "file" as $ canonicalizePath' copts >=> \f ->
+					fork (dump f (mconcat $ map snd dats))]
+	dumpProjects' as _ copts = return $ err "Invalid arguments"
+	-- dump files
+	dumpFiles' as [] copts = do
+		dbval <- getDb copts
+		let
+			dat = standaloneDB dbval
+		liftM (ResultOk . fromMaybe (ResultDatabase dat)) $ runMaybeT $ msum [
+			maybeOpt "path" as $ canonicalizePath' copts >=> \p ->
+				fork (dump (p </> standaloneCache) dat),
+			maybeOpt "file" as $ canonicalizePath' copts >=> \f ->
+				fork (dump f dat)]
+	dumpFiles' as _ copts = return $ err "Invalid arguments"
+	-- dump database
+	dump' as _ copts = do
+		dbval <- getDb copts
+		liftM (fromMaybe (ResultOk $ ResultDatabase dbval)) $ runMaybeT $ msum [
+			do
+				p <- MaybeT $ traverse (canonicalizePath' copts) $ askOpt "path" as
+				fork $ SC.dump p $ structurize dbval
+				return ok,
+			do
+				f <- MaybeT $ traverse (canonicalizePath' copts) $ askOpt "file" as
+				fork $ dump f dbval
+				return ok]
+	-- load database
+	load' as _ copts = do
+		res <- liftM (fromMaybe (err "Specify one of: --path, --file or --data")) $ runMaybeT $ msum [
+			do
+				p <- MaybeT $ return $ askOpt "path" as
+				forkOrWait as $ cacheLoad copts (liftA merge <$> SC.load p)
+				return ok,
+			do
+				f <- MaybeT $ return $ askOpt "file" as
+				e <- liftIO $ doesFileExist f
+				forkOrWait as $ when e $ cacheLoad copts (load f)
+				return ok,
+			do
+				dat <- MaybeT $ return $ askOpt "data" as
+				forkOrWait as $ cacheLoad copts (return $ eitherDecode (toUtf8 dat))
+				return ok]
+		waitDb copts as
+		return res
+	-- link to server
+	link' as _ copts = do
+		race [void (commandWaitInput copts) `finally` commandExit copts, commandLink copts]
+		return ok
+	-- exit
+	exit' _ copts = do
+		commandExit copts
+		return ok
+
+	-- Helper functions
+	cmd' :: [String] -> [String] -> String -> [OptDescr Opts] -> (Opts -> [String] -> a) -> Command (WithOpts a)
+	cmd' name posArgs descr as act = cmd name posArgs descr as act' where
+		act' os args = WithOpts (act os args) $
+			return $ name ++ args ++ optsToArgs os
+
+	cmd_' :: [String] -> [String] -> String -> ([String] -> a) -> Command (WithOpts a)
+	cmd_' name posArgs descr act = cmd_ name posArgs descr act' where
+		act' args = WithOpts (act args) $
+			return $ name ++ args ++ optsToArgs defaultConfig
+
+	getGhcOpts = askOpts "ghc"
+
+	toPair :: Module -> Maybe (FilePath, Module)
+	toPair m = case moduleLocation m of
+		FileModule f _ -> Just (f, m)
+		_ -> Nothing
+
+	modCabal :: Module -> Maybe Cabal
+	modCabal m = case moduleLocation m of
+		CabalModule c _ _ -> Just c
+		_ -> Nothing
+
+	waitDb copts as = when (hasOpt "wait" as) $ do
+		commandLog copts "wait for db"
+		DB.wait (dbVar copts)
+		commandLog copts "db done"
+
+	forkOrWait as act
+		| hasOpt "wait" as = liftIO act
+		| otherwise = liftIO $ void $ forkIO act
+
+	cacheLoad copts act = do
+		db' <- act
+		case db' of
+			Left e -> commandLog copts e
+			Right database -> DB.update (dbVar copts) (return database)
+
+	asCabal :: CommandOptions -> Maybe FilePath -> ErrorT String IO Cabal
+	asCabal copts = maybe
+		(return Cabal)
+		(canonicalizePath' copts >=> locateSandbox)
+
+	askCabal :: CommandOptions -> Opts -> ErrorT String IO (Maybe Cabal)
+	askCabal copts as = traverse (asCabal copts) $ askOptDef "sandbox" as
+
+	getCabal :: CommandOptions -> Opts -> ErrorT String IO Cabal
+	getCabal copts as = asCabal copts $ askOpt "sandbox" as
+
+	getProject :: CommandOptions -> String -> ErrorT String IO Project
+	getProject copts proj = do
+		db' <- getDb copts
+		proj' <- liftM addCabal $ canonicalizePath' copts proj
+		let
+			result =
+				M.lookup proj' (databaseProjects db') <|>
+				find ((== proj) . projectName) (M.elems $ databaseProjects db')
+		maybe (throwError $ "Project " ++ proj ++ " not found") return result
+		where
+			addCabal p
+				| takeExtension p == ".cabal" = p
+				| otherwise = p </> (takeBaseName p <.> "cabal")
+
+	localsDatabase :: Opts -> Database -> Database
+	localsDatabase as
+		| hasOpt "locals" as = databaseLocals
+		| otherwise = id
+
+	newest :: Symbol a => Opts -> [a] -> [a]
+	newest as
+		| hasOpt "no-last" as = id
+		| otherwise = newestPackage
+
+	askProject :: CommandOptions -> Opts -> ErrorT String IO (Maybe Project)
+	askProject copts = traverse (getProject copts) . askOpt "project"
+
+	askFile :: CommandOptions -> Opts -> ErrorT String IO (Maybe FilePath)
+	askFile copts = traverse (canonicalizePath' copts) . askOpt "file"
+
+	forceJust :: String -> ErrorT String IO (Maybe a) -> ErrorT String IO a
+	forceJust msg act = act >>= maybe (throwError msg) return
+
+	askCtx :: CommandOptions -> Opts -> ErrorT String IO (FilePath, Cabal)
+	askCtx copts as = liftM2 (,)
+		(forceJust "No file specified" $ askFile copts as)
+		(getCabal copts as)
+
+	getDb :: (MonadIO m) => CommandOptions -> m Database
+	getDb = liftIO . DB.readAsync . commandDatabase
+
+	dbVar :: CommandOptions -> DB.Async Database
+	dbVar = commandDatabase
+
+	canonicalizePath' :: MonadIO m => CommandOptions -> FilePath -> m FilePath
+	canonicalizePath' copts f = liftIO $ canonicalizePath (normalise f') where
+		f'
+			| isRelative f = commandRoot copts </> f
+			| otherwise = f
+
+	startProcess :: Opts -> ((Value -> IO ()) -> IO ()) -> IO CommandResult
+	startProcess as f
+		| hasOpt "wait" as = return $ ResultProcess (f . onMsg)
+		| otherwise = forkIO (f $ const $ return ()) >> return ok
+		where
+			onMsg showMsg
+				| hasOpt "status" as = showMsg
+				| otherwise = const $ return ()
+
+	error_ :: ErrorT String IO CommandResult -> IO CommandResult
+	error_ = liftM (either err id) . runErrorT
+
+	errorT :: ErrorT String IO ResultValue -> IO CommandResult
+	errorT = liftM (either err ResultOk) . runErrorT
+
+	errorT' :: ErrorT CommandResult IO ResultValue -> IO CommandResult
+	errorT' = liftM (either id ResultOk) . runErrorT
+
+	updateProcess :: CommandOptions -> Opts -> ErrorT String (Update.UpdateDB IO) () -> IO CommandResult
+	updateProcess opts as act = startProcess as $ \onStatus -> Update.updateDB (Update.Settings (commandDatabase opts) (commandReadCache opts) onStatus (getGhcOpts as)) act
+
+	fork :: MonadIO m => IO () -> m ()
+	fork = voidm . liftIO . forkIO
+
+	voidm :: Monad m => m a -> m ()
+	voidm act = act >> return ()
+
+	maybeOpt :: Monad m => String -> Opts -> (String -> MaybeT m a) -> MaybeT m ResultValue
+	maybeOpt n as act = do
+		p <- MaybeT $ return $ askOpt n as
+		act p
+		return ResultNone
+
+	filterMatch :: Opts -> [ModuleDeclaration] -> [ModuleDeclaration]
+	filterMatch as = findMatch as . prefMatch as
+
+	findMatch :: Opts -> [ModuleDeclaration] -> [ModuleDeclaration]
+	findMatch as = case askOpt "find" as of
+		Nothing -> id
+		Just str -> filter (match' str)
+		where
+			match' str m = str `isInfixOf` declarationName (moduleDeclaration m)
+
+	prefMatch :: Opts -> [ModuleDeclaration] -> [ModuleDeclaration]
+	prefMatch as = case fmap splitIdentifier (askOpt "prefix" as) of
+		Nothing -> id
+		Just (qname, pref) -> filter (match' qname pref)
+		where
+			match' qname pref m =
+				pref `isPrefixOf` declarationName (moduleDeclaration m) &&
+				maybe True (== moduleIdName (declarationModuleId m)) qname
+
+processCmd :: CommandOptions -> Int -> String -> (Response -> IO ()) -> IO ()
+processCmd copts tm cmdLine sendResponse = processCmdArgs copts tm (splitArgs cmdLine) sendResponse
+
+-- | Process command, returns 'False' if exit requested
+processCmdArgs :: CommandOptions -> Int -> [String] -> (Response -> IO ()) -> IO ()
+processCmdArgs copts tm cmdArgs sendResponse = run (map (fmap withOptsAct) commands) (asCmd unknownCommand) (asCmd . commandError) cmdArgs tm copts >>= sendResponses where
+	asCmd :: CommandResult -> (Int -> CommandOptions -> IO CommandResult)
+	asCmd r _ _ = return r
+
+	unknownCommand :: CommandResult
+	unknownCommand = err "Unknown command"
+	commandError :: [String] -> CommandResult
+	commandError errs = errArgs "Command syntax error" [("what", ResultList $ map ResultString errs)]
+
+	sendResponses :: CommandResult -> IO ()
+	sendResponses (ResultOk v) = sendResponse $ Response $ toJSON v
+	sendResponses (ResultError e args) = sendResponse $ Response $ object [
+		"error" .= e,
+		"details" .= args]
+	sendResponses (ResultProcess act) = do
+		act (sendResponse . ResponseStatus)
+		sendResponses ok
+		`catch`
+		processFailed
+		where
+			processFailed :: SomeException -> IO ()
+			processFailed e = sendResponses $ errArgs "process throws exception" [
+				("exception", ResultString $ show e)]
+
+hGetLine' :: Handle -> IO ByteString
+hGetLine' = fmap L.fromStrict . B.hGetLine
+
+race :: [IO ()] -> IO ()
+race acts = do
+	v <- newEmptyMVar
+	forM_ acts $ \a -> forkIO ((a `finally` putMVar v ()) `catch` ignoreError)
+	takeMVar v
+	where
+		ignoreError :: SomeException -> IO ()
+		ignoreError _ = return ()

@@ -0,0 +1,38 @@+module Control.Concurrent.FiniteChan (
+	Chan,
+	newChan, dupChan, putChan, getChan, readChan, closeChan, stopChan
+	) where
+
+import qualified Control.Concurrent.Chan as C
+import Data.Maybe
+
+-- | 'Chan' is stoppable channel unline 'Control.Concurrent.Chan'
+newtype Chan a = Chan (C.Chan (Maybe a))
+
+-- | Create channel
+newChan :: IO (Chan a)
+newChan = fmap Chan C.newChan
+
+-- | Duplicate channel
+dupChan :: Chan a -> IO (Chan a)
+dupChan (Chan ch) = fmap Chan $ C.dupChan ch
+
+-- | Write data to channel
+putChan :: Chan a -> a -> IO ()
+putChan (Chan ch) = C.writeChan ch . Just
+
+-- | Get data from channel
+getChan :: Chan a -> IO (Maybe a)
+getChan (Chan ch) = C.readChan ch
+
+-- | Read channel contents
+readChan :: Chan a -> IO [a]
+readChan (Chan ch) = fmap (catMaybes . takeWhile isJust) $ C.getChanContents ch
+
+-- | Close channel. 'putChan' will still work, but no data will be available on other ending
+closeChan :: Chan a -> IO ()
+closeChan (Chan ch) = C.writeChan ch Nothing
+
+-- | Stop channel and return all data
+stopChan :: Chan a -> IO [a]
+stopChan ch = closeChan ch >> readChan ch

@@ -0,0 +1,209 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, DefaultSignatures, FlexibleInstances #-}
+
+module System.Command (
+	Command(..),
+	DefaultConfig(..),
+	cmd, cmd_,
+	Help(..), addHelpCommand, addHelp,
+	brief, help,
+	run, runCmd,
+	Opts(..),
+	mapOpts, traverseOpts,
+	option, option_, req, noreq, flag,
+	opt, optMaybe, hasOpt, askOpt, askOptDef, askOpts,
+	optsToArgs,
+	splitArgs, unsplitArgs
+	) where
+
+import Control.Arrow
+import Control.Applicative
+import Control.Monad (join)
+import Data.Char
+import Data.List (stripPrefix, unfoldr, isPrefixOf)
+import Data.Maybe (fromMaybe, mapMaybe, listToMaybe, maybeToList)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Monoid
+import Data.Traversable (traverse)
+import System.Console.GetOpt
+
+-- | Command
+data Command a = Command {
+	commandName :: [String],
+	commandPosArgs :: [String],
+	commandDesc :: Maybe String,
+	commandUsage :: [String],
+	commandRun :: [String] -> Maybe (Either [String] a) }
+
+instance Functor Command where
+	fmap f cmd' = cmd' {
+		commandRun = fmap (fmap f) . commandRun cmd' }
+
+-- | Default value for options
+class DefaultConfig a where
+	defaultConfig :: a
+	default defaultConfig :: Monoid a => a
+	defaultConfig = mempty
+
+instance DefaultConfig ()
+instance DefaultConfig [String]
+
+-- | Make command
+-- >cmd name args desc args' onCmd
+cmd :: (Monoid c, DefaultConfig c) => [String] -> [String] -> String -> [OptDescr c] -> (c -> [String] -> a) -> Command a
+cmd name posArgs descr as act = Command {
+	commandName = name,
+	commandPosArgs = posArgs,
+	commandDesc = descr',
+	commandUsage = lines $ usageInfo (unwords (name ++ map (\a -> "[" ++ a ++ "]") posArgs) ++ maybe "" (" -- " ++) descr') as,
+	commandRun = \opts -> case getOpt Permute as opts of
+		(opts', cs, errs) -> fmap (\cs' -> if null errs then return (act (mconcat opts' `mappend` defaultConfig) cs') else Left errs) (stripPrefix name cs) }
+	where
+		descr' = if null descr then Nothing else Just descr
+
+-- | Make command without params
+cmd_ :: [String] -> [String] -> String -> ([String] -> a) -> Command a
+cmd_ name posArgs descr act = cmd name posArgs descr [] (act' act) where
+	act' :: a -> () -> a
+	act' = const
+
+data Help =
+	HelpUsage [String] |
+	HelpCommands [([String], [String])]
+		deriving (Eq, Ord, Read, Show)
+
+-- | Add help command
+addHelpCommand :: String -> (Either String Help -> a) -> [Command a] -> [Command a]
+addHelpCommand tool toCmd cmds = cmds' where
+	cmds' = helpcmd' : cmds
+	helpcmd = fmap toCmd $ cmd_ ["help"] ["command"] ("help command, also can be called in form '" ++ tool ++ " [command] -?'") onHelp
+	-- allow help by last argument '-?'
+	helpcmd' = helpcmd { commandRun = commandRun helpcmd . rewrite } where
+		rewrite as
+			| last as == "-?" = "help" : init as
+			| otherwise = as
+	onHelp [] = Right $ HelpUsage [tool ++ " " ++ brief c | c <- cmds']
+	onHelp cmdname = case filter ((cmdname `isPrefixOf`) . commandName) cmds' of
+		[] -> Left $ "Unknown command: " ++ unwords cmdname
+		helps -> Right $ HelpCommands $ map (commandName &&& (addHeader . help)) helps
+	addHeader [] = []
+	addHeader (h:hs) = (tool ++ " " ++ h) : hs
+
+-- | Add help commands, which outputs help to stdout
+addHelp :: String -> (IO () -> a) -> [Command a] -> [Command a]
+addHelp tool liftPrint cmds = addHelpCommand tool toCmd cmds where
+	toCmd = liftPrint . either putStrLn printHelp
+	printHelp :: Help -> IO ()
+	printHelp (HelpUsage u) = mapM_ putStrLn $ map ('\t':) u
+	printHelp (HelpCommands cs) = mapM_ putStrLn $ map ('\t':) $ concatMap snd cs
+
+-- | Show brief help for command
+brief :: Command a -> String
+brief = head . commandUsage
+
+-- | Show detailed help for command
+help :: Command a -> [String]
+help = commandUsage
+
+-- | Run commands
+run :: [Command a] -> a -> ([String] -> a) -> [String] -> a
+run cmds onDef onError as = maybe onDef (either onError id) found where
+	found = listToMaybe $ mapMaybe (`commandRun` as) cmds
+
+-- | Try run command, wrapping any negative result to 'Maybe'
+runCmd :: Command a -> [String] -> Maybe a
+runCmd cmd = join . fmap toMaybe . commandRun cmd where
+	toMaybe :: Either b c -> Maybe c
+	toMaybe = either (const Nothing) Just
+
+-- | Options holder
+newtype Opts = Opts { getOpts :: Map String [String] }
+
+instance Monoid Opts where
+	mempty = Opts mempty
+	(Opts l) `mappend` (Opts r) = Opts $ M.unionWith (++) l r
+
+instance DefaultConfig Opts
+
+-- | Map 'Opts'
+mapOpts :: (String -> String) -> Opts -> Opts
+mapOpts f = Opts . M.mapKeys f . getOpts
+
+-- | Traverse 'Opts'
+traverseOpts :: Applicative f => (String -> String -> f String) -> Opts -> f Opts
+traverseOpts f = fmap Opts . M.traverseWithKey (traverse . f) . getOpts
+
+option :: [Char] -> String -> [String] -> (String -> ArgDescr Opts) -> String -> OptDescr Opts
+option fs name names onOption d = Option fs (name:names) (onOption name) d
+
+option_ :: [Char] -> String -> (String -> ArgDescr Opts) -> String -> OptDescr Opts
+option_ fs name = option fs name []
+
+-- | Required option
+req :: String -> String -> ArgDescr Opts
+req nm n = ReqArg (opt n) nm
+
+-- | Optional option
+noreq :: String -> String -> ArgDescr Opts
+noreq nm n = OptArg (optMaybe n) nm
+
+-- | Flag option
+flag :: String -> ArgDescr Opts
+flag n = NoArg flag' where
+	flag' :: Opts
+	flag' = Opts $ M.singleton n []
+
+opt :: String -> String -> Opts
+opt n v = Opts $ M.singleton n [v]
+
+optMaybe :: String -> Maybe String -> Opts
+optMaybe n = Opts . M.singleton n . maybeToList
+
+hasOpt :: String -> Opts -> Bool
+hasOpt n = M.member n . getOpts
+
+askOpt :: String -> Opts -> Maybe String
+askOpt n = listToMaybe . askOpts n
+
+askOptDef :: String -> Opts -> Maybe (Maybe String)
+askOptDef n = fmap listToMaybe . M.lookup n . getOpts
+
+askOpts :: String -> Opts -> [String]
+askOpts n = fromMaybe [] . M.lookup n . getOpts
+
+-- | Print 'Opts' as args
+optsToArgs :: Opts -> [String]
+optsToArgs = concatMap optToArgs . M.toList . getOpts where
+	optToArgs :: (String, [String]) -> [String]
+	optToArgs (n, []) = ["--" ++ n]
+	optToArgs (n, vs) = ["--"++ n ++ "=" ++ v | v <- vs]
+
+-- | Split string to words
+splitArgs :: String -> [String]
+splitArgs "" = []
+splitArgs (c:cs)
+	| isSpace c = splitArgs cs
+	| c == '"' = let (w, cs') = readQuote cs in w : splitArgs cs'
+	| otherwise = let (ws, tl) = break isSpace cs in (c:ws) : splitArgs tl
+	where
+		readQuote :: String -> (String, String)
+		readQuote "" = ("", "")
+		readQuote ('\\':ss)
+			| null ss = ("\\", "")
+			| otherwise = first (head ss :) $ readQuote (tail ss)
+		readQuote ('"':ss) = ("", ss)
+		readQuote (s:ss) = first (s:) $ readQuote ss
+
+unsplitArgs :: [String] -> String
+unsplitArgs = unwords . map escape where
+	escape :: String -> String
+	escape str
+		| any isSpace str || '"' `elem` str = "\"" ++ concat (unfoldr escape' str) ++ "\""
+		| otherwise = str
+	escape' :: String -> Maybe (String, String)
+	escape' [] = Nothing
+	escape' (ch:tl) = Just (escaped, tl) where
+		escaped = case ch of
+			'"' -> "\\\""
+			'\\' -> "\\\\"
+			_ -> [ch]

@@ -0,0 +1,58 @@+module System.Win32.FileMapping.Memory (
+	createMap, openMap, mapFile,
+	withMapFile, readMapFile
+	) where
+
+import Control.Monad.CatchIO (bracket)
+import Control.Monad.Cont
+import Control.Monad.Error
+import Data.ByteString.Char8
+import qualified Data.ByteString.Char8 as BS
+import Foreign.C.String
+import Foreign.Ptr
+import System.Win32.File (closeHandle)
+import System.Win32.FileMapping hiding (mapFile)
+import System.Win32.Types
+import System.Win32.Mem
+
+createMap :: Maybe HANDLE -> ProtectFlags -> DDWORD -> Maybe String -> ContT r (ErrorT String IO) HANDLE
+createMap mh pf sz mn = ContT $ bracket
+	(verify iNVALID_HANDLE_VALUE "Invalid handle" $
+		liftIO (createFileMapping mh pf sz mn))
+	(liftIO . closeHandle)
+
+openMap :: FileMapAccess -> Bool -> Maybe String -> ContT r (ErrorT String IO) HANDLE
+openMap f i mn = ContT $ bracket
+	(verify iNVALID_HANDLE_VALUE "Invalid handle" $
+		liftIO (openFileMapping f i mn))
+	(liftIO . closeHandle)
+
+mapFile :: HANDLE -> FileMapAccess -> DDWORD -> SIZE_T -> ErrorT String IO (Ptr a)
+mapFile h f off sz = verify nullPtr "null pointer" $ liftIO (mapViewOfFile h f off sz) 
+
+-- | Write data to named map view of file
+withMapFile :: String -> ByteString -> IO a -> ErrorT String IO a
+withMapFile name str act = flip runContT return $ do
+	p <- ContT $ \f -> ErrorT (BS.useAsCString str (runErrorT . f))
+	h <- createMap Nothing pAGE_READWRITE (fromIntegral len) (Just name)
+	ptr <- lift $ mapFile h fILE_MAP_ALL_ACCESS 0 0
+	liftIO $ do
+		copyMemory ptr p (fromIntegral len)
+		unmapViewOfFile ptr
+		act
+	where
+		len = BS.length str + 1
+
+-- | Read data from named map view of file
+readMapFile :: String -> ErrorT String IO ByteString
+readMapFile name = flip runContT return $ do
+	h <- openMap fILE_MAP_ALL_ACCESS True (Just name)
+	ptr <- lift $ mapFile h fILE_MAP_ALL_ACCESS 0 0
+	liftIO $ BS.packCString ptr
+
+verify :: (Error e, MonadError e m, Eq a) => a -> String -> m a -> m a
+verify v str act = do
+	x <- act
+	if x == v
+		then throwError (strMsg str)
+		else return x

@@ -0,0 +1,31 @@+module System.Win32.FileMapping.NamePool (
+	Pool(..),
+	createPool, withName
+	) where
+
+import Control.Concurrent
+import Control.Exception (bracket)
+import Control.Monad (liftM, liftM2)
+import System.Win32.FileMapping.Memory ()
+
+-- | Pool of names for memory mapped files
+data Pool = Pool {
+	poolFreeNames :: MVar [String],
+	poolNewName :: IO String }
+
+-- | Create pool of numbered names by base name
+createPool :: String -> IO Pool
+createPool baseName = liftM2 Pool (newMVar []) mkNewName where
+	mkNewName :: IO (IO String)
+	mkNewName = do
+		num <- newMVar 0
+		return $ modifyMVar num $ \n -> do
+			return (succ n, baseName ++ show n)
+
+-- | Use free name from pool
+withName :: Pool -> (String -> IO a) -> IO a
+withName p act = bracket getName freeName act where
+	getName = modifyMVar (poolFreeNames p) $ \names -> case names of
+		[] -> liftM ((,) []) $ poolNewName p
+		(n:ns) -> return (ns, n)
+	freeName name = modifyMVar_ (poolFreeNames p) (return . (name:))

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Tool (
+	-- * Tool
+	toolMain, usage,
+	-- * Json command
+	jsonCmd, jsonCmd_,
+	-- * Errors
+	toolError,
+	-- * Options
+	prettyOpt, isPretty,
+
+	module System.Command
+	) where
+
+import Control.Monad.Error (ErrorT, runErrorT, throwError)
+import Data.Aeson
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.ByteString.Lazy.Char8 as L (ByteString, putStrLn)
+import System.Console.GetOpt
+import System.Environment
+import System.IO
+
+import HsDev.Tools.Base (ToolM)
+
+import System.Command
+
+-- | Run tool with commands
+toolMain :: String -> [Command (IO ())] -> IO ()
+toolMain name commands = do
+	hSetBuffering stdout LineBuffering
+	hSetEncoding stdout utf8
+	as <- getArgs
+	case as of
+		[] -> usage name toolCmds
+		_ -> run toolCmds unknownCmd onError as
+	where
+		onError :: [String] -> IO ()
+		onError = mapM_ putStrLn
+
+		unknownCmd :: IO ()
+		unknownCmd = putStrLn "Unknown command" >> usage name toolCmds
+
+		toolCmds = addHelp name id commands
+
+-- | Print usage
+usage :: String -> [Command (IO ())] -> IO ()
+usage toolName = mapM_ (putStrLn . ('\t':) . ((toolName ++ " ") ++) . brief)
+
+-- | Command with JSONable result
+jsonCmd :: ToJSON a => [String] -> [String] -> String -> [OptDescr Opts] -> (Opts -> [String] -> ToolM a) -> Command (IO ())
+jsonCmd name posArgs descr as act = cmd name posArgs descr (prettyOpt : as) $ \opts as -> do
+	r <- runErrorT $ act opts as
+	L.putStrLn $ either (toStr opts . errorStr) (toStr opts) r
+	where
+		toStr :: ToJSON a => Opts -> a -> L.ByteString
+		toStr opts
+			| isPretty opts = encodePretty
+			| otherwise = encode
+
+		errorStr :: String -> Value
+		errorStr s = object ["error" .= s]
+
+-- | `jsonCmd` with the only '--pretty' option
+jsonCmd_ :: ToJSON a => [String] -> [String] -> String -> ([String] -> ToolM a) -> Command (IO ())
+jsonCmd_ name posArgs descr = jsonCmd name posArgs descr [] . const
+
+-- | Fail with error
+toolError :: String -> ToolM a
+toolError = throwError
+
+prettyOpt :: OptDescr Opts
+prettyOpt = option_ [] "pretty" flag "pretty JSON output"
+
+isPretty :: Opts -> Bool
+isPretty = hasOpt "pretty"

@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Types (
+	-- * Server options
+	ServerOpts(..), serverOpts, serverOptsToArgs,
+	-- * Client options
+	ClientOpts(..), clientOpts,
+	-- * Messages and results
+	ResultValue(..), Response(..),
+	CommandResult(..), ok, err, errArgs, details,
+	WithOpts(..),
+	CommandOptions(..), CommandAction
+	) where
+
+import Control.Applicative
+import Control.Monad.Error
+import Data.Aeson
+import Data.Map (Map)
+import Data.Monoid
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map as M
+import System.Console.GetOpt
+import Text.Read
+
+import HsDev.Database
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Tools.GhcMod (TypedRegion)
+import qualified HsDev.Database.Async as DB
+
+import System.Command
+
+-- | Server options
+data ServerOpts = ServerOpts {
+	serverPort :: First Int,
+	serverTimeout :: First Int,
+	serverLog :: First String,
+	serverCache :: First FilePath,
+	serverLoadCache :: Any }
+
+instance DefaultConfig ServerOpts where
+	defaultConfig = ServerOpts
+		(First $ Just 4567)
+		(First $ Just 1000)
+		(First Nothing)
+		(First Nothing)
+		mempty
+
+instance Monoid ServerOpts where
+	mempty = ServerOpts mempty mempty mempty mempty mempty
+	l `mappend` r = ServerOpts
+		(serverPort l `mappend` serverPort r)
+		(serverTimeout l `mappend` serverTimeout r)
+		(serverLog l `mappend` serverLog r)
+		(serverCache l `mappend` serverCache r)
+		(serverLoadCache l `mappend` serverLoadCache r)
+
+-- | Server options command opts
+serverOpts :: [OptDescr ServerOpts]
+serverOpts = [
+	Option [] ["port"] (ReqArg (\p -> mempty { serverPort = First (readMaybe p) }) "number") "listen port",
+	Option [] ["timeout"] (ReqArg (\t -> mempty { serverTimeout = First (readMaybe t) }) "msec") "query timeout",
+	Option ['l'] ["log"] (ReqArg (\l -> mempty { serverLog = First (Just l) }) "file") "log file",
+	Option [] ["cache"] (ReqArg (\p -> mempty { serverCache = First (Just p) }) "path") "cache directory",
+	Option [] ["load"] (NoArg (mempty { serverLoadCache = Any True })) "force load all data from cache on startup"]
+
+-- | Convert 'ServerOpts' to args
+serverOptsToArgs :: ServerOpts -> [String]
+serverOptsToArgs sopts = concat [
+	arg' "port" show $ serverPort sopts,
+	arg' "timeout" show $ serverTimeout sopts,
+	arg' "log" id $ serverLog sopts,
+	arg' "cache" id $ serverCache sopts,
+	if getAny (serverLoadCache sopts) then ["--load"] else []]
+	where
+		arg' :: String -> (a -> String) -> First a -> [String]
+		arg' name str = maybe [] (\v -> ["--" ++ name, str v]) . getFirst
+
+-- | Client options
+data ClientOpts = ClientOpts {
+	clientPort :: First Int,
+	clientPretty :: Any,
+	clientData :: Any }
+
+instance DefaultConfig ClientOpts where
+	defaultConfig = ClientOpts (First $ Just 4567) mempty mempty
+
+instance Monoid ClientOpts where
+	mempty = ClientOpts mempty mempty mempty
+	l `mappend` r = ClientOpts
+		(clientPort l `mappend` clientPort r)
+		(clientPretty l `mappend` clientPretty r)
+		(clientData l `mappend` clientData r)
+
+-- | Client options command opts
+clientOpts :: [OptDescr ClientOpts]
+clientOpts = [
+	Option [] ["port"] (ReqArg (\p -> mempty { clientPort = First (readMaybe p) }) "number") "connection port",
+	Option [] ["pretty"] (NoArg (mempty { clientPretty = Any True })) "pretty json output",
+	Option [] ["stdin"] (NoArg (mempty { clientData = Any True })) "pass data to stdin"]
+
+data ResultValue =
+	ResultDatabase Database |
+	ResultDeclaration Declaration |
+	ResultModuleDeclaration ModuleDeclaration |
+	ResultModuleId ModuleId |
+	ResultModule Module |
+	ResultInspectedModule InspectedModule |
+	ResultPackage ModulePackage |
+	ResultProject Project |
+	ResultTyped TypedRegion |
+	ResultList [ResultValue] |
+	ResultMap (Map String ResultValue) |
+	ResultJSON Value |
+	ResultString String |
+	ResultNone
+
+instance ToJSON ResultValue where
+	toJSON (ResultDatabase db) = toJSON db
+	toJSON (ResultDeclaration d) = toJSON d
+	toJSON (ResultModuleDeclaration md) = toJSON md
+	toJSON (ResultModuleId mid) = toJSON mid
+	toJSON (ResultModule m) = toJSON m
+	toJSON (ResultInspectedModule m) = toJSON m
+	toJSON (ResultPackage p) = toJSON p
+	toJSON (ResultProject p) = toJSON p
+	toJSON (ResultTyped t) = toJSON t
+	toJSON (ResultList l) = toJSON l
+	toJSON (ResultMap m) = toJSON m
+	toJSON (ResultJSON v) = toJSON v
+	toJSON (ResultString s) = toJSON s
+	toJSON ResultNone = toJSON $ object []
+
+instance FromJSON ResultValue where
+	parseJSON v = foldr1 (<|>) [
+		do
+			(Object m) <- parseJSON v
+			if HM.null m then return ResultNone else mzero,
+		ResultDatabase <$> parseJSON v,
+		ResultDeclaration <$> parseJSON v,
+		ResultModuleDeclaration <$> parseJSON v,
+		ResultModuleId <$> parseJSON v,
+		ResultModule <$> parseJSON v,
+		ResultInspectedModule <$> parseJSON v,
+		ResultPackage <$> parseJSON v,
+		ResultProject <$> parseJSON v,
+		ResultTyped <$> parseJSON v,
+		ResultList <$> parseJSON v,
+		ResultMap <$> parseJSON v,
+		pure $ ResultJSON v,
+		ResultString <$> parseJSON v]
+
+data Response =
+	Response Value |
+	ResponseStatus Value |
+	ResponseMapFile String
+
+instance ToJSON Response where
+	toJSON (Response v) = object ["result" .= v]
+	toJSON (ResponseStatus v) = object ["status" .= v]
+	toJSON (ResponseMapFile s) = object ["file" .= s]
+
+instance FromJSON Response where
+	parseJSON = withObject "response" (\v ->
+		(Response <$> (v .: "result")) <|>
+		(ResponseStatus <$> (v .: "status")) <|>
+		(ResponseMapFile <$> (v .: "file")))
+
+data CommandResult =
+	ResultOk ResultValue |
+	ResultError String (Map String ResultValue) |
+	ResultProcess ((Value -> IO ()) -> IO ())
+
+instance Error CommandResult where
+	noMsg = ResultError noMsg mempty
+	strMsg s = ResultError s mempty
+
+ok :: CommandResult
+ok = ResultOk ResultNone
+
+err :: String -> CommandResult
+err s = ResultError s M.empty
+
+errArgs :: String -> [(String, ResultValue)] -> CommandResult
+errArgs s as = ResultError s (M.fromList as)
+
+-- | Add detailed information to error message
+details :: [(String, ResultValue)] -> CommandResult -> CommandResult
+details as (ResultError s cs) = ResultError s (M.union (M.fromList as) cs)
+details _ r = r
+
+data WithOpts a = WithOpts {
+	withOptsAct :: a,
+	withOptsArgs :: IO [String] }
+
+instance Functor WithOpts where
+	fmap f (WithOpts x as) = WithOpts (f x) as
+
+data CommandOptions = CommandOptions {
+	commandDatabase :: DB.Async Database,
+	commandWriteCache :: Database -> IO (),
+	commandReadCache :: (FilePath -> ErrorT String IO Structured) -> IO (Maybe Database),
+	commandRoot :: FilePath,
+	commandLog :: String -> IO (),
+	commandWaitInput :: IO String,
+	commandLink :: IO (),
+	commandExit :: IO () }
+
+type CommandAction = WithOpts (Int -> CommandOptions -> IO CommandResult)
+

@@ -0,0 +1,189 @@+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, MultiParamTypeClasses #-}
+
+module Update (
+	Settings(..),
+
+	UpdateDB,
+	updateDB,
+
+	setStatus, waiter, updater, loadCache, runTask, runTasks,
+	status, readDB,
+
+	scanModule, scanModules, scanFile, scanCabal, scanProject, scanDirectory,
+
+	-- * Helpers
+	liftErrorT
+	) where
+
+import Control.Applicative (Applicative(..))
+import Control.Monad.CatchIO
+import Control.Monad.Error
+import Control.Monad.Reader
+import Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Maybe (mapMaybe)
+import Data.Monoid
+import Data.Traversable (traverse)
+import System.Directory (canonicalizePath)
+
+import qualified HsDev.Cache.Structured as Cache
+import HsDev.Database
+import HsDev.Database.Async
+import HsDev.Project
+import HsDev.Symbols
+import HsDev.Tools.HDocs
+import qualified HsDev.Scan as S
+import HsDev.Scan.Browse
+
+data Settings = Settings {
+	database :: Async Database,
+	databaseCacheReader :: (FilePath -> ErrorT String IO Structured) -> IO (Maybe Database),
+	onStatus :: Value -> IO (),
+	ghcOptions :: [String] }
+
+newtype UpdateDB m a = UpdateDB { runUpdateDB :: ReaderT Settings m a }
+	deriving (Applicative, Monad, MonadIO, MonadCatchIO, Functor, MonadReader Settings)
+
+-- | Run `UpdateDB` monad
+updateDB :: Monad m => Settings -> ErrorT String (UpdateDB m) () -> m ()
+updateDB sets act = runUpdateDB (runErrorT act >> return ()) `runReaderT` sets
+
+-- | Set partial status
+setStatus :: MonadReader Settings m => Value -> m a -> m a
+setStatus v act = local alter act where
+	alter s = s {
+		onStatus = \st -> onStatus s (v `union` st) }
+
+-- | Wait DB to complete actions
+waiter :: (MonadIO m, MonadReader Settings m) => m () -> m ()
+waiter act = do
+	db <- asks database
+	act
+	wait db
+
+-- | Update task result to database
+updater :: (MonadIO m, MonadReader Settings m) => m Database -> m ()
+updater act = do
+	db <- asks database
+	act >>= update db . return
+
+-- | Load data from cache and wait
+loadCache :: (MonadIO m, MonadReader Settings m) => (FilePath -> ErrorT String IO Structured) -> m ()
+loadCache act = do
+	cacheReader <- asks databaseCacheReader
+	mdat <- liftIO $ cacheReader act
+	case mdat of
+		Nothing -> return ()
+		Just dat -> waiter (updater (return dat))
+
+-- | Run one task
+runTask :: MonadIO m => Value -> ErrorT String (UpdateDB m) a -> ErrorT String (UpdateDB m) a
+runTask v act = object ["task" .= v] `setStatus` wrapAct act where
+	wrapAct :: MonadIO m => ErrorT String (UpdateDB m) a -> ErrorT String (UpdateDB m) a
+	wrapAct a = do
+		status $ object ["status" .= toJSON ("working" :: String)]
+		x <- a
+		status $ object ["status" .= taskOk]
+		return x
+		`catchError`
+		(\e -> status (object ["status" .= taskErr e]) >> throwError e)
+	taskOk = toJSON ("ok" :: String)
+	taskErr e = object ["error" .= e]
+
+-- | Run many tasks with numeration
+runTasks :: Monad m => [ErrorT String (UpdateDB m) ()] -> ErrorT String (UpdateDB m) ()
+runTasks ts = zipWithM_ taskNum [1..] (map noErr ts) where
+	total = length ts
+	taskNum n t = progress `setStatus` t where
+		progress = object ["progress" .= object [
+			"current" .= (n :: Integer), "total" .= total]]
+	noErr v = v `mplus` return ()
+
+-- | Post status
+status :: (MonadIO m, MonadReader Settings m) => Value -> m ()
+status msg = do
+	on' <- asks onStatus
+	liftIO $ on' msg
+
+-- | Get database value
+readDB :: (MonadIO m, MonadReader Settings m) => m Database
+readDB = asks database >>= liftIO . readAsync
+
+-- | Scan module
+scanModule :: MonadCatchIO m => [String] -> ModuleLocation -> ErrorT String (UpdateDB m) ()
+scanModule opts mloc = runTask task' $ do
+	im <- liftErrorT $ S.scanModule opts mloc
+	updater $ return $ fromModule im
+	ErrorT $ return $ inspectionResult im
+	return ()
+	where
+		task' = object ["scanning" .= mloc]
+
+-- | Scan modules
+scanModules :: MonadCatchIO m => [String] -> [S.ModuleToScan] -> ErrorT String (UpdateDB m) ()
+scanModules opts ms = do
+	db <- asks database
+	dbval <- readDB
+	runTask (toJSON ("updating projects files" :: String)) $ updater $ do
+		projects <- mapM (liftErrorT . S.scanProjectFile opts) ps
+		return $ mconcat $ map fromProject projects
+	ms' <- liftErrorT $ filterM (S.changedModule dbval opts . fst) ms
+	runTasks [scanModule (opts ++ snd m) (fst m) | m <- ms']
+	where
+		ps = mapMaybe (toProj . fst) ms
+		toProj (FileModule _ p) = fmap projectCabal p
+		toProj _ = Nothing
+
+-- | Scan source file
+scanFile :: MonadCatchIO m => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
+scanFile opts fpath = do
+	fpath' <- liftIO $ canonicalizePath fpath
+	mproj <- liftIO $ locateProject fpath'
+	let
+		mtarget = mproj >>= (`fileTarget` fpath')
+		fileExts = maybe [] (extensionsOpts . infoExtensions) mtarget
+
+	scanModule (opts ++ fileExts) (FileModule fpath' mproj)
+
+-- | Scan cabal modules
+scanCabal :: MonadCatchIO m => [String] -> Cabal -> ErrorT String (UpdateDB m) ()
+scanCabal opts sandbox = do
+	loadCache $ Cache.loadCabal sandbox
+	dbval <- readDB
+	ms <- runTask
+		(object ["action" .= ("loading modules" :: String), "sandbox" .= sandbox]) $
+		liftErrorT $ browseFilter opts sandbox (S.changedModule dbval opts)
+	docs <- runTask
+		(object ["action" .= ("loading docs" :: String), "sandbox" .= sandbox]) $
+		liftErrorT $ hdocsCabal sandbox opts
+	updater $ return $ mconcat $ map (fromModule . fmap (setDocs' docs)) ms
+	where
+		setDocs' :: Map String (Map String String) -> Module -> Module
+		setDocs' docs m = maybe m (`setDocs` m) $ M.lookup (moduleName m) docs
+
+-- | Scan project
+scanProject :: MonadCatchIO m => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
+scanProject opts cabal = do
+	proj <- liftErrorT $ S.scanProjectFile opts cabal
+	loadCache $ Cache.loadProject $ projectCabal proj
+	(_, sources) <- liftErrorT $ S.enumProject proj
+	scanModules opts sources
+
+-- | Scan directory for source files and projects
+scanDirectory :: MonadCatchIO m => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
+scanDirectory opts dir = do
+	(projSrcs, standSrcs) <- runTask (toJSON ("getting list of sources" :: String)) $ liftErrorT $ S.enumDirectory dir
+	forM_ projSrcs $ \(p, _) -> loadCache (Cache.loadProject $ projectCabal p)
+	loadCache $ Cache.loadFiles $ mapMaybe (moduleSource . fst) standSrcs
+	scanModules opts (concatMap snd projSrcs ++ standSrcs)
+
+-- | Lift errors
+liftErrorT :: MonadIO m => ErrorT String IO a -> ErrorT String m a
+liftErrorT = mapErrorT liftIO
+
+-- | Merge two JSON object
+union :: Value -> Value -> Value
+union (Object l) (Object r) = Object $ HM.union l r
+union _ _ = error "Commands.union: impossible happened"

@@ -0,0 +1,11 @@+module Main (
+	main
+	) where
+
+import HsDev.Tools.Cabal
+
+import Tool
+
+main :: IO ()
+main = toolMain "hscabal" [
+	jsonCmd_ ["list"] ["packages..."] "list hackage packages" cabalList]

@@ -0,0 +1,52 @@+module Main (
+	main
+	) where
+
+import Control.Exception (finally)
+import Control.Monad (void)
+import Control.Monad.Error
+import System.Console.GetOpt (OptDescr)
+import System.Directory
+import System.Environment (getArgs)
+import Text.Read (readMaybe)
+
+import HsDev.Tools.ClearImports (clearImports)
+import HsDev.Symbols (locateSourceDir)
+
+import System.Command
+
+opts :: [OptDescr Opts]
+opts = [
+	option_ ['g'] "ghc" (req "ghc options") "options for GHC",
+	option_ [] "hide-import-list" flag "hide import list",
+	option_ [] "max-import-list" (req "max import list length") "hide long import lists"]
+
+cmds :: [Command (IO ())]
+cmds = addHelp "hsclearimports" id [
+	cmd [] ["file"] "clear imports in haskell source" opts clear]
+	where
+		clear :: Opts -> [String] -> IO ()
+		clear as [f] = do
+			file <- canonicalizePath f
+			mroot <- locateSourceDir file
+			cur <- getCurrentDirectory
+			flip finally (setCurrentDirectory cur) $ do
+				maybe (return ()) setCurrentDirectory mroot
+				void $ runErrorT $ catchError
+					(clearImports (askOpts "ghc" as) file >>= mapM_ (liftIO . putStrLn . format as))
+					(\e -> liftIO (putStrLn $ "Error: " ++ e))
+		clear _ _ = putStrLn "Invalid arguments"
+		
+		format :: Opts -> (String, String) -> String
+		format as (imp, lst)
+			| hasOpt "hide-import-list" as = imp
+			| maybe False (length lst >) (askOpt "max-import-list" as >>= readMaybe) = imp
+			| otherwise = imp ++ " (" ++ lst ++ ")"
+
+main :: IO ()
+main = do
+	args <- getArgs
+	run cmds noCmd onError args
+	where
+		noCmd = putStrLn "Invalid command"
+		onError = mapM_ putStrLn

@@ -0,0 +1,45 @@+module Main (
+	main
+	) where
+
+import Control.Monad
+import Network.Socket
+import System.Environment
+import System.Exit
+import System.IO
+
+import System.Command hiding (brief)
+import qualified System.Command as C (brief)
+
+import Types
+import Commands
+
+main :: IO ()
+main = withSocketsDo $ do
+	hSetBuffering stdout LineBuffering
+	hSetEncoding stdout utf8
+	as <- getArgs
+	when (null as) $ do
+		printMainUsage
+		exitSuccess
+	let
+		asr = if last as == "-?" then "help" : init as else as 
+	run mainCommands onDef onError asr
+	where
+		onError :: [String] -> IO ()
+		onError errs = do
+			mapM_ putStrLn errs
+			exitFailure
+
+		onDef :: IO ()
+		onDef = do
+			putStrLn "Unknown command"
+			exitFailure
+
+printMainUsage :: IO ()
+printMainUsage = do
+	mapM_ (putStrLn . ('\t':) . ("hsdev " ++) . C.brief) mainCommands
+	putStrLn "\thsdev [--port=number] [--pretty] [--stdin] interactive command... -- send command to server, use flag stdin to pass data argument through stdin"
+
+printUsage :: IO ()
+printUsage = mapM_ (putStrLn . ('\t':) . ("hsdev " ++) . C.brief) commands

@@ -0,0 +1,15 @@+module Main (
+	main
+	) where
+
+import Control.Monad (liftM)
+import HsDev.Tools.Hayoo
+
+import Tool
+
+main :: IO ()
+main = toolMain "hshayoo" [
+	jsonCmd_ [] ["query"] "search in hayoo" hayoo']
+	where
+		hayoo' [q] = liftM (map hayooAsDeclaration . hayooFunctions) $ hayoo q
+		hayoo' _ = toolError "Invalid arguments"

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (
+	main
+	) where
+
+import HsDev.Project (readProject)
+import HsDev.Scan (scanModule)
+import HsDev.Symbols.Location (ModuleLocation(..), Cabal(..))
+
+import Tool
+
+main :: IO ()
+main = toolMain "hsinspect" [
+	jsonCmd ["module"] ["module name"] "inspect installed module" [ghcOpts] inspectModule',
+	jsonCmd ["file"] ["source file"] "inspect file" [ghcOpts] inspectFile',
+	jsonCmd_ ["cabal"] ["project file"] "inspect .cabal file" inspectCabal']
+	where
+		ghcOpts = option_ ['g'] "ghc" (req "ghc options") "options to pass to GHC"
+		ghcs = askOpts "ghc"
+
+		inspectModule' opts [mname] = scanModule (ghcs opts) (CabalModule Cabal Nothing mname)
+		inspectModule' _ _ = toolError "Specify module name"
+
+		inspectFile' opts [fname] = scanModule (ghcs opts) (FileModule fname Nothing)
+		inspectFile' _ _ = toolError "Specify source file name"
+
+		inspectCabal' [fcabal] = readProject fcabal
+		inspectCabal' _ = toolError "Specify project .cabal file"