packages feed

hsdev 0.1.4.3 → 0.1.5.0

raw patch · 42 files changed

+1870/−3025 lines, 42 filesdep +asyncdep +cpphsdep +data-defaultdep ~ghc-mod

Dependencies added: async, cpphs, data-default, hformat, optparse-applicative, text-region

Dependency ranges changed: ghc-mod

Files

hsdev.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.4.3
+version:             0.1.5.0
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -22,14 +22,12 @@   exposed-modules:
     Control.Apply.Util
     Control.Concurrent.FiniteChan
-    Control.Concurrent.Task
     Control.Concurrent.Worker
     Control.Concurrent.Util
     Data.Async
     Data.Group
     Data.Help
     Data.Lisp
-    Data.Mark
     Data.Maybe.JustIf
     HsDev
     HsDev.Cabal
@@ -46,6 +44,7 @@     HsDev.Project
     HsDev.Scan
     HsDev.Scan.Browse
+    HsDev.Server.Base
     HsDev.Server.Commands
     HsDev.Server.Message
     HsDev.Server.Types
@@ -74,10 +73,8 @@     HsDev.Version
     HsDev.Watcher
     HsDev.Watcher.Types
-    System.Console.Args
-    System.Console.Cmd
+    System.Directory.Paths
     System.Directory.Watcher
-    Text.Format
 
   if os(windows)
     build-depends:
@@ -95,23 +92,27 @@     aeson >= 0.7.0,
     aeson-pretty >= 0.7.0,
     array >= 0.5.0,
+    async >= 2.0,
     attoparsec >= 0.11.0,
     bin-package-db,
     bytestring >= 0.10.0,
     Cabal >= 1.22.0,
     containers >= 0.5.0,
+    cpphs >= 1.19.0,
+    data-default >= 0.5.0,
     deepseq >= 1.4.0,
     directory >= 1.2.0,
     exceptions >= 0.6.0,
     filepath >= 1.4.0,
     fsnotify >= 0.2.1,
     ghc >= 7.10.0 && < 7.11.0,
-    ghc-mod >= 5.3.0.0,
+    ghc-mod >= 5.4.0.0 && < 5.5.0.0,
     ghc-paths >= 0.1.0,
     ghc-syb-utils >= 0.2.3,
     haddock-api >= 2.16.0 && < 2.17.0,
     haskell-src-exts >= 1.16.0,
     hdocs >= 0.4.4,
+    hformat >= 0.1,
     hlint >= 1.9.0 && < 2.0.0,
     HTTP >= 4000.2.0,
     lens >= 4.8,
@@ -121,6 +122,7 @@     mtl >= 2.2.0,
     MonadCatchIO-transformers >= 0.3.1,
     network >= 2.6.0,
+    optparse-applicative >= 0.11,
     process >= 1.2.0,
     regex-pcre-builtin >= 0.94,
     scientific >= 0.3,
@@ -128,6 +130,7 @@     syb >= 0.5.1,
     template-haskell,
     text >= 1.2.0,
+    text-region >= 0.1,
     time >= 1.5.0,
     transformers >= 0.4.0,
     transformers-base >= 0.4.0,
@@ -154,6 +157,7 @@     monad-loops >= 0.4.0,
     mtl >= 2.2.0,
     network >= 2.6.0,
+    optparse-applicative >= 0.11,
     process >= 1.2.0,
     text >= 1.2.0,
     transformers >= 0.4.0,
@@ -175,6 +179,7 @@     directory >= 1.2.0,
     filepath >= 1.4.0,
     mtl >= 2.2.0,
+    optparse-applicative >= 0.11,
     text >= 1.2.0,
     transformers >= 0.4.0,
     unordered-containers >= 0.2.0,
@@ -190,13 +195,16 @@     hsdev,
     aeson >= 0.7.0,
     aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
     containers >= 0.5.0,
     directory >= 1.2.0,
     ghc >= 7.10.0 && < 7.11.0,
     haskell-src-exts >= 1.16.0,
     lens >= 4.8,
     mtl >= 2.2.0,
+    optparse-applicative >= 0.11,
     text >= 1.2.0,
+    transformers >= 0.4.0,
     unordered-containers >= 0.2.0
 
 executable hscabal
@@ -213,7 +221,9 @@     bytestring >= 0.10.0,
     containers >= 0.5.0,
     mtl >= 2.2.0,
+    optparse-applicative >= 0.11,
     text >= 1.2.0,
+    transformers >= 0.4.0,
     unordered-containers >= 0.2.0
 
 executable hshayoo
@@ -230,7 +240,9 @@     bytestring >= 0.10.0,
     containers >= 0.5.0,
     mtl >= 2.2.0,
+    optparse-applicative >= 0.11,
     text >= 1.2.0,
+    transformers >= 0.4.0,
     unordered-containers >= 0.2.0
 
 executable hsautofix
@@ -247,7 +259,9 @@     bytestring >= 0.10.0,
     directory >= 1.2.0,
     lens >= 4.8,
-    mtl >= 2.2.0
+    mtl >= 2.2.0,
+    optparse-applicative >= 0.11,
+    transformers >= 0.4.0
 
 test-suite test
   main-is: Test.hs
@@ -255,7 +269,16 @@   ghc-options: -Wall -fno-warn-tabs
   type: exitcode-stdio-1.0
   build-depends:
-    base >= 4.7 && < 5
+    base >= 4.7 && < 5,
+    hsdev,
+    async >= 2.0,
+    data-default >= 0.5.0,
+    containers >= 0.5.0,
+    deepseq >= 1.4.0,
+    hformat >= 0.1,
+    lens >= 4.8,
+    mtl >= 2.2.0,
+    text >= 1.2.0
 
 source-repository head
   type: git
− src/Control/Concurrent/Task.hs 
@@ -1,138 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}
-
-module Control.Concurrent.Task (
-	Task(..), TaskException(..), TaskResult(..),
-	taskStarted, taskRunning, taskStopped, taskDone, taskFailed, taskCancelled,
-	taskWaitStart, taskWait, taskJoinWith, taskJoin, taskJoin_, taskKill, taskCancel, taskStop,
-	runTask, runTask_, runTaskTry, runTaskError, forkTask, tryT,
-
-	-- * Reexports
-	SomeException,
-	MonadIO, MonadCatch, MonadError
-	) where
-
-import Control.Concurrent
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Catch
-import Data.Either
-import Data.Maybe
-import Data.Typeable
-
--- | Task result
-data Task a = Task {
-	taskStart :: MVar (Maybe (SomeException -> IO ())),
-	taskResult :: TaskResult a }
-
-data TaskException = TaskCancelled | TaskKilled deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)
-
-instance Exception TaskException
-
-data TaskResult a = TaskResult {
-	taskResultEmpty :: IO Bool,
-	taskResultTryRead :: IO (Maybe (Either SomeException a)),
-	taskResultTake :: IO (Either SomeException a),
-	taskResultFail :: SomeException -> IO () }
-
-instance Functor TaskResult where
-	fmap f r = TaskResult {
-		taskResultEmpty = taskResultEmpty r,
-		taskResultTryRead = fmap (fmap f) <$> taskResultTryRead r,
-		taskResultTake = fmap f <$> taskResultTake r,
-		taskResultFail = taskResultFail r }
-
-instance Functor Task where
-	fmap f t = Task {
-		taskStart = taskStart t,
-		taskResult = fmap f (taskResult t) }
-
-taskStarted :: Task a -> IO Bool
-taskStarted = fmap (maybe False isJust) . tryReadMVar . taskStart
-
-taskRunning :: Task a -> IO Bool
-taskRunning t = (&&) <$> taskStarted t <*> (not <$> taskStopped t)
-
-taskStopped :: Task a -> IO Bool
-taskStopped = fmap not . taskResultEmpty . taskResult
-
-taskDone :: Task a -> IO Bool
-taskDone = fmap (maybe False isRight) . taskResultTryRead . taskResult
-
-taskFailed :: Task a -> IO Bool
-taskFailed = fmap (maybe False isLeft) . taskResultTryRead . taskResult
-
-taskCancelled :: Task a -> IO Bool
-taskCancelled = fmap (maybe False isNothing) . tryReadMVar . taskStart
-
--- | Wait until task starts or be cancelled, returns True if started
-taskWaitStart :: Task a -> IO Bool
-taskWaitStart = (`withMVar` (return . isJust)) . taskStart
-
--- | Wait for task
-taskWait :: Task a -> IO (Either SomeException a)
-taskWait = taskResultTake . taskResult
-
--- | Join task with
-taskJoinWith :: MonadIO m => (SomeException -> m a) -> Task a -> m a
-taskJoinWith err = liftIO . taskWait >=> either err return
-
--- | Join task, rethrowing its exceptions
-taskJoin :: Task a -> IO a
-taskJoin = taskJoinWith throwM
-
--- | Join task, returning exceptions as @EitherT@
-taskJoin_ :: Task a -> ExceptT SomeException IO a
-taskJoin_ = taskJoinWith throwError
-
--- | Kill task
-taskKill :: Task a -> IO ()
-taskKill =
-	tryTakeMVar . taskStart >=>
-	void . traverse ($ toException TaskKilled) . join
-
--- | Cancel task if it is not started yet
-taskCancel :: Task a -> IO Bool
-taskCancel t = do
-	aborted <- tryPutMVar (taskStart t) Nothing
-	when aborted $ void $ taskResultFail (taskResult t) (toException TaskCancelled)
-	return aborted
-
--- | Cancel or kill task, returns whether it was cancelled
-taskStop :: Task a -> IO Bool
-taskStop t = do
-	cancelled <- taskCancel t
-	unless cancelled $ taskKill t
-	return cancelled
-
-runTask :: (MonadCatch m, MonadIO m, MonadIO n) => (m () -> n ()) -> m a -> n (Task a)
-runTask f = runTask_ (const f)
-
-runTask_ :: (MonadCatch m, MonadIO m, MonadIO n) => (Task a -> m () -> n ()) -> m a -> n (Task a)
-runTask_ f = runTaskTry f . liftM Right
-
-runTaskTry :: (MonadCatch m, MonadIO m, MonadIO n) => (Task a -> m () -> n ()) -> m (Either SomeException a) -> n (Task a)
-runTaskTry f act = do
-	throwVar <- liftIO newEmptyMVar
-	resultVar <- liftIO newEmptyMVar
-	f (Task throwVar $ toResult resultVar) $ handle (liftIO . putMVar resultVar . Left) $ do
-		th <- liftIO myThreadId
-		ok <- liftIO $ tryPutMVar throwVar (Just $ throwTo th)
-		when ok $ act >>= liftIO . putMVar resultVar
-	return $ Task throwVar $ toResult resultVar
-	where
-		toResult :: MVar (Either SomeException a) -> TaskResult a
-		toResult var = TaskResult {
-			taskResultEmpty = isEmptyMVar var,
-			taskResultTryRead = tryReadMVar var,
-			taskResultTake = takeMVar var,
-			taskResultFail = void . tryPutMVar var . Left }	
-
-runTaskError :: (Show e, MonadError e m, MonadCatch m, MonadIO m, MonadIO n) => (Task a -> m () -> n ()) -> m a -> n (Task a)
-runTaskError f = runTaskTry f . tryT
-
--- | Run task in separate thread
-forkTask :: IO a -> IO (Task a)
-forkTask = runTask (void . forkIO)
-
-tryT :: (Show e, MonadError e m) => m a -> m (Either SomeException a)
-tryT act = catchError (liftM Right act) (return . Left . toException . userError . show)
src/Control/Concurrent/Worker.hs view
@@ -7,21 +7,22 @@ 	stopWorker, syncTask,
 	inWorkerWith, inWorker, inWorker_,
 
-	module Control.Concurrent.Task
+	module Control.Concurrent.Async
 	) where
 
 import Control.Concurrent.MVar
 import Control.Monad.IO.Class
 import Control.Monad.Catch
 import Control.Monad.Except
+import Data.Maybe (isJust)
 
 import Control.Concurrent.FiniteChan
-import Control.Concurrent.Task
+import Control.Concurrent.Async
 
 data Worker m = Worker {
-	workerChan :: Chan (Task (), m ()),
+	workerChan :: Chan (Async (), m ()),
 	workerWrap :: forall a. m a -> m a,
-	workerTask :: MVar (Task ()),
+	workerTask :: MVar (Async ()),
 	workerRestart :: IO Bool }
 
 -- | Create new worker
@@ -30,27 +31,31 @@ 	ch <- newChan
 	taskVar <- newEmptyMVar
 	let
-		start = forkTask $ do
+		start = async $ do
 			run $ initialize processWork
 			processSkip
 		processWork = whileJust (liftM (fmap snd) $ liftIO $ getChan ch) id
-		processSkip = whileJust (liftM (fmap fst) $ getChan ch) taskStop
+		processSkip = whileJust (liftM (fmap fst) $ getChan ch) cancel
 		whileJust :: Monad m => m (Maybe a) -> (a -> m b) -> m  ()
 		whileJust v act = v >>= maybe (return ()) (\x -> act x >> whileJust v act)
 	start >>= putMVar taskVar
 	let
 		restart = do
 			task <- readMVar taskVar
-			stopped <- taskStopped task
+			stopped <- liftM isJust $ poll task
 			when stopped (start >>= void . swapMVar taskVar)
 			return stopped
 	return $ Worker ch wrap taskVar restart
 
-sendTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)
-sendTask w = runTask_ putTask' . workerWrap w where
-	putTask' t act = putChan (workerChan w) (fmap (const ()) t, act)
+sendTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Async a)
+sendTask w act = mfix $ \async' -> do
+	var <- newEmptyMVar
+	let
+		act' = (workerWrap w act >>= liftIO . putMVar var . Right) `catch` (liftIO . putMVar var . Left)
+		f = putChan (workerChan w) (void async', void act') >> takeMVar var >>= either (throwM :: SomeException -> IO a) return
+	async f
 
-pushTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)
+pushTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Async a)
 pushTask w act = workerRestart w >> sendTask w act
 
 stopWorker :: Worker m -> IO ()
@@ -58,16 +63,16 @@ 
 -- | Send empty task and wait until worker run it
 syncTask :: (MonadCatch m, MonadIO m) => Worker m -> IO ()
-syncTask w = pushTask w (return ()) >>= void . taskWait
+syncTask w = pushTask w (return ()) >>= void . wait
 
 -- | Run action in worker and wait for result
 inWorkerWith :: (MonadIO m, MonadCatch m, MonadIO n) => (SomeException -> n a) -> Worker m -> m a -> n a
-inWorkerWith err w act = liftIO (pushTask w act) >>= taskJoinWith err
+inWorkerWith err w act = liftIO (pushTask w act) >>= (liftIO . waitCatch >=> either err return)
 
 -- | Run action in worker and wait for result
 inWorker :: (MonadIO m, MonadCatch m) => Worker m -> m a -> IO a
-inWorker w act = pushTask w act >>= taskJoin
+inWorker w act = pushTask w act >>= liftIO . wait
 
 -- | Run action in worker and wait for result
 inWorker_ :: (MonadIO m, MonadCatch m) => Worker m -> m a -> ExceptT SomeException IO a
-inWorker_ w act = liftIO (pushTask w act) >>= taskJoin_
+inWorker_ w act = liftIO (pushTask w act) >>= ExceptT . waitCatch
− src/Data/Mark.hs 
@@ -1,340 +0,0 @@-{-# LANGUAGE ViewPatterns, OverloadedStrings, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, RankNTypes, MultiParamTypeClasses #-}
-
-module Data.Mark (
-	Point(..), point, lineStart, (.-.), (.+.), till, Size, linesSize, stringSize,
-	Range(..), rangeLines, emptyRange,
-	line,
-	range, rangeSize, expandLines, at,
-	-- * Mappings
-	Map(..), apply, back,
-	cut, insert,
-	cutRange, insertRange,
-	-- * Edited data
-	Contents, Edit(..),
-	EditM(..), editRange, mapRange, runEdit, edit, editEval,
-	Prefix(..), prefix, Suffix(..), suffix, concatCts, splitCts,
-	-- * Editable class
-	Editable(..), measure,
-	-- * Actions
-	EditAction(..),
-	Replace(..), inverse, reverseEdits, run
-	) where
-
-import Prelude hiding (splitAt, length, lines, unlines)
-
-import Control.Arrow ((&&&))
-import Control.Lens (view)
-import Control.Lens.Iso
-import Control.Monad.State
-import Data.Aeson
-import qualified Data.List as List (splitAt, length, break, intercalate)
-import Data.Text (Text)
-import qualified Data.Text as T (splitAt, length, split, intercalate)
-
-import HsDev.Util ((.::))
-
--- | Point at text: line and column
-data Point = Point {
-	pointLine :: Int,
-	pointColumn :: Int }
-		deriving (Eq, Ord, Read, Show)
-
-instance ToJSON Point where
-	toJSON (Point l c) = object ["line" .= l, "column" .= c]
-
-instance FromJSON Point where
-	parseJSON = withObject "point" $ \v -> Point <$> v .:: "line" <*> v .:: "column"
-
--- | Distance between points is measured in lines and columns.
--- And it is defined, that distance between point at l:c and point (l + 1):0 is one line no matter c is
--- because we need to go to new line to reach destination point
--- Columns are taken into account only if points are on the same line
--- @pt .-. base@ is distance from @base@ to @pt@
--- Distance can't be less then zero lines and columns
-(.-.) :: Point -> Point -> Point
-(Point l c) .-. (Point bl bc)
-	| bl < l = Point (l - bl) c
-	| bl == l = Point 0 (max 0 (c - bc))
-	| otherwise = Point 0 0
-
--- | Opposite to ".-.", @(pt .-. base) .+. base = pt@
-(.+.) :: Point -> Point -> Point
-(Point l c) .+. (Point bl bc)
-	| l == 0 = Point bl (c + bc)
-	| otherwise = Point (l + bl) c
-
-point :: Int -> Int -> Point
-point l c
-	| l < 0 = error "Line can't be less then zero"
-	| c < 0 = error "Column can't be less then zero"
-	| otherwise = Point l c
-
-lineStart :: Int -> Point
-lineStart l = point l 0
-
--- | Range from "Point" to "Point"
-data Range = Range {
-	rangeFrom :: Point,
-	rangeTo :: Point }
-		deriving (Eq, Ord, Read, Show)
-
-type Size = Point
-
-instance Monoid Size where
-	mempty = Point 0 0
-	l `mappend` r = r .+. l
-
-rangeLength :: Range -> Size
-rangeLength (Range f t) = t .-. f
-
--- | Range from one @Point@ to another
-till :: Point -> Point -> Range
-l `till` r = Range (min l r) (max l r)
-
--- | Distance in @n@ lines
-linesSize :: Int -> Point
-linesSize n = Point n 0
-
--- | Distance in @n@ chars within one line
-stringSize :: Int -> Point
-stringSize = Point 0
-
-instance ToJSON Range where
-	toJSON (Range f t) = object ["from" .= f, "to" .= t]
-
-instance FromJSON Range where
-	parseJSON = withObject "range" $ \v -> Range <$> v .:: "from" <*> v .:: "to"
-
--- | "Range" height in lines. Any "Range" at least of one line height
-rangeLines :: Range -> Int
-rangeLines r = succ $ pointLine (rangeTo r) - pointLine (rangeFrom r)
-
--- | Is "Range" empty
-emptyRange :: Range -> Bool
-emptyRange r = rangeTo r == rangeFrom r
-
--- | n'th line range, starts at the beginning of line and ends on the next line
-line :: Int -> Range
-line l = range (Point l 0) (Point (succ l) 0)
-
--- | Make range
-range :: Point -> Point -> Range
-range f t = Range (min f t) (max f t)
-
--- | Make range from starting point and its size
-rangeSize :: Point -> Size -> Range
-rangeSize pt sz = range pt (sz .+. pt)
-
--- | Expand range to contain full lines
-expandLines :: Range -> Range
-expandLines (Range (Point sline _) (Point eline _)) = Range (Point sline 0) (Point (succ eline) 0)
-
--- | Get contents at specified range
-at :: Editable a => Contents a -> Range -> Contents a
-at cts r =
-	onHead (snd . splitAt (pointColumn $ rangeFrom r)) .
-	onLast (fst . splitAt (pointColumn $ rangeTo r)) .
-	take (rangeLines r) .
-	drop (pointLine (rangeFrom r)) $
-	cts
-	where
-		onHead :: (a -> a) -> [a] -> [a]
-		onHead _ [] = []
-		onHead f (x:xs) = f x : xs
-		onLast :: (a -> a) -> [a] -> [a]
-		onLast _ [] = []
-		onLast f l@(last -> x) = init l ++ [f x]
-
--- | Main idea is that there are only two basic actions, that chances ranges: inserting and cutting
--- When something is cutted out or inserted in, range positions must be updated
--- All editings can be represented as many cuts and inserts, so we can combine them to get function
--- which maps source ranges to ranges on updated data
--- Because insert is dual to cut (and therefore composes iso), we can also get function to map ranges back
--- Combining this functions while edit, we get function, that maps ranges from source data to edited one
--- To get back function, we must also combine opposite actions, or we can represent actions as isomorphisms
--- Same idea goes for modifying contents, represent each action as isomorphism and combine them together
-newtype Map = Map { mapIso :: Iso' Range Range }
-
-instance Monoid Map where
-	mempty = Map $ iso id id
-	(Map l) `mappend` (Map r) = Map (l . r)
-
--- | Apply mapping
-apply :: Map -> Range -> Range
-apply = view . mapIso
-
--- | Back mapping
-back :: Map -> Map
-back (Map f) = Map (from f)
-
--- | Apply mapping to starting position only
-applyStart :: Map -> Range -> Range
-applyStart m r = rangeFrom (apply m r) `rangeSize` rangeLength r
-
--- | Cut range mapping
-cut :: Range -> Map
-cut rgn = Map $ iso (cutRange rgn) (insertRange rgn)
-
--- | Opposite to "cut"
-insert :: Range -> Map
-insert = back . cut
-
--- | Update second range position as if it was data cutted at first range
-cutRange :: Range -> Range -> Range
-cutRange (Range is ie) (Range s e) = Range
-	(if is < s then (s .-. ie) .+. is else s)
-	(if is < e then (e .-. ie) .+. is else e)
-
--- | Update second range position as if it was data inserted at first range
-insertRange :: Range -> Range -> Range
-insertRange (Range is ie) (Range s e) = Range
-	(if is < s then (s .-. is) .+. ie else s)
-	(if is < e then (e .-. is) .+. ie else e)
-
--- | Contents is list of lines
-type Contents a = [a]
-
--- | Edit data
-data Edit a = Edit {
-	editCts :: Contents a -> Contents a, -- ^ Edit contents splitted by lines
-	editMap :: Map } -- ^ Map range from source contents to edited
-
-instance Monoid (Edit a) where
-	mempty = Edit id mempty
-	(Edit fl ml) `mappend` (Edit fr mr) = Edit (fr . fl) (ml `mappend` mr)
-
--- | Edit monad is state on "Edit", it also collects range mappings
-newtype EditM s a = EditM { runEditM :: State (Edit s) a }
-	deriving (Functor, Applicative, Monad, MonadState (Edit s))
-
--- | Basic edit action in monad
--- It takes range, range edit function and contents updater
--- and passes mapped range to these functions to get new state
-editRange :: Range -> (Range -> Edit a) -> EditM a ()
-editRange rgn edit' = do
-	rgn' <- mapRange rgn
-	modify (`mappend` edit' rgn')
-
--- | Get mapped range
-mapRange :: Range -> EditM a Range
-mapRange rgn = gets (($ rgn) . apply . editMap)
-
--- | Run edit monad
-runEdit :: Editable s => EditM s a -> (a, Edit s)
-runEdit act = runState (runEditM act) mempty
-
--- | Edit contents
-edit :: Editable s => s -> EditM s a -> s
-edit cts = snd . editEval cts
-
--- | Eval edit
-editEval :: Editable s => s -> EditM s a -> (a, s)
-editEval cts act = (v, unlines . editCts st . lines $ cts) where
-	(v, st) = runEdit act
-
--- | Prefix of contents cutted at some point
-data Prefix a = Prefix {
-	prefixLines :: [a],
-	prefixLine :: a }
-		deriving (Eq, Ord, Read, Show)
-
-instance Functor Prefix where
-	fmap f (Prefix ls l) = Prefix (fmap f ls) (f l)
-
--- | Make prefix from full contents
-prefix :: Contents a -> Prefix a
-prefix cts = Prefix (init cts) (last cts)
-
--- | Suffix of contents
-data Suffix a = Suffix {
-	suffixLine :: a,
-	suffixLines :: [a] }
-		deriving (Eq, Ord, Read, Show)
-
-instance Functor Suffix where
-	fmap f (Suffix l ls) = Suffix (f l) (fmap f ls)
-
-suffix :: Contents a -> Suffix a
-suffix cts = Suffix (head cts) (tail cts)
-
--- | Concat prefix and suffix. First line of suffix is appended to last line of prefix
-concatCts :: Monoid a => Prefix a -> Suffix a -> Contents a
-concatCts (Prefix ps p) (Suffix s ss) = ps ++ [p `mappend` s] ++ ss
-
--- | Split contents at point. First argument is function to split one line at position.
-splitCts :: Editable a => Point -> Contents a -> (Prefix a, Suffix a)
-splitCts (Point l c) cts = (Prefix (take l cts) p, Suffix s (drop (succ l) cts)) where
-	(p, s) = splitAt c (cts !! l)
-
-class Monoid a => Editable a where
-	splitAt :: Int -> a -> (a, a)
-	length :: a -> Int
-	lines :: a -> [a]
-	unlines :: [a] -> a
-
-instance Editable String where
-	splitAt = List.splitAt
-	length = List.length
-	lines s = case List.break (== '\n') s of
-		(pre, "") -> [pre]
-		(pre, _:post) -> pre : lines post
-	unlines = List.intercalate "\n"
-
-instance Editable Text where
-	splitAt = T.splitAt
-	length = T.length
-	lines = T.split (== '\n')
-	unlines = T.intercalate "\n"
-
--- | Contents size
-measure :: Editable s => Contents s -> Size
-measure [] = error "Invalid argument"
-measure cts = Point (pred $ List.length cts) (length $ last cts)
-
-class EditAction e where
-	erase :: Editable s => Range -> e s ()
-	write :: Editable s => Point -> s -> e s ()
-	replace :: Editable s => Range -> s -> e s ()
-
-instance EditAction EditM where
-	erase rgn = editRange rgn (\r -> Edit (erase' r) (cut r)) where
-		erase' :: Editable a => Range -> Contents a -> Contents a
-		erase' rgn' cts = fst (splitCts (rangeFrom rgn') cts) `concatCts` snd (splitCts (rangeTo rgn') cts)
-
-	write pt cts = editRange (pt `till` pt) (\r -> Edit (write' r) (insert $ rangeFrom r `rangeSize` measure cts')) where
-		cts' = lines cts
-		write' rgn' origin = prefix (before' `concatCts` suffix cts') `concatCts` after' where
-			(before', after') = splitCts (rangeFrom rgn') origin
-
-	replace rgn cts = erase rgn >> write (rangeFrom rgn) cts
-
--- | Serializable replace action
-data Replace s a = Replace {
-	replaceRange :: Range,
-	replaceWith :: s }
-		deriving (Eq, Read, Show)
-
-instance (Editable s, ToJSON s) => ToJSON (Replace s a) where
-	toJSON (Replace e c) = object ["range" .= e, "contents" .= c]
-
-instance (Editable s, FromJSON s) => FromJSON (Replace s a) where
-	parseJSON = withObject "edit" $ \v -> Replace <$> v .:: "range" <*> v .:: "contents"
-
-instance EditAction Replace where
-	erase rgn = Replace rgn mempty
-	write pt = Replace (range pt pt)
-	replace = Replace
-
--- | Inverted operation - restores previous state
-inverse :: Editable s => Contents s -> Replace s a -> Replace s a
-inverse cts (Replace r s) = Replace (rangeFrom r `rangeSize` measure (lines s)) (unlines $ cts `at` r)
-
--- | Reverse list of operations
-reverseEdits :: Editable s => Contents s -> [Replace s ()] -> [Replace s ()]
-reverseEdits cts rs = map (remap . inverse cts) $ reverse rs where
-	edit' = snd $ runEdit $ run rs
-	remap r = r { replaceRange = editMap edit' `applyStart` replaceRange r }
-
--- | Run replace actions to get monadic action
-run :: Editable s => [Replace s ()] -> EditM s ()
-run = mapM_ (uncurry replace . (replaceRange &&& replaceWith))
src/HsDev/Client/Commands.hs view
@@ -1,969 +1,377 @@ {-# LANGUAGE OverloadedStrings #-}
 
 module HsDev.Client.Commands (
-	commands
-	) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Lens (view, over, preview, each, _Just)
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Catch (try, SomeException(..))
-import Control.Monad.Trans.Maybe
-import Data.Aeson hiding (Result, Error)
-import Data.List
-import Data.Maybe
-import qualified Data.Map as M
-import Data.String (fromString)
-import Data.Text (unpack)
-import qualified Data.Text as T (isInfixOf, isPrefixOf)
-import System.Directory
-import System.FilePath
-import qualified System.Log.Simple.Base as Log
-import Text.Read (readMaybe)
-
-import HsDev.Cache
-import qualified HsDev.Cache.Structured as SC
-import HsDev.Commands
-import qualified HsDev.Database.Async as DB
-import HsDev.Server.Message as M
-import HsDev.Server.Types
-import HsDev.Symbols
-import HsDev.Symbols.Resolve (resolveOne, scopeModule, exportsModule)
-import HsDev.Symbols.Util
-import qualified HsDev.Tools.AutoFix as AutoFix
-import qualified HsDev.Tools.Cabal as Cabal
-import HsDev.Tools.Ghc.Worker
-import qualified HsDev.Tools.Ghc.Check as Check
-import qualified HsDev.Tools.Ghc.Types as Types
-import qualified HsDev.Tools.GhcMod as GhcMod
-import qualified HsDev.Tools.Hayoo as Hayoo
-import qualified HsDev.Tools.HLint as HLint
-import qualified HsDev.Tools.Types as Tools
-import HsDev.Util
-
-import Control.Concurrent.Util
-import System.Console.Cmd
-
-import qualified HsDev.Database.Update as Update
-
--- | Client commands
-commands :: [Cmd CommandAction]
-commands = [
-	-- Ping command
-	cmd' "ping" [] [] "ping server" ping',
-	cmd' "listen" [] [] "listen server log" listen',
-	-- Database commands
-	cmd' "add" [] [dataArg] "add info to database" add',
-	cmd' "scan" [] (sandboxes ++ [
-		manyReq $ projectArg `desc` "project path or .cabal",
-		manyReq $ fileArg `desc` "source file",
-		manyReq $ pathArg `desc` "directory to scan for files and projects",
-		dataArg `desc` "files contents in format {<path>:<contents>, ...}",
-		ghcOpts, docsFlag, inferFlag])
-		"scan sources"
-		scan',
-	cmd' "docs" [] [
-		manyReq $ projectArg `desc` "project path or .cabal",
-		manyReq $ fileArg `desc` "source file",
-		manyReq $ moduleArg `desc` "module name"]
-		"scan docs"
-		docs',
-	cmd' "infer" [] ([
-		manyReq $ projectArg `desc` "project path or .cabal",
-		manyReq $ fileArg `desc` "source file",
-		manyReq $ moduleArg `desc` "module name"] ++ autoScanOpts)
-		"infer types for specified modules"
-		infer',
-	cmdList' "remove" [] (sandboxes ++ [
-		projectArg `desc` "module project",
-		fileArg `desc` "module source file",
-		moduleArg,
-		packageArg, noLastArg, packageVersionArg,
-		allFlag "remove all"])
-		"remove modules info"
-		remove',
-	-- Context free commands
-	cmdList' "modules" [] (sandboxes ++ [
-		manyReq $ projectArg `desc` "projects to list modules from",
-		moduleArg,
-		depsArg,
-		noLastArg,
-		manyReq packageArg,
-		sourced, standaloned])
-		"list modules"
-		listModules',
-	cmdList' "packages" [] [] "list packages" listPackages',
-	cmdList' "projects" [] [] "list projects" listProjects',
-	cmdList' "sandboxes" [] [] "list sandboxes" listSandboxes',
-	cmdList' "symbol" ["name"] (matches ++ sandboxes ++ [
-		projectArg `desc` "related project",
-		fileArg `desc` "source file",
-		moduleArg, localsArg,
-		packageArg, depsArg, noLastArg, packageVersionArg,
-		sourced, standaloned] ++ autoScanOpts)
-		"get symbol info"
-		symbol',
-	cmd' "module" [] (sandboxes ++ [
-		moduleArg, localsArg,
-		packageArg, depsArg, noLastArg, packageVersionArg,
-		projectArg `desc` "module project",
-		fileArg `desc` "module source file",
-		sourced] ++ autoScanOpts)
-		"get module info"
-		modul',
-	cmd' "resolve" [] (sandboxes ++ [
-		moduleArg, localsArg,
-		projectArg `desc` "module project",
-		fileArg `desc` "module source file",
-		exportsArg] ++ autoScanOpts)
-		"resolve module scope (or exports)"
-		resolve',
-	cmd' "project" [] ([
-		projectArg `desc` "project path or name",
-		pathArg `desc` "locate project in parent of this path"] ++ autoScanOpts)
-		"get project info"
-		project',
-	cmd' "sandbox" [] [
-		pathArg `desc` "locate sandbox in parent of this path"]
-		"get sandbox info"
-		sandbox',
-	-- Context commands
-	cmdList' "lookup" ["symbol"] ctx "lookup for symbol" lookup',
-	cmdList' "whois" ["symbol"] ctx "get info for symbol" whois',
-	cmdList' "scope modules" [] ctx "get modules accessible from module or within a project" scopeModules',
-	cmdList' "scope" [] (ctx ++ matches ++ [globalArg]) "get declarations accessible from module or within a project" scope',
-	cmdList' "complete" ["input"] (ctx ++ [wideArg]) "show completions for input" complete',
-	-- Tool commands
-	cmdList' "hayoo" ["query"] hayooArgs "find declarations online via Hayoo" hayoo',
-	cmdList' "cabal list" ["packages..."] [] "list cabal packages" cabalList',
-	cmdList' "lint" ["files..."] ([dataArg] ++ autoScanOpts) "lint source files or file contents" lint',
-	cmdList' "check" ["files..."] ([dataArg, sandboxArg, ghcOpts] ++ autoScanOpts) "check source files or file contents" check',
-	cmdList' "check-lint" ["files..."] ([dataArg, sandboxArg, ghcOpts] ++ autoScanOpts) "check and lint source files or file contents" checkLint',
-	cmdList' "types" ["file"] ([dataArg, sandboxArg, ghcOpts] ++ autoScanOpts) "get types for file expressions" types',
-	cmdList' "ghc-mod lang" [] [] "get LANGUAGE pragmas" ghcmodLang',
-	cmdList' "ghc-mod flags" [] [] "get OPTIONS_GHC pragmas" ghcmodFlags',
-	cmdList' "ghc-mod type" ["line", "column"] (ctx ++ [ghcOpts]) "infer type with 'ghc-mod type'" ghcmodType',
-	cmdList' "ghc-mod check" ["files..."] ([sandboxArg, ghcOpts] ++ autoScanOpts) "check source files" ghcmodCheck',
-	cmdList' "ghc-mod lint" ["files..."] ([hlintOpts] ++ autoScanOpts) "lint source files" ghcmodLint',
-	cmdList' "ghc-mod check-lint" ["files..."] ([sandboxArg, ghcOpts, hlintOpts] ++ autoScanOpts) "check & lint source files" ghcmodCheckLint',
-	-- Autofix
-	cmd' "autofix show" [] [dataArg] "generate corrections for check & lint messages" autofixShow',
-	cmd' "autofix fix" [] [dataArg, restMsgsArg, pureArg] "fix errors and return rest corrections with updated regions" autofixFix',
-	-- Ghc commands
-	cmdList' "ghc eval" ["expr..."] [] "evaluate expression" ghcEval',
-	-- Dump/load commands
-	cmd' "dump" [] (sandboxes ++ [
-		cacheDir, cacheFile,
-		manyReq $ projectArg `desc` "project",
-		manyReq $ fileArg `desc` "file",
-		standaloned,
-		allFlag "dump all"])
-		"dump database info" dump',
-	cmd' "load" [] [cacheDir, cacheFile, dataArg] "load data" load',
-	-- Link
-	cmd' "link" [] [holdArg] "link to server" link',
-	-- Exit
-	cmd' "exit" [] [] "exit" exit']
-	where
-		cmd' :: ToJSON a => String -> [String] -> [Opt] -> String -> ([String] -> Opts String -> CommandActionT a) -> Cmd CommandAction
-		cmd' nm pos named descr act = checkPosArgs $ cmd nm pos named descr act' where
-			act' (Args args os) copts = Log.scopeLog (commandLogger copts) (fromString nm) $ do
-				r <- runExceptT (act args os copts)
-				case r of
-					Left (CommandError e ds) -> return $ Error e $ M.fromList $ map (first unpack) ds
-					Right r' -> return $ Result $ toJSON r'
-
-		cmdList' :: ToJSON a => String -> [String] -> [Opt] -> String -> ([String] -> Opts String -> CommandActionT [a]) -> Cmd CommandAction
-		cmdList' nm pos named descr act = cmd' nm pos (named ++ [splitRes]) descr act' where
-			splitRes = flag "split-result" `desc` "split result list and return it with notifications"
-			act' args os copts = do
-				rs <- act args os' copts
-				if flagSet "split-result" isSplit
-					then do
-						liftIO $ mapM_ (commandNotify copts . resultPart) rs
-						return []
-					else return rs
-				where
-					(isSplit, os') = splitOpts [splitRes] os
-
-		-- Command arguments and flags
-		allFlag d = flag "all" `short` ['a'] `desc` d
-		autoScanFlag = flag "autoscan" `short` ['s'] `desc` "automatically scan related files/projects"
-		autoScanOpts = [autoScanFlag, ghcOpts]
-		cacheDir = req "cache-dir" "path" `desc` "cache path"
-		cacheFile = req "cache-file" "path" `desc` "cache file"
-		ctx = [fileArg `desc` "source file", sandboxArg]
-		dataArg = req "data" "contents" `desc` "data to pass to command"
-		depsArg = req "deps" "object" `desc` "filter to such that in dependency of specified object (file or project)"
-		docsFlag = flag "docs" `desc` "scan source file docs"
-		exportsArg = flag "exports" `short` ['e'] `desc` "resolve module exports"
-		fileArg = req "file" "path" `short` ['f']
-		findArg = req "find" "query" `desc` "infix match"
-		ghcOpts = list "ghc" "option" `short` ['g'] `desc` "options to pass to GHC"
-		globalArg = flag "global" `desc` "scope of project"
-		hayooArgs = [
-			req "page" "n" `short` ['p'] `desc` "page number (0 by default)",
-			req "pages" "count" `short` ['n'] `desc` "pages count (1 by default)"]
-		hlintOpts = list "hlint" "option" `short` ['h'] `desc` "options to pass to hlint"
-		holdArg = flag "hold" `short` ['h'] `desc` "don't return any response"
-		inferFlag = flag "infer" `desc` "infer types"
-		localsArg = flag "locals" `short` ['l'] `desc` "look in local declarations"
-		matches = [prefixArg, findArg]
-		moduleArg = req "module" "name" `short` ['m'] `desc` "module name"
-		noLastArg = flag "no-last" `desc` "select not only last version packages"
-		packageArg = req "package" "name" `desc` "module package"
-		pathArg = req "path" "path" `short` ['p']
-		prefixArg = req "prefix" "prefix" `desc` "prefix match"
-		projectArg = req "project" "project"
-		packageVersionArg = req "version" "id" `short` ['v'] `desc` "package version"
-		pureArg = flag "pure" `desc` "don't modify actual file, just return result"
-		restMsgsArg = req "rest" "corrections" `short` ['r'] `desc` "corrections left unfixed to update locations"
-		sandboxArg = req "sandbox" "path" `desc` "path to cabal sandbox"
-		sandboxList = manyReq sandboxArg
-		sandboxes = [
-			flag "cabal" `desc` "cabal",
-			sandboxList]
-		sourced = flag "src" `desc` "source files"
-		standaloned = flag "stand" `desc` "standalone files"
-		wideArg = flag "wide" `short` ['f'] `desc` "wide mode - complete as if there were no import lists"
-
-		-- | Ping server
-		ping' :: [String] -> Opts String -> CommandActionT Value
-		ping' _ _ _ = return $ object ["message" .= ("pong" :: String)]
-
-		-- | Listen server log
-		listen' :: [String] -> Opts String -> CommandActionT ()
-		listen' _ _ copts = liftIO $ commandListenLog copts $
-			mapM_ (\msg -> commandNotify copts (Notification $ object ["message" .= msg]))
-
-		-- | Add data
-		add' :: [String] -> Opts String -> CommandActionT ()
-		add' _ as copts = do
-			dbval <- getDb copts
-			jsonData <- maybe (commandError "Specify --data" []) return $ arg "data" as
-			decodedData <- either
-				(\err -> commandError "Unable to decode data" [
-					"why" .= err,
-					"data" .= jsonData])
-				return $
-				eitherDecode $ toUtf8 jsonData
-
-			let
-				updateData (ResultDatabase db) = DB.update (dbVar copts) $ return db
-				updateData (ResultDeclaration d) = commandError "Can't insert declaration" ["declaration" .= d]
-				updateData (ResultModuleDeclaration md) = do
-					let
-						ModuleId mname mloc = view declarationModuleId md
-						defMod = Module mname Nothing mloc mempty mempty mempty
-						defInspMod = Inspected InspectionNone mloc (Right defMod)
-						dbmod = maybe
-							defInspMod
-							(over inspectionResult (<|> Right defMod)) $
-							M.lookup mloc (databaseModules dbval)
-						updatedMod = over inspectionResult (fmap $ addDeclaration (view moduleDeclaration md)) 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 mempty)
-				updateData (ResultModule m) = DB.update (dbVar copts) $ return $ fromModule $ Inspected InspectionNone (view 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 ResultNone = return ()
-				updateData _ = commandError "Invalid data" []
-			updateData decodedData
-
-		-- | Scan sources and installed packages
-		scan' :: [String] -> Opts String -> CommandActionT ()
-		scan' _ as copts = do
-			cabals <- getSandboxes copts as
-			let
-				getData :: String -> CommandM [(FilePath, String)]
-				getData d =
-					either
-						(\err -> commandError "Unable to decode data" [
-							"why" .= err,
-							"data" .= d])
-						(return . M.toList) .
-					eitherDecode . toUtf8 $ d
-			ctsFiles <- traverse getData $ arg "data" as
-			updateProcess copts as $ concat [
-				map (\(f, cts) -> Update.scanFileContents (listArg "ghc" as) f (Just cts)) (fromMaybe [] ctsFiles),
-				concatMap (\(n, f) -> [findPath copts v >>= f (listArg "ghc" as) | v <- listArg n as]) [
-					("project", Update.scanProject),
-					("file", Update.scanFile),
-					("path", Update.scanDirectory)],
-				map (Update.scanCabal (listArg "ghc" as)) cabals]
-
-		-- | Scan docs
-		docs' :: [String] -> Opts String -> CommandActionT ()
-		docs' _ as copts = do
-			files <- traverse (findPath copts) $ listArg "file" as
-			projects <- traverse (findProject copts) $ listArg "project" as
-			dbval <- getDb copts
-			let
-				filters = anyOf $
-					map inProject projects ++
-					map inFile files ++
-					map inModule (listArg "module" as)
-				mods = selectModules (filters . view moduleId) dbval
-			updateProcess copts as [Update.scanDocs $ map (getInspected dbval) mods]
-
-		-- | Infer types
-		infer' :: [String] -> Opts String -> CommandActionT ()
-		infer' _ as copts = do
-			files <- traverse (findPath copts) $ listArg "file" as
-			projects <- traverse (findProject copts) $ listArg "project" as
-			autoScan as copts files projects
-			dbval <- getDb copts
-			let
-				filters = anyOf $
-					map inProject projects ++
-					map inFile files ++
-					map inModule (listArg "module" as)
-				mods = selectModules (filters . view moduleId) dbval
-			updateProcess copts as [Update.inferModTypes $ map (getInspected dbval) mods]
-			
-		-- | Remove data
-		remove' :: [String] -> Opts String -> CommandActionT [ModuleId]
-		remove' _ as copts = do
-			dbval <- getDb copts
-			cabal <- getCabal_ copts as
-			proj <- traverse (findProject copts) $ arg "project" as
-			file <- traverse (findPath copts) $ arg "file" as
-			let
-				cleanAll = flagSet "all" as
-				filters = catMaybes [
-					fmap inProject proj,
-					fmap inFile file,
-					fmap inModule (arg "module" as),
-					fmap inPackage (arg "package" as),
-					fmap inVersion (arg "version" as),
-					fmap inCabal cabal]
-				toClean = newest as $ filter (allOf filters . view moduleId) (allModules dbval)
-				action
-					| null filters && cleanAll = liftIO $ do
-						DB.modifyAsync (dbVar copts) DB.Clear
-						return []
-					| null filters && not cleanAll = commandError "Specify filter or explicitely set flag --all" []
-					| cleanAll = commandError "--all flag can't be set with filters" []
-					| otherwise = liftIO $ do
-						DB.modifyAsync (dbVar copts) $ DB.Remove $ mconcat $ map (fromModule . getInspected dbval) toClean
-						return $ map (view moduleId) toClean
-			action
-
-		-- | List modules
-		listModules' :: [String] -> Opts String -> CommandActionT [ModuleId]
-		listModules' _ as copts = do
-			dbval <- getDb copts
-			projs <- traverse (findProject copts) $ listArg "project" as
-			deps <- traverse (findDep copts) $ listArg "deps" as
-			cabals <- getSandboxes copts as
-			let
-				packages = listArg "package" as
-				hasFilters = not $ null projs && null packages && null cabals && null deps
-				filters = allOf $ catMaybes [
-					if hasFilters
-						then Just $ anyOf $ catMaybes [
-							if null projs then Nothing else Just (\m -> any (`inProject` m) projs),
-							if null deps then Nothing else Just (\m -> any (`inDeps` m) deps),
-							if null packages && null cabals then Nothing
-								else Just (\m -> (any (`inPackage` m) packages || null packages) && (any (`inCabal` m) cabals || null cabals))]
-						else Nothing,
-					fmap (\n m -> fromString n == view moduleIdName m) $ arg "module" as,
-					if flagSet "src" as then Just byFile else Nothing,
-					if flagSet "stand" as then Just standalone else Nothing]
-			return $ map (view moduleId) $ newest as $ selectModules (filters . view moduleId) dbval
-
-		-- | List packages
-		listPackages' :: [String] -> Opts String -> CommandActionT [ModulePackage]
-		listPackages' _ _ copts = do
-			dbval <- getDb copts
-			return $ ordNub $ sort $
-				mapMaybe (preview (moduleLocation . modulePackage . _Just)) $
-				allModules dbval
-
-		-- | List projects
-		listProjects' :: [String] -> Opts String -> CommandActionT [Project]
-		listProjects' _ _ copts = do
-			dbval <- getDb copts
-			return $ M.elems $ databaseProjects dbval
-
-		-- | List sandboxes
-		listSandboxes' :: [String] -> Opts String -> CommandActionT [Cabal]
-		listSandboxes' _ _ copts = (ordNub . sort . mapMaybe (cabalOf . view moduleId) . allModules) <$> getDb copts
-
-		-- | Get symbol info
-		symbol' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		symbol' ns as copts = do
-			dbval <- liftM (localsDatabase as) $ getDb copts
-			proj <- traverse (findProject copts) $ arg "project" as
-			file <- traverse (findPath copts) $ arg "file" as
-			autoScan as copts (maybeToList file) (maybeToList proj)
-			deps <- traverse (findDep copts) $ arg "deps" as
-			cabal <- getCabal_ copts as
-			let
-				filters = checkModule $ allOf $ catMaybes [
-					fmap inProject proj,
-					fmap inFile file,
-					fmap inModule (arg "module" as),
-					fmap inPackage (arg "package" as),
-					fmap inDeps deps,
-					fmap inVersion (arg "version" as),
-					fmap inCabal cabal,
-					if flagSet "src" as then Just byFile else Nothing,
-					if flagSet "stand" as then Just standalone else Nothing]
-				toResult = newest as . filterMatch as . filter filters
-			case ns of
-				[] -> return $ toResult $ allDeclarations dbval
-				[nm] -> liftM toResult $ mapExceptT
-					(liftM $ left (\e -> CommandError ("Can't find symbol: " ++ e) []))
-					(findDeclaration dbval nm)
-				_ -> commandError "Too much arguments" []
-
-		-- | Get module info
-		modul' :: [String] -> Opts String -> CommandActionT Module
-		modul' _ as copts = do
-			dbval <- liftM (localsDatabase as) $ getDb copts
-			proj <- traverse (findProject copts) $ arg "project" as
-			cabal <- getCabal_ copts as
-			file' <- mapExceptT (fmap $ left commandStrMsg) $ traverse (findPath copts) $ arg "file" as
-			autoScan as copts (maybeToList file') (maybeToList proj)
-			deps <- traverse (findDep copts) $ arg "deps" as
-			let
-				filters = allOf $ catMaybes [
-					fmap inProject proj,
-					fmap inCabal cabal,
-					fmap inFile file',
-					fmap inModule (arg "module" as),
-					fmap inPackage (arg "package" as),
-					fmap inDeps deps,
-					fmap inVersion (arg "version" as),
-					if flagSet "src" as then Just byFile else Nothing]
-			rs <- (newest as . filter (filters . view moduleId)) <$> maybe
-				(return $ allModules dbval)
-				(mapCommandErrorStr . findModule dbval)
-				(arg "module" as)
-			case rs of
-				[] -> commandError "Module not found" []
-				[m] -> return m
-				ms' -> commandError "Ambiguous modules" ["modules" .= map (view moduleId) ms']
-
-		-- | Resolve module scope
-		resolve' :: [String] -> Opts String -> CommandActionT Module
-		resolve' _ as copts = do
-			dbval <- liftM (localsDatabase as) $ getDb copts
-			proj <- traverse (findProject copts) $ arg "project" as
-			cabal <- getCabal copts as
-			file' <- mapExceptT (fmap $ left commandStrMsg) $ traverse (findPath copts) $ arg "file" as
-			autoScan as copts (maybeToList file') (maybeToList proj)
-			let
-				filters = allOf $ catMaybes [
-					fmap inProject proj,
-					fmap inFile file',
-					fmap inModule (arg "module" as),
-					Just byFile]
-			rs <- (newest as . filter (filters . view moduleId)) <$> maybe
-				(return $ allModules dbval)
-				(mapCommandErrorStr . findModule dbval)
-				(arg "module" as)
-			let
-				cabaldb = filterDB (restrictCabal cabal) (const True) dbval
-				getScope = if flagSet "exports" as then exportsModule else scopeModule
-			case rs of
-				[] -> commandError "Module not found" []
-				[m] -> return $ getScope $ resolveOne cabaldb m
-				ms' -> commandError "Ambiguous modules" ["modules" .= map (view moduleId) ms']
-
-		-- | Get project info
-		project' :: [String] -> Opts String -> CommandActionT Project
-		project' _ as copts = do
-			proj <- runMaybeT $ do
-				p <- msum $ map MaybeT [
-					traverse (findProject copts) $ arg "project" as,
-					liftM join $ traverse (liftIO . searchProject) $ arg "path" as]
-				lift $ if flagSet "autoscan" as then mapCommandErrorStr (loadProject p) else return p
-			maybe (commandError "Specify project name, .cabal file or search directory" []) return proj
-
-		-- | Locate sandbox
-		sandbox' :: [String] -> Opts String -> CommandActionT Cabal
-		sandbox' _ as _ = do
-			sbox <- traverse (liftIO . searchSandbox) (arg "path" as)
-			maybe (commandError "Specify search directory" []) return sbox
-
-		-- | Lookup info about symbol
-		lookup' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		lookup' [nm] as copts = do
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			mapCommandErrorStr $ lookupSymbol dbval cabal srcFile nm
-		lookup' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Get detailed info about symbol in source file
-		whois' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		whois' [nm] as copts = do
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			mapCommandErrorStr $ whois dbval cabal srcFile nm
-		whois' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Get modules accessible from module or from directory
-		scopeModules' :: [String] -> Opts String -> CommandActionT [ModuleId]
-		scopeModules' [] as copts = do
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			liftM (map (view moduleId)) $ mapCommandErrorStr $ scopeModules dbval cabal srcFile
-		scopeModules' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Get declarations accessible from module
-		scope' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		scope' [] as copts = do
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			liftM (filterMatch as) $ mapCommandErrorStr $ scope dbval cabal srcFile (flagSet "global" as)
-		scope' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Completion
-		complete' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		complete' [] as copts = complete' [""] as copts
-		complete' [input] as copts = do
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			mapCommandErrorStr $ completions dbval cabal srcFile input (flagSet "wide" as)
-		complete' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Hayoo
-		hayoo' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
-		hayoo' [] _ _ = commandError "Query not specified" []
-		hayoo' [query] opts _ = liftM concat $ forM [page .. page + pred pages] $ \i -> liftM
-			(mapMaybe Hayoo.hayooAsDeclaration . Hayoo.resultResult) $
-			mapCommandErrorStr $ Hayoo.hayoo query (Just i)
-			where
-				page = fromMaybe 0 $ narg "page" opts
-				pages = fromMaybe 1 $ narg "pages" opts
-		hayoo' _ _ _ = commandError "Too much arguments" []
-
-		-- | Cabal list
-		cabalList' :: [String] -> Opts String -> CommandActionT [Cabal.CabalPackage]
-		cabalList' qs _ _ = mapCommandErrorStr $ Cabal.cabalList qs
-
-		-- | HLint
-		lint' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		lint' files as copts = case arg "data" as of
-			Nothing -> do
-				files' <- mapM (findPath copts) files
-				autoScan as copts files' []
-				mapCommandErrorStr $ liftM concat $ mapM HLint.hlintFile files'
-			Just src -> do
-				src' <- either
-					(\err -> commandError "Unable to decode data" [
-						"why" .= err,
-						"data" .= src])
-					return $
-					eitherDecode (toUtf8 src)
-				when (length files > 1) $ commandError_ "Only one file permitted when passing source"
-				file' <- traverse (findPath copts) $ listToMaybe files
-				mapCommandErrorStr $ HLint.hlintSource (fromMaybe "<unnamed>" file') src'
-
-		-- | Check
-		check' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		check' files as copts = case arg "data" as of
-			Nothing -> do
-				files' <- mapM (findPath copts) files
-				autoScan as copts files' []
-				db <- getDb copts
-				cabal <- getCabal copts as
-				liftM concat $ forM files' $ \file' -> do
-					m <- maybe
-						(commandError_ $ "File '" ++ file' ++ "' not found, maybe you forgot to scan it?")
-						return $
-						lookupFile file' db
-					notes <- inWorkerWith (commandError_ . show) (commandGhc copts) $
-						(runExceptT $ Check.checkFile (listArg "ghc" as) cabal m)
-					either commandError_ return notes
-			Just src -> do
-				src' <- either
-					(\err -> commandError "Unable to decode data" [
-						"why" .= err,
-						"data" .= src])
-					return $
-					eitherDecode (toUtf8 src)
-				when (length files > 1) $ commandError_ "Only one file permitted when passing source"
-				file' <- maybe (commandError_ "File must be specified") (findPath copts) $ listToMaybe files
-				db <- getDb copts
-				cabal <- getCabal copts as
-				m <- maybe
-					(commandError_ $ "File '" ++ file' ++ "' not found")
-					return $
-					lookupFile file' db
-				notes <- inWorkerWith (commandError_ . show) (commandGhc copts) $
-					(runExceptT $ Check.checkSource (listArg "ghc" as) cabal m src')
-				either commandError_ return notes
-
-		-- | Check and lint
-		checkLint' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		checkLint' files as copts = liftM2 (++) (check' files as copts) (lint' files as copts)
-
-		-- | Types
-		types' :: [String] -> Opts String -> CommandActionT [Tools.Note Types.TypedExpr]
-		types' [file] as copts = do
-			file' <- findPath copts file
-			autoScan as copts [file'] []
-			db <- getDb copts
-			cabal <- getCabal copts as
-			let
-				decodeData src = either
-					(\err -> commandError "Unable to decode data" ["why" .= err, "data" .= src])
-					return $
-					eitherDecode (toUtf8 src)
-			msrc <- traverse decodeData $ arg "data" as
-			m <- maybe
-				(commandError_ $ "File '" ++ file' ++ "' not found")
-				return $
-				lookupFile file' db
-			notes <- inWorkerWith (commandError_ . show) (commandGhc copts) $
-				(runExceptT $ Types.fileTypes (listArg "ghc" as) cabal m msrc)
-			either commandError_ return notes
-		types' _ _ _ = commandError_ "One file must be specified"
-
-		-- | Ghc-mod lang
-		ghcmodLang' :: [String] -> Opts String -> CommandActionT [String]
-		ghcmodLang' _ _ _ = mapCommandErrorStr GhcMod.langs
-
-		-- | Ghc-mod flags
-		ghcmodFlags' :: [String] -> Opts String -> CommandActionT [String]
-		ghcmodFlags' _ _ _ = mapCommandErrorStr GhcMod.flags
-
-		-- | Ghc-mod type
-		ghcmodType' :: [String] -> Opts String -> CommandActionT [GhcMod.TypedRegion]
-		ghcmodType' [line] as copts = ghcmodType' [line, "1"] as copts
-		ghcmodType' [line, column] as copts = do
-			line' <- maybe (commandError "line must be a number" []) return $ readMaybe line
-			column' <- maybe (commandError "column must be a number" []) return $ readMaybe column
-			dbval <- getDb copts
-			(srcFile, cabal) <- getCtx copts as
-			(srcFile', m', _) <- mapCommandErrorStr $ fileCtx dbval srcFile
-			mapCommandErrorStr $ GhcMod.waitMultiGhcMod (commandGhcMod copts) srcFile' $
-				GhcMod.typeOf (listArg "ghc" as ++ moduleOpts (allPackages dbval) m') cabal srcFile' line' column'
-		ghcmodType' [] _ _ = commandError "Specify line" []
-		ghcmodType' _ _ _ = commandError "Too much arguments" []
-
-		-- | Ghc-mod check
-		ghcmodCheck' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		ghcmodCheck' [] _ _ = commandError "Specify at least one file" []
-		ghcmodCheck' files as copts = do
-			files' <- mapM (findPath copts) files
-			autoScan as copts files' []
-			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM locateProject files')
-			cabal <- getCabal copts as
-			dbval <- getDb copts
-			mapCommandErrorStr $ liftM concat $ forM files' $ \file' -> do
-				(_, m', _) <- fileCtx dbval file'
-				GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $
-					GhcMod.check (listArg "ghc" as ++ moduleOpts (allPackages dbval) m') cabal [file'] mproj
-
-		-- | Ghc-mod lint
-		ghcmodLint' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		ghcmodLint' [] _ _ = commandError "Specify at least one file to hlint" []
-		ghcmodLint' files as copts = do
-			files' <- mapM (findPath copts) files
-			autoScan as copts files' []
-			mapCommandErrorStr $ liftM concat $ forM files' $ \file' ->
-				GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $
-					GhcMod.lint (listArg "hlint" as) file'
-
-		-- | Ghc-mod check & lint
-		ghcmodCheckLint' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		ghcmodCheckLint' [] _ _ = commandError "Specify at least one file" []
-		ghcmodCheckLint' files as copts = do
-			files' <- mapM (findPath copts) files
-			autoScan as copts files' []
-			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM locateProject files')
-			cabal <- getCabal copts as
-			dbval <- getDb copts
-			mapCommandErrorStr $ liftM concat $ forM files' $ \file' -> do
-				(_, m', _) <- fileCtx dbval file'
-				GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $ do
-					checked <- GhcMod.check (listArg "ghc" as ++ moduleOpts (allPackages dbval) m') cabal [file'] mproj
-					linted <- GhcMod.lint (listArg "hlint" as) file'
-					return $ checked ++ linted
-
-		-- | Autofix show
-		autofixShow' :: [String] -> Opts String -> CommandActionT [Tools.Note AutoFix.Correction]
-		autofixShow' _ as _ = do
-			jsonData <- maybe (commandError "Specify --data" []) return $ arg "data" as
-			msgs <- either
-				(\err -> commandError "Unable to decode data" [
-					"why" .= err,
-					"data" .= jsonData])
-				return $
-				eitherDecode $ toUtf8 jsonData
-			return $ AutoFix.corrections msgs
-
-		-- | Autofix fix
-		autofixFix' :: [String] -> Opts String -> CommandActionT [Tools.Note AutoFix.Correction]
-		autofixFix' _ as copts = do
-			let
-				readCorrs cts = either
-					(\err -> commandError "Unable to decode data" [
-						"why" .= err,
-						"data" .= cts])
-					return $
-					eitherDecode $ toUtf8 cts
-			jsonData <- maybe (commandError "Specify --data" []) return $ arg "data" as
-			corrs <- readCorrs jsonData
-			upCorrs <- liftM (fromMaybe []) $ traverse readCorrs $ arg "rest" as
-			files <- liftM (ordNub . sort) $ mapM (findPath copts) $ mapMaybe (preview $ Tools.noteSource . moduleFile) corrs
-			let
-				doFix :: FilePath -> AutoFix.EditM String [Tools.Note AutoFix.Correction]
-				doFix file = do
-					AutoFix.autoFix_ fCorrs
-					(each . Tools.note) AutoFix.updateRange fUpCorrs
-					where
-						findCorrs :: FilePath -> [Tools.Note AutoFix.Correction] -> [Tools.Note AutoFix.Correction]
-						findCorrs f = filter ((== Just f) . preview (Tools.noteSource . moduleFile))
-						fCorrs = map (view Tools.note) $ findCorrs file corrs
-						fUpCorrs = findCorrs file upCorrs
-				runFix file
-					| flagSet "pure" as = return $ fst $ AutoFix.runEdit $ doFix file
-					| otherwise = do
-						(corrs', cts') <- liftM (`AutoFix.editEval` doFix file) $ liftE $ readFileUtf8 file
-						liftE $ writeFileUtf8 file cts'
-						return corrs'
-			mapCommandErrorStr $ liftM concat $ mapM runFix files
-
-		-- | Evaluate expression
-		ghcEval' :: [String] -> Opts String -> CommandActionT [Value]
-		ghcEval' exprs _ copts = mapCommandErrorStr $ liftM (map toValue) $ liftTask $
-			pushTask (commandGhci copts) $ mapM (try . evaluate) exprs
-			where
-				toValue :: Either SomeException String -> Value
-				toValue (Left (SomeException e)) = object ["fail" .= show e]
-				toValue (Right s) = toJSON s
-
-		-- | Dump database info
-		dump' :: [String] -> Opts String -> CommandActionT ()
-		dump' [] as copts = do
-			dbval <- getDb copts
-
-			cabals <- getSandboxes copts as
-			ps' <- traverse (findProject copts) $ listArg "project" as
-			fs' <- traverse (findPath copts) $ listArg "file" as
-
-			let
-				dat = mconcat [
-					if flagSet "all" as then dbval else mempty,
-					if flagSet "stand" as then standaloneDB dbval else mempty,
-					mconcat $ map (`cabalDB` dbval) cabals,
-					mconcat $ map (`projectDB` dbval) ps',
-					filterDB (\m -> any (`inFile` m) fs') (const False) dbval]
-
-			void $ runMaybeT $ msum [
-				do
-					p <- MaybeT $ traverse (findPath copts) $ arg "path" as
-					fork $ SC.dump p $ structurize dat,
-				do
-					f <- MaybeT $ traverse (findPath copts) $ arg "file" as
-					fork $ dump f dat]
-		dump' _ _ _ = commandError "Invalid arguments" []
-
-		-- | Load database
-		load' :: [String] -> Opts String -> CommandActionT ()
-		load' _ as copts = do
-			void $ liftM (maybe (commandError "Specify one of: --path, --file or --data" []) return) $ runMaybeT $ msum [
-				do
-					p <- MaybeT $ return $ arg "path" as
-					lift $ cacheLoad copts (liftA merge <$> SC.load p),
-				do
-					f <- MaybeT $ return $ arg "file" as
-					e <- liftIO $ doesFileExist f
-					when e $ lift $ cacheLoad copts (load f),
-				do
-					dat <- MaybeT $ return $ arg "data" as
-					lift $ cacheLoad copts (return $ eitherDecode (toUtf8 dat))]
-			waitDb copts as
-
-		-- | Link to server
-		link' :: [String] -> Opts String -> CommandActionT ()
-		link' _ as copts = liftIO $ do
-			commandLink copts
-			when (flagSet "hold" as) $ commandHold copts
-
-		-- | Exit
-		exit' :: [String] -> Opts String -> CommandActionT ()
-		exit' _ _ copts = liftIO $ commandExit copts
-
--- Helper functions
-
-commandStrMsg :: String -> CommandError
-commandStrMsg m = CommandError m []
-
--- | Automatically scan files and projects
-autoScan :: Opts String -> CommandOptions -> [FilePath] -> [Project] -> CommandM ()
-autoScan as copts srcs projs
-	| flagSet "autoscan" as = updateProcess copts as $
-		concatMap (\(n, f) -> [findPath copts v >>= f (listArg "ghc" as) | v <- n]) [
-			(srcs, Update.scanFile),
-			(map (view projectCabal) projs, Update.scanProject)]
-	| otherwise = return ()
-
--- | Check positional args count
-checkPosArgs :: Cmd a -> Cmd a
-checkPosArgs c = validateArgs pos' c where
-	pos' (Args args _) = case cmdArgs c of
-		[ellipsis]
-			| "..." `isSuffixOf` ellipsis -> return ()
-		_ -> mplus
-			(guard (length args <= length (cmdArgs c)))
-			(failMatch ("unexpected positional arguments: " ++ unwords (drop (length $ cmdArgs c) args)))
-
--- | Find sandbox by path
-findSandbox :: MonadIO m => CommandOptions -> Maybe FilePath -> ExceptT CommandError m Cabal
-findSandbox copts = maybe
-	(return Cabal)
-	(findPath copts >=> mapCommandErrorStr . liftIO . getSandbox)
-
--- | Canonicalize path
-findPath :: MonadIO m => CommandOptions -> FilePath -> ExceptT e m FilePath
-findPath copts f = liftIO $ canonicalizePath (normalise f') where
-	f'
-		| isRelative f = commandRoot copts </> f
-		| otherwise = f
-
--- | Get context: file and sandbox
-getCtx :: (MonadIO m, Functor m) => CommandOptions -> Opts String -> ExceptT CommandError m (FilePath, Cabal)
-getCtx copts as = do
-	f <- forceJust "No file specified" $ traverse (findPath copts) $ arg "file" as
-	c <- getCabal_ copts as >>= maybe (liftIO $ getSandbox f) return
-	return (f, c)
-
--- | Get current sandbox set, user-db by default
-getCabal :: MonadIO m => CommandOptions -> Opts String -> ExceptT CommandError m Cabal
-getCabal copts as
-	| flagSet "cabal" as = findSandbox copts Nothing
-	| otherwise  = findSandbox copts $ arg "sandbox" as
-
--- | Get current sandbox if set
-getCabal_ :: (MonadIO m, Functor m) => CommandOptions -> Opts String -> ExceptT CommandError m (Maybe Cabal)
-getCabal_ copts as
-	| flagSet "cabal" as = Just <$> findSandbox copts Nothing
-	| otherwise = case arg "sandbox" as of
-		Just f -> Just <$> findSandbox copts (Just f)
-		Nothing -> return Nothing
-
--- | Get list of enumerated sandboxes
-getSandboxes :: (MonadIO m, Functor m) => CommandOptions -> Opts String -> ExceptT CommandError m [Cabal]
-getSandboxes copts as = traverse (findSandbox copts) paths where
-	paths
-		| flagSet "cabal" as = Nothing : sboxes
-		| otherwise = sboxes
-	sboxes = map Just $ listArg "sandbox" as
-
--- | Find project by name of path
-findProject :: MonadIO m => CommandOptions -> String -> ExceptT CommandError m Project
-findProject copts proj = do
-	db' <- getDb copts
-	proj' <- liftM addCabal $ findPath copts proj
-	let
-		resultProj =
-			M.lookup proj' (databaseProjects db') <|>
-			find ((== proj) . view projectName) (M.elems $ databaseProjects db')
-	maybe (throwError $ commandStrMsg $ "Projects " ++ proj ++ " not found") return resultProj
-	where
-		addCabal p
-			| takeExtension p == ".cabal" = p
-			| otherwise = p </> (takeBaseName p <.> "cabal")
-
--- | Find dependency: it may be source, project file or project name, also returns sandbox found
-findDep :: MonadIO m => CommandOptions -> String -> ExceptT CommandError m (Project, Maybe FilePath, Cabal)
-findDep copts depName = do
-	depPath <- findPath copts depName
-	proj <- msum [
-		mapCommandErrorStr $ do
-			p <- liftIO (locateProject depPath)
-			maybe (throwError $ "Project " ++ depName ++ " not found") (mapExceptT liftIO . loadProject) p,
-		findProject copts depName]
-	let
-		src
-			| takeExtension depPath == ".hs" = Just depPath
-			| otherwise = Nothing
-	sbox <- liftIO $ searchSandbox $ view projectPath proj
-	return (proj, src, sbox)
-
--- | Check if project or source depends from this module
-inDeps :: (Project, Maybe FilePath, Cabal) -> ModuleId -> Bool
-inDeps (proj, src, cabal) = liftM2 (&&) (restrictCabal cabal) deps' where
-	deps' = case src of
-		Nothing -> inDepsOfProject proj
-		Just src' -> inDepsOfFile proj src'
-
--- | Wait for DB to complete update
-waitDb :: CommandOptions -> Opts String -> CommandM ()
-waitDb copts as = when (flagSet "wait" as) $ liftIO $ do
-	commandLog copts Log.Trace "wait for db"
-	DB.wait (dbVar copts)
-	commandLog copts Log.Trace "db done"
-
-cacheLoad :: CommandOptions -> IO (Either String Database) -> CommandM ()
-cacheLoad copts act = liftIO $ do
-	db' <- act
-	case db' of
-		Left e -> commandLog copts Log.Error e
-		Right database -> DB.update (dbVar copts) (return database)
-
--- | Bring locals to top scope to search within them if 'locals' flag set
-localsDatabase :: Opts String -> Database -> Database
-localsDatabase as
-	| flagSet "locals" as = databaseLocals
-	| otherwise = id
-
--- | Select newest packages if 'no-last' flag not set
-newest :: Symbol a => Opts String -> [a] -> [a]
-newest as
-	| flagSet "no-last" as = id
-	| otherwise = newestPackage
-
--- | Convert from just of throw
-forceJust :: MonadIO m => String -> ExceptT CommandError m (Maybe a) -> ExceptT CommandError m a
-forceJust msg act = act >>= maybe (throwError $ commandStrMsg msg) return
-
--- | Get actual DB state
-getDb :: MonadIO m => CommandOptions -> m Database
-getDb = liftIO . DB.readAsync . commandDatabase
-
--- | Get DB async var
-dbVar :: CommandOptions -> DB.Async Database
-dbVar = commandDatabase
-
-mapCommandErrorStr :: (Monad m) => ExceptT String m a -> ExceptT CommandError m a
-mapCommandErrorStr = mapExceptT (liftM $ left commandStrMsg)
-
--- | Run DB update action
-updateProcess :: CommandOptions -> Opts String -> [ExceptT String (Update.UpdateDB IO) ()] -> CommandM ()
-updateProcess copts as acts = lift $ Update.updateDB (Update.settings copts as) $ sequence_ [act `catchError` logErr | act <- acts] where
-	logErr :: String -> ExceptT String (Update.UpdateDB IO) ()
-	logErr e = liftIO $ commandLog copts Log.Error e
-
--- | Filter declarations with prefix and infix
-filterMatch :: Opts String -> [ModuleDeclaration] -> [ModuleDeclaration]
-filterMatch as = findMatch as . prefMatch as
-
--- | Filter declarations with infix match
-findMatch :: Opts String -> [ModuleDeclaration] -> [ModuleDeclaration]
-findMatch as = case arg "find" as of
-	Nothing -> id
-	Just str -> filter (match' str)
-	where
-		match' str m = fromString str `T.isInfixOf` view (moduleDeclaration . declarationName) m
-
--- | Filter declarations with prefix match
-prefMatch :: Opts String -> [ModuleDeclaration] -> [ModuleDeclaration]
-prefMatch as = case fmap splitIdentifier (arg "prefix" as) of
-	Nothing -> id
-	Just (qname, pref) -> filter (match' qname pref)
-	where
-		match' qname pref m =
-			fromString pref `T.isPrefixOf` view (moduleDeclaration . declarationName) m &&
-			maybe True (view (declarationModuleId . moduleIdName) m ==) (fmap fromString qname)
+	runCommand
+	) where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Lens (view, preview, _Just, from, each)
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.State (gets)
+import Control.Monad.Catch (try, SomeException(..))
+import Data.Aeson hiding (Result, Error)
+import Data.List
+import Data.Foldable (toList)
+import Data.Maybe
+import qualified Data.Map as M
+import Data.String (fromString)
+import Data.Text (unpack)
+import Data.Text.Lens (packed)
+import qualified Data.Text as T (isInfixOf, isPrefixOf, isSuffixOf)
+import System.Directory
+import System.FilePath
+import qualified System.Log.Simple.Base as Log
+import Text.Regex.PCRE ((=~))
+
+import System.Directory.Paths
+import HsDev.Cache
+import HsDev.Commands
+import qualified HsDev.Database.Async as DB
+import HsDev.Server.Message as M
+import HsDev.Server.Types
+import HsDev.Symbols
+import HsDev.Symbols.Resolve (resolveOne, scopeModule, exportsModule)
+import HsDev.Symbols.Util
+import qualified HsDev.Tools.AutoFix as AutoFix
+import qualified HsDev.Tools.Cabal as Cabal
+import HsDev.Tools.Ghc.Worker
+import qualified HsDev.Tools.Ghc.Check as Check
+import qualified HsDev.Tools.Ghc.Types as Types
+import qualified HsDev.Tools.GhcMod as GhcMod
+import qualified HsDev.Tools.Hayoo as Hayoo
+import qualified HsDev.Tools.HLint as HLint
+import qualified HsDev.Tools.Types as Tools
+import HsDev.Util
+
+import qualified HsDev.Database.Update as Update
+
+runCommandM :: ToJSON a => CommandM a -> IO Result
+runCommandM = liftM toResult . runExceptT where
+	toResult (Left (CommandError e ds)) = Error e $ M.fromList $ map (first unpack) ds
+	toResult (Right r') = Result $ toJSON r'
+
+-- | Run command
+runCommand :: CommandOptions -> Command -> IO Result
+runCommand copts Ping = runCommandM $ return $ object ["message" .= ("pong" :: String)]
+runCommand copts Listen = runCommandM $ liftIO $ commandListenLog copts $
+	mapM_ (\msg -> commandNotify copts (Notification $ object ["message" .= msg]))
+runCommand copts (AddData cts) = runCommandM $ mapM_ updateData cts where
+	updateData (AddedDatabase db) = DB.update (dbVar copts) $ return db
+	updateData (AddedModule m) = DB.update (dbVar copts) $ return $ fromModule m
+	updateData (AddedProject p) = DB.update (dbVar copts) $ return $ fromProject p
+runCommand copts (Scan projs cabals fs paths fcts ghcs' docs' infer') = runCommandM $ do
+	sboxes <- getSandboxes copts cabals
+	updateProcess copts ghcs' docs' infer' $ concat [
+		map (\(FileContents f cts) -> Update.scanFileContents ghcs' f (Just cts)) fcts,
+		map (Update.scanProject ghcs') projs,
+		map (Update.scanFile ghcs') fs,
+		map (Update.scanDirectory ghcs') paths,
+		map (Update.scanCabal ghcs') sboxes]
+runCommand copts (RefineDocs projs fs ms) = runCommandM $ do
+	projects <- traverse (findProject copts) projs
+	dbval <- getDb copts
+	let
+		filters = anyOf $ concat [
+			map inProject projects,
+			map inFile fs,
+			map inModule ms]
+		mods = selectModules (filters . view moduleId) dbval
+	updateProcess copts [] False False [Update.scanDocs $ map (getInspected dbval) mods]
+runCommand copts (InferTypes projs fs ms) = runCommandM $ do
+	projects <- traverse (findProject copts) projs
+	dbval <- getDb copts
+	let
+		filters = anyOf $ concat [
+			map inProject projects,
+			map inFile fs,
+			map inModule ms]
+		mods = selectModules (filters . view moduleId) dbval
+	updateProcess copts [] False False [Update.inferModTypes $ map (getInspected dbval) mods]
+runCommand copts (Remove projs packages cabals fs) = undefined
+runCommand copts (InfoModules f) = runCommandM $ do
+	dbval <- getDb copts
+	filter' <- targetFilter copts f
+	return $ map (view moduleId) $ newestPackage $ selectModules (filter' . view moduleId) dbval
+runCommand copts InfoPackages = runCommandM $
+	(ordNub . sort . 	mapMaybe (preview (moduleLocation . modulePackage . _Just)) . allModules) <$> getDb copts
+runCommand copts InfoProjects = runCommandM $ (toList . databaseProjects) <$> getDb copts
+runCommand copts InfoSandboxes = runCommandM $
+	(ordNub . sort . mapMaybe (cabalOf . view moduleId) . allModules) <$> getDb copts
+runCommand copts (InfoSymbol sq f) = runCommandM $ do
+	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
+	filter' <- targetFilter copts f
+	return $ newestPackage $ filterMatch sq $ filter (checkModule filter') $ allDeclarations dbval
+runCommand copts (InfoModule sq f) = runCommandM $ do
+	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
+	filter' <- targetFilter copts f
+	return $ newestPackage $ filterMatch sq $ filter (filter' . view moduleId) $ allModules dbval
+runCommand copts (InfoResolve fpath exports) = runCommandM $ do
+	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
+	cabal <- liftIO $ getSandbox fpath
+	let
+		cabaldb = filterDB (restrictCabal cabal) (const True) dbval
+		getScope
+			| exports = exportsModule
+			| otherwise = scopeModule
+	case lookupFile fpath dbval of
+		Nothing -> commandError "File not found" []
+		Just m -> return $ getScope $ resolveOne cabaldb m
+runCommand copts (InfoProject (Left projName)) = runCommandM $ findProject copts projName
+runCommand copts (InfoProject (Right projPath)) = runCommandM $ liftIO $ searchProject projPath
+runCommand copts (InfoSandbox sandbox) = runCommandM $ liftIO $ searchSandbox sandbox
+runCommand copts (Lookup nm fpath) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	mapCommandErrorStr $ lookupSymbol dbval cabal fpath nm
+runCommand copts (Whois nm fpath) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	mapCommandErrorStr $ whois dbval cabal fpath nm
+runCommand copts (ResolveScopeModules fpath) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	liftM (map (view moduleId)) $ mapCommandErrorStr $ scopeModules dbval cabal fpath
+runCommand copts (ResolveScope sq global fpath) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	liftM (filterMatch sq) $ mapCommandErrorStr $ scope dbval cabal fpath global
+runCommand copts (Complete input wide fpath) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	mapCommandErrorStr $ completions dbval cabal fpath input wide
+runCommand copts (Hayoo hq p ps) = runCommandM $ liftM concat $ forM [p .. p + pred ps] $ \i -> liftM
+	(mapMaybe Hayoo.hayooAsDeclaration . Hayoo.resultResult) $
+	mapCommandErrorStr $ Hayoo.hayoo hq (Just i)
+runCommand copts (CabalList packages) = runCommandM $ mapCommandErrorStr $ Cabal.cabalList packages
+runCommand copts (Lint fs fcts) = runCommandM $ do
+	mapCommandErrorStr $ liftM2 (++)
+		(liftM concat $ mapM HLint.hlintFile fs)
+		(liftM concat $ mapM (\(FileContents f c) -> HLint.hlintSource f c) fcts)
+runCommand copts (Check fs fcts ghcs') = runCommandM $ do
+	db <- getDb copts
+	let
+		checkSome file fn = do
+			cabal <- liftIO $ getSandbox file
+			m <- maybe
+				(commandError_ $ "File '" ++ file ++ "' not found")
+				return
+				(lookupFile file db)
+			notes <- inWorkerWith (commandError_ . show) (commandGhc copts)
+				(runExceptT $ fn cabal m)
+			either commandError_ return notes
+	liftM concat $ mapM (uncurry checkSome) $
+		[(f, Check.checkFile ghcs') | f <- fs] ++
+		[(f, \cabal m -> Check.checkSource ghcs' cabal m src) | FileContents f src <- fcts]
+runCommand copts (CheckLint fs fcts ghcs') = runCommandM $ do
+	db <- getDb copts
+	let
+		checkSome file fn = do
+			cabal <- liftIO $ getSandbox file
+			m <- maybe
+				(commandError_ $ "File '" ++ file ++ "' not found")
+				return
+				(lookupFile file db)
+			notes <- inWorkerWith (commandError_ . show) (commandGhc copts)
+				(runExceptT $ fn cabal m)
+			either commandError_ return notes
+	checkMsgs <- liftM concat $ mapM (uncurry checkSome) $
+		[(f, Check.checkFile ghcs') | f <- fs] ++
+		[(f, \cabal m -> Check.checkSource ghcs' cabal m src) | FileContents f src <- fcts]
+	lintMsgs <- mapCommandErrorStr $ liftM2 (++)
+		(liftM concat $ mapM HLint.hlintFile fs)
+		(liftM concat $ mapM (\(FileContents f src) -> HLint.hlintSource f src) fcts)
+	return $ checkMsgs ++ lintMsgs
+runCommand copts (Types fs fcts ghcs') = runCommandM $ do
+	db <- getDb copts
+	let
+		cts = [(f, Nothing) | f <- fs] ++ [(f, Just src) | FileContents f src <- fcts]
+	liftM concat $ forM cts $ \(file, msrc) -> do
+		cabal <- liftIO $ getSandbox file
+		m <- maybe
+			(commandError_ $ "File '" ++ file ++ "' not found")
+			return
+			(lookupFile file db)
+		notes <- inWorkerWith (commandError_ . show) (commandGhc copts)
+			(runExceptT $ Types.fileTypes ghcs' cabal m msrc)
+		either commandError_ return notes
+runCommand copts (GhcMod GhcModLang) = runCommandM $ mapCommandErrorStr GhcMod.langs
+runCommand copts (GhcMod GhcModFlags) = runCommandM $ mapCommandErrorStr GhcMod.flags
+runCommand copts (GhcMod (GhcModType (Position line column) fpath ghcs')) = runCommandM $ do
+	dbval <- getDb copts
+	cabal <- liftIO $ getSandbox fpath
+	(fpath', m', _) <- mapCommandErrorStr $ fileCtx dbval fpath
+	mapCommandErrorStr $ GhcMod.waitMultiGhcMod (commandGhcMod copts) fpath' $
+		GhcMod.typeOf (ghcs' ++ moduleOpts (allPackages dbval) m') cabal fpath' line column
+runCommand copts (GhcMod (GhcModLint fs hlints')) = runCommandM $ do
+	mapCommandErrorStr $ liftM concat $ forM fs $ \file ->
+		GhcMod.waitMultiGhcMod (commandGhcMod copts) file $
+			GhcMod.lint hlints' file
+runCommand copts (GhcMod (GhcModCheck fs ghcs')) = runCommandM $ do
+	dbval <- getDb copts
+	mapCommandErrorStr $ liftM concat $ forM fs $ \file -> do
+		mproj <- liftIO $ locateProject file
+		cabal <- liftIO $ getSandbox file
+		(_, m', _) <- fileCtx dbval file
+		GhcMod.waitMultiGhcMod (commandGhcMod copts) file $
+			GhcMod.check (ghcs' ++ moduleOpts (allPackages dbval) m') cabal [file] mproj
+runCommand copts (GhcMod (GhcModCheckLint fs ghcs' hlints')) = runCommandM $ do
+	dbval <- getDb copts
+	mapCommandErrorStr $ liftM concat $ forM fs $ \file -> do
+		mproj <- liftIO $ locateProject file
+		cabal <- liftIO $ getSandbox file
+		(_, m', _) <- fileCtx dbval file
+		GhcMod.waitMultiGhcMod (commandGhcMod copts) file $ do
+			checked <- GhcMod.check (ghcs' ++ moduleOpts (allPackages dbval) m') cabal [file] mproj
+			linted <- GhcMod.lint hlints' file
+			return $ checked ++ linted
+runCommand copts (AutoFix (AutoFixShow ns)) = runCommandM $ return $ AutoFix.corrections ns
+runCommand copts (AutoFix (AutoFixFix ns rest isPure)) = runCommandM $ do
+	files <- liftM (ordNub . sort) $ mapM (findPath copts) $ mapMaybe (preview $ Tools.noteSource . moduleFile) ns
+	let
+		doFix :: FilePath -> String -> ([Tools.Note AutoFix.Correction], String)
+		doFix file cts = AutoFix.edit cts fUpCorrs $ do
+			AutoFix.autoFix fCorrs
+			gets (view AutoFix.regions)
+			where
+				findCorrs :: FilePath -> [Tools.Note AutoFix.Correction] -> [Tools.Note AutoFix.Correction]
+				findCorrs f = filter ((== Just f) . preview (Tools.noteSource . moduleFile))
+				fCorrs = map (view Tools.note) $ findCorrs file ns
+				fUpCorrs = findCorrs file rest
+		runFix file
+			| isPure = return $ fst $ doFix file ""
+			| otherwise = do
+				(corrs', cts') <- liftM (doFix file) $ liftE $ readFileUtf8 file
+				liftE $ writeFileUtf8 file cts'
+				return corrs'
+	mapCommandErrorStr $ liftM concat $ mapM runFix files
+runCommand copts (GhcEval exprs) = runCommandM $ mapCommandErrorStr $ liftM (map toValue) $ liftAsync $
+	pushTask (commandGhci copts) $ mapM (try . evaluate) exprs
+	where
+		toValue :: Either SomeException String -> Value
+		toValue (Left (SomeException e)) = object ["fail" .= show e]
+		toValue (Right s) = toJSON s
+runCommand copts (Link hold) = runCommandM $ liftIO $ commandLink copts >> when hold (commandHold copts)
+runCommand copts Exit = runCommandM $ liftIO $ commandExit copts
+
+targetFilter :: MonadIO m => CommandOptions -> TargetFilter -> ExceptT CommandError m (ModuleId -> Bool)
+targetFilter copts f = case f of
+	TargetProject proj -> liftM inProject $ findProject copts proj
+	TargetFile file -> return $ inFile file
+	TargetModule mname -> return $ inModule mname
+	TargetDepsOf dep -> liftM inDeps $ findDep copts dep
+	TargetCabal cabal -> liftM inCabal $ findSandbox copts cabal
+	TargetPackage pack -> return $ inPackage pack
+	TargetSourced -> return byFile
+	TargetStandalone -> return standalone
+	TargetAny -> return (const True)
+
+-- Helper functions
+
+commandStrMsg :: String -> CommandError
+commandStrMsg m = CommandError m []
+
+-- | Find sandbox by path
+findSandbox :: MonadIO m => CommandOptions -> Cabal -> ExceptT CommandError m Cabal
+findSandbox copts Cabal = return Cabal
+findSandbox copts (Sandbox f) = (findPath copts >=> mapCommandErrorStr . liftIO . getSandbox) f
+
+-- | Canonicalize paths
+findPath :: (MonadIO m, Paths a) => CommandOptions -> a -> ExceptT e m a
+findPath copts = paths findPath' where
+	findPath' :: MonadIO m => FilePath -> ExceptT e m FilePath
+	findPath' f = liftIO $ canonicalizePath (normalise f') where
+		f'
+			| isRelative f = commandRoot copts </> f
+			| otherwise = f
+
+-- | Get list of enumerated sandboxes
+getSandboxes :: (MonadIO m, Functor m) => CommandOptions -> [Cabal] -> ExceptT CommandError m [Cabal]
+getSandboxes copts = traverse (findSandbox copts)
+
+-- | Find project by name of path
+findProject :: MonadIO m => CommandOptions -> String -> ExceptT CommandError m Project
+findProject copts proj = do
+	db' <- getDb copts
+	proj' <- liftM addCabal $ findPath copts proj
+	let
+		resultProj =
+			refineProject db' (project proj') <|>
+			find ((== proj) . view projectName) (databaseProjects db')
+	maybe (throwError $ commandStrMsg $ "Projects " ++ proj ++ " not found") return resultProj
+	where
+		addCabal p
+			| takeExtension p == ".cabal" = p
+			| otherwise = p </> (takeBaseName p <.> "cabal")
+
+-- | Find dependency: it may be source, project file or project name, also returns sandbox found
+findDep :: MonadIO m => CommandOptions -> String -> ExceptT CommandError m (Project, Maybe FilePath, Cabal)
+findDep copts depName = do
+	depPath <- findPath copts depName
+	proj <- msum [
+		mapCommandErrorStr $ do
+			p <- liftIO (locateProject depPath)
+			maybe (throwError $ "Project " ++ depName ++ " not found") (mapExceptT liftIO . loadProject) p,
+		findProject copts depName]
+	let
+		src
+			| takeExtension depPath == ".hs" = Just depPath
+			| otherwise = Nothing
+	sbox <- liftIO $ searchSandbox $ view projectPath proj
+	return (proj, src, sbox)
+
+-- | Check if project or source depends from this module
+inDeps :: (Project, Maybe FilePath, Cabal) -> ModuleId -> Bool
+inDeps (proj, src, cabal) = liftM2 (&&) (restrictCabal cabal) deps' where
+	deps' = case src of
+		Nothing -> inDepsOfProject proj
+		Just src' -> inDepsOfFile proj src'
+
+cacheLoad :: CommandOptions -> IO (Either String Database) -> CommandM ()
+cacheLoad copts act = liftIO $ do
+	db' <- act
+	case db' of
+		Left e -> commandLog copts Log.Error e
+		Right database -> DB.update (dbVar copts) (return database)
+
+-- | Bring locals to top scope to search within them if 'locals' flag set
+localsDatabase :: Bool -> Database -> Database
+localsDatabase True = databaseLocals
+localsDatabase False = id
+
+-- | Select newest packages if 'no-last' flag not set
+newest :: Symbol a => Bool -> [a] -> [a]
+newest True = newestPackage
+newest False = id
+
+-- | Convert from just of throw
+forceJust :: MonadIO m => String -> ExceptT CommandError m (Maybe a) -> ExceptT CommandError m a
+forceJust msg act = act >>= maybe (throwError $ commandStrMsg msg) return
+
+-- | Get actual DB state
+getDb :: MonadIO m => CommandOptions -> m Database
+getDb = liftIO . DB.readAsync . commandDatabase
+
+-- | Get DB async var
+dbVar :: CommandOptions -> DB.Async Database
+dbVar = commandDatabase
+
+mapCommandErrorStr :: (Monad m) => ExceptT String m a -> ExceptT CommandError m a
+mapCommandErrorStr = mapExceptT (liftM $ left commandStrMsg)
+
+-- | Run DB update action
+updateProcess :: CommandOptions -> [String] -> Bool -> Bool -> [ExceptT String (Update.UpdateDB IO) ()] -> CommandM ()
+updateProcess copts ghcOpts' docs' infer' acts = lift $ Update.updateDB (Update.settings copts ghcOpts' docs' infer') $ sequence_ [act `catchError` logErr | act <- acts] where
+	logErr :: String -> ExceptT String (Update.UpdateDB IO) ()
+	logErr e = liftIO $ commandLog copts Log.Error e
+
+-- | Filter declarations with prefix and infix
+filterMatch :: Symbol a => SearchQuery -> [a] -> [a]
+filterMatch (SearchQuery q st) = filter match' where
+	match' m = case st of
+		SearchExact -> fromString q == symbolName m
+		SearchPrefix -> fromString q `T.isPrefixOf` symbolName m
+		SearchInfix -> fromString q `T.isInfixOf` symbolName m
+		SearchSuffix -> fromString q `T.isSuffixOf` symbolName m
+		SearchRegex -> unpack (symbolName m) =~ q
src/HsDev/Commands.hs view
@@ -26,12 +26,14 @@ import Control.Applicative
 import Control.Lens (view, set, each)
 import Control.Monad.Except
+import Data.List (delete)
 import Data.Maybe
-import qualified Data.Map as M (lookup)
 import Data.String (fromString)
 import qualified Data.Text as T (isPrefixOf, split, unpack)
 import System.Directory (canonicalizePath)
 
+import System.Directory.Paths
+
 import HsDev.Database
 import HsDev.Project
 import HsDev.Symbols
@@ -64,9 +66,9 @@ -- | Find project of module
 getProject :: Database -> Project -> ExceptT String IO Project
 getProject db p = do
-	p' <- liftE $ canonicalizePath $ view projectCabal p
-	maybe (throwError $ "Project " ++ p' ++ " not found") return $
-		M.lookup p' $ databaseProjects db
+	p' <- liftE $ canonicalize p
+	maybe (throwError $ "Project " ++ view projectCabal p' ++ " not found") return $
+		refineProject db p'
 
 -- | Lookup visible within project symbol
 lookupSymbol :: Database -> Cabal -> FilePath -> String -> ExceptT String IO [ModuleDeclaration]
@@ -105,7 +107,7 @@ 				inProject proj,
 				\m -> any (`inPackage` m) deps']
 	where
-		deps f p = concatMap (view infoDepends) $ fileTargets p f
+		deps f p = delete (view projectName p) $ concatMap (view infoDepends) $ fileTargets p f
 
 -- | Symbols in scope
 scope :: Database -> Cabal -> FilePath -> Bool -> ExceptT String IO [ModuleDeclaration]
src/HsDev/Database.hs view
@@ -6,7 +6,7 @@ 	fromModule, fromProject,
 	filterDB,
 	projectDB, cabalDB, standaloneDB,
-	selectModules, selectDeclarations, lookupModule, lookupFile, refineProject,
+	selectModules, selectDeclarations, lookupModule, lookupInspected, lookupFile, refineProject,
 	getInspected,
 
 	append, remove,
@@ -17,11 +17,12 @@ 	Map
 	) where
 
-import Control.Lens (set, view, preview, _Just)
+import Control.Lens (set, view, preview, _Just, each, (^..))
 import Control.Monad (msum, join)
 import Control.DeepSeq (NFData(..))
 import Data.Aeson
 import Data.Either (rights)
+import Data.Foldable (find)
 import Data.Function (on)
 import Data.Group (Group(..))
 import Data.Map (Map)
@@ -30,12 +31,12 @@ 
 import HsDev.Symbols
 import HsDev.Symbols.Util
-import HsDev.Util ((.::), ordNub)
+import HsDev.Util ((.::), ordNub, mapBy)
 
 -- | HsDev database
 data Database = Database {
-	databaseModules :: Map ModuleLocation InspectedModule,
-	databaseProjects :: Map FilePath Project }
+	databaseModules :: [InspectedModule],
+	databaseProjects :: [Project] }
 		deriving (Eq, Ord)
 
 instance NFData Database where
@@ -43,14 +44,16 @@ 
 instance Group Database where
 	add old new = Database {
-		databaseModules = databaseModules new `M.union` databaseModules old,
-		databaseProjects = M.unionWith mergeProject (databaseProjects new) (databaseProjects old) }
+		databaseModules = M.elems $ mapBy (view inspectedId) (databaseModules new) `M.union` mapBy (view inspectedId) (databaseModules old),
+		databaseProjects = M.elems $ M.unionWith mergeProject
+			(mapBy (view projectCabal) (databaseProjects new))
+			(mapBy (view projectCabal) (databaseProjects old)) }
 		where
 			mergeProject pl pr = set projectDescription (msum [view projectDescription pl, view projectDescription pr]) pl
 	sub old new = Database {
-		databaseModules = databaseModules old `M.difference` databaseModules new,
-		databaseProjects = databaseProjects old `M.difference` databaseProjects new }
-	zero = Database M.empty M.empty
+		databaseModules = M.elems $ mapBy (view inspectedId) (databaseModules old) `M.difference` mapBy (view inspectedId) (databaseModules new),
+		databaseProjects = M.elems $ mapBy (view projectCabal) (databaseProjects old) `M.difference` mapBy (view projectCabal) (databaseProjects new) }
+	zero = Database [] []
 
 instance Monoid Database where
 	mempty = zero
@@ -58,35 +61,32 @@ 
 instance ToJSON Database where
 	toJSON (Database ms ps) = object [
-		"modules" .= M.elems ms,
-		"projects" .= M.elems ps]
+		"modules" .= ms,
+		"projects" .= 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 (view inspectedId m) m
-			mkProject p = M.singleton (view projectCabal p) p
+		(v .:: "modules") <*>
+		(v .:: "projects")
 
 -- | 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 }
+	databaseModules = M.elems $ mapBy (view inspectedId) (databaseModules l) `M.intersection` mapBy (view inspectedId) (databaseModules r),
+	databaseProjects = M.elems $ mapBy (view projectCabal) (databaseProjects l) `M.intersection` mapBy (view projectCabal) (databaseProjects r) }
 
 -- | Check if database is empty
 nullDatabase :: Database -> Bool
-nullDatabase db = M.null (databaseModules db) && M.null (databaseProjects db)
+nullDatabase db = null (databaseModules db) && null (databaseProjects db)
 
 -- | Bring all locals to scope
 databaseLocals :: Database -> Database
 databaseLocals db = db {
-	databaseModules = M.map (fmap moduleLocals) (databaseModules db) }
+	databaseModules = fmap (fmap moduleLocals) (databaseModules db) }
 
 -- | All modules
 allModules :: Database -> [Module]
-allModules = rights . map (view inspectionResult) . M.elems . databaseModules
+allModules = rights . fmap (view inspectionResult) . databaseModules
 
 -- | All declarations
 allDeclarations :: Database -> [ModuleDeclaration]
@@ -101,18 +101,18 @@ -- | Make database from module
 fromModule :: InspectedModule -> Database
 fromModule m = zero {
-	databaseModules = M.singleton (view inspectedId m) m }
+	databaseModules = [m] }
 
 -- | Make database from project
 fromProject :: Project -> Database
 fromProject p = zero {
-	databaseProjects = M.singleton (view projectCabal p) p }
+	databaseProjects = [p] }
 
 -- | Filter database by predicate
 filterDB :: (ModuleId -> Bool) -> (Project -> Bool) -> Database -> Database
 filterDB m p db = mempty {
-	databaseModules = M.filter (either (const False) (m . view moduleId) . view inspectionResult) (databaseModules db),
-	databaseProjects = M.filter p (databaseProjects db) }
+	databaseModules = filter (either (const False) (m . view moduleId) . view inspectionResult) (databaseModules db),
+	databaseProjects = filter p (databaseProjects db) }
 
 -- | Project database
 projectDB :: Project -> Database -> Database
@@ -124,7 +124,7 @@ 
 -- | Standalone database
 standaloneDB :: Database -> Database
-standaloneDB db = filterDB check' (const False) db where
+standaloneDB = filterDB check' (const False) where
 	check' m = standalone m && byFile m
 
 -- | Select module by predicate
@@ -138,20 +138,24 @@ -- | Lookup module by its location and name
 lookupModule :: ModuleLocation -> Database -> Maybe Module
 lookupModule mloc db = do
-	m <- M.lookup mloc $ databaseModules db
+	m <- find ((== mloc) . view inspectedId) $ databaseModules db
 	either (const Nothing) Just $ view inspectionResult m
 
+-- | Lookup inspected module
+lookupInspected :: ModuleLocation -> Database -> Maybe InspectedModule
+lookupInspected mloc db = find ((== mloc) . view inspectedId) $ databaseModules db
+
 -- | Lookup module by its source file
 lookupFile :: FilePath -> Database -> Maybe Module
 lookupFile f = listToMaybe . selectModules (inFile f . view moduleId)
 
 -- | Refine project
 refineProject :: Database -> Project -> Maybe Project
-refineProject db proj = M.lookup (view projectCabal proj) $ databaseProjects db
+refineProject db proj = find ((== view projectCabal proj) . view projectCabal) $ databaseProjects db
 
 -- | Get inspected module
 getInspected :: Database -> Module -> InspectedModule
-getInspected db m = fromMaybe err $ M.lookup (view moduleLocation m) $ databaseModules db where
+getInspected db m = fromMaybe err $ find ((== view moduleLocation m) . view inspectedId) $ databaseModules db where
 	err = error "Impossible happened: getInspected"
 
 -- | Append database
@@ -219,7 +223,7 @@ 	keyProj db = unique
 		"No project"
 		"Different module projects"
-		(return (M.keys (databaseProjects db)))
+		(return (databaseProjects db ^.. each . projectCabal))
 	-- Check that list results in one element
 	unique :: (Eq a) => String -> String -> Either String [a] -> Either String a
 	unique _ _ (Left e) = Left e
@@ -230,7 +234,7 @@ structurize :: Database -> Structured
 structurize db = Structured cs ps fs where
 	cs = M.fromList [(c, cabalDB c db) | c <- ordNub (mapMaybe modCabal (allModules db))]
-	ps = M.fromList [(pname, projectDB (project pname) db) | pname <- M.keys (databaseProjects db)]
+	ps = M.fromList [(pname, projectDB (project pname) db) | pname <- (databaseProjects db ^.. each . projectCabal)]
 	fs = standaloneDB db
 
 merge :: Structured -> Database
src/HsDev/Database/Update.hs view
@@ -35,9 +35,9 @@ import Control.Monad.Trans.Control
 import Data.Aeson
 import Data.Aeson.Types
-import qualified Data.HashMap.Strict as HM
+import Data.Foldable (toList)
 import qualified Data.Map as M
-import Data.Maybe (mapMaybe, isJust, fromMaybe, catMaybes)
+import Data.Maybe (mapMaybe, isJust, fromMaybe)
 import qualified Data.Text as T (unpack)
 import System.Directory (canonicalizePath, doesFileExist)
 import qualified System.Log.Simple as Log
@@ -48,7 +48,7 @@ import HsDev.Database
 import HsDev.Database.Async hiding (Event)
 import HsDev.Display
-import HsDev.Inspect (inspectDocs, inspectDocsGhc)
+import HsDev.Inspect (inspectDocs, inspectDocsGhc, getDefines)
 import HsDev.Project
 import HsDev.Symbols
 import HsDev.Tools.Ghc.Worker (ghcWorker)
@@ -89,7 +89,7 @@ 				getMods :: (MonadIO m) => m [InspectedModule]
 				getMods = do
 					db' <- liftIO $ readAsync $ database sets
-					return $ catMaybes [M.lookup mloc' (databaseModules db') | mloc' <- mlocs']
+					return $ filter ((`elem` mlocs') . view inspectedId) $ toList $ databaseModules db'
 			when (updateDocs sets) $ do
 				Log.log Log.Trace "forking inspecting source docs"
 				void $ fork (getMods >>= waiter . mapM_ scanDocs_)
@@ -115,7 +115,7 @@ postStatus :: (MonadIO m, MonadReader Settings m) => Task -> m ()
 postStatus s = do
 	on' <- asks onStatus
-	liftIO $ on' s
+	liftIO $ on' [s]
 
 -- | Wait DB to complete actions
 waiter :: (MonadIO m, MonadReader Settings m) => m () -> m ()
@@ -159,11 +159,11 @@ 			return dbval
 
 -- | Run one task
-runTask :: MonadIO m => String -> [Pair] -> ExceptT String (UpdateDB m) a -> ExceptT String (UpdateDB m) a
-runTask action params act = do
+runTask :: (Display t, MonadIO m, NFData a, MonadCatchIO m) => String -> t -> ExceptT String (UpdateDB m) a -> ExceptT String (UpdateDB m) a
+runTask action subj act = Log.scope "task" $ do
 	postStatus $ task { taskStatus = StatusWorking }
 	x <- local childTask act
-	postStatus $ task { taskStatus = StatusOk }
+	x `deepseq` postStatus (task { taskStatus = StatusOk })
 	return x
 	`catchError`
 	(\e -> postStatus (task { taskStatus = StatusError e }) >> throwError e)
@@ -171,11 +171,11 @@ 		task = Task {
 			taskName = action,
 			taskStatus = StatusWorking,
-			taskParams = HM.fromList params,
-			taskProgress = Nothing,
-			taskChild = Nothing }
+			taskSubjectType = displayType subj,
+			taskSubjectName = display subj,
+			taskProgress = Nothing }
 		childTask st = st {
-			onStatus = \t -> onStatus st (task { taskChild = Just t }) }
+			onStatus = \t -> onStatus st (task : t) }
 
 -- | Run many tasks with numeration
 runTasks :: Monad m => [ExceptT String (UpdateDB m) ()] -> ExceptT String (UpdateDB m) ()
@@ -183,7 +183,7 @@ 	total = length ts
 	taskNum n = local setProgress where
 		setProgress st = st {
-			onStatus = \t -> onStatus st (t { taskProgress = Just (Progress n total) }) }
+			onStatus = \(t:tl) -> onStatus st ((t { taskProgress = Just (Progress n total) }) : tl) }
 	noErr v = v `mplus` return ()
 
 -- | Get database value
@@ -191,15 +191,16 @@ readDB = asks database >>= liftIO . readAsync
 
 -- | Scan module
-scanModule :: (MonadIO m, MonadCatch m) => [String] -> ModuleLocation -> Maybe String -> ExceptT String (UpdateDB m) ()
-scanModule opts mloc mcts = runTask "scanning" (subject mloc ["module" .= mloc]) $ do
-	im <- liftExceptT $ S.scanModule opts mloc mcts
+scanModule :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> ModuleLocation -> Maybe String -> ExceptT String (UpdateDB m) ()
+scanModule opts mloc mcts = runTask "scanning" mloc $ Log.scope "module" $ do
+	defs <- asks settingsDefines
+	im <- liftExceptT $ S.scanModule defs opts mloc mcts
 	updater $ return $ fromModule im
 	_ <- ExceptT $ return $ view inspectionResult im
 	return ()
 
 -- | Scan modules
-scanModules :: (MonadIO m, MonadCatch m) => [String] -> [S.ModuleToScan] -> ExceptT String (UpdateDB m) ()
+scanModules :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> [S.ModuleToScan] -> ExceptT String (UpdateDB m) ()
 scanModules opts ms = runTasks $
 	[scanProjectFile opts p >> return () | p <- ps] ++
 	[scanModule (opts ++ mopts) m mcts | (m, mopts, mcts) <- ms]
@@ -209,12 +210,12 @@ 		toProj _ = Nothing
 
 -- | Scan source file
-scanFile :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
+scanFile :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
 scanFile opts fpath = scanFileContents opts fpath Nothing
 
 -- | Scan source file with contents
-scanFileContents :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> Maybe String -> ExceptT String (UpdateDB m) ()
-scanFileContents opts fpath mcts = do
+scanFileContents :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> FilePath -> Maybe String -> ExceptT String (UpdateDB m) ()
+scanFileContents opts fpath mcts = Log.scope "file" $ do
 	dbval <- readDB
 	fpath' <- liftEIO $ canonicalizePath fpath
 	ex <- liftEIO $ doesFileExist fpath'
@@ -238,28 +239,25 @@ 		inFile f = maybe False (== f) . preview (moduleIdLocation . moduleFile)
 
 -- | Scan cabal modules
-scanCabal :: (MonadIO m, MonadCatch m) => [String] -> Cabal -> ExceptT String (UpdateDB m) ()
-scanCabal opts cabalSandbox = runTask "scanning" (subject cabalSandbox ["sandbox" .= cabalSandbox]) $ do
+scanCabal :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> Cabal -> ExceptT String (UpdateDB m) ()
+scanCabal opts cabalSandbox = runTask "scanning" cabalSandbox $ Log.scope "cabal" $ do
 	watch (\w -> watchSandbox w cabalSandbox opts)
-	mlocs <- runTask "getting list of cabal modules" [] $ 
-		liftExceptT $ listModules opts cabalSandbox
+	mlocs <- liftExceptT $ listModules opts cabalSandbox
 	scan (Cache.loadCabal cabalSandbox) (cabalDB cabalSandbox) ((,,) <$> mlocs <*> pure [] <*> pure Nothing) opts $ \mlocs' -> do
-		ms <- runTask "loading modules" [] $
-			liftExceptT $ browseModules opts cabalSandbox (mlocs' ^.. each . _1)
-		docs <- runTask "loading docs" [] $
-			liftExceptT $ hdocsCabal cabalSandbox opts
+		ms <- liftExceptT $ browseModules opts cabalSandbox (mlocs' ^.. each . _1)
+		docs <- liftExceptT $ hdocsCabal cabalSandbox 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 (T.unpack $ view moduleName m) docs
 
 -- | Scan project file
-scanProjectFile :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ExceptT String (UpdateDB m) Project
-scanProjectFile opts cabal = runTask "scanning" (subject cabal ["file" .= cabal]) $ liftExceptT $ S.scanProjectFile opts cabal
+scanProjectFile :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> FilePath -> ExceptT String (UpdateDB m) Project
+scanProjectFile opts cabal = runTask "scanning" cabal $ liftExceptT $ S.scanProjectFile opts cabal
 
 -- | Scan project
-scanProject :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
-scanProject opts cabal = runTask "scanning" (subject (project cabal) ["project" .= cabal]) $ do
+scanProject :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
+scanProject opts cabal = runTask "scanning" (project cabal) $ Log.scope "project" $ do
 	proj <- scanProjectFile opts cabal
 	watch (\w -> watchProject w proj opts)
 	(_, sources) <- liftExceptT $ S.enumProject proj
@@ -268,10 +266,9 @@ 		updater $ return $ fromProject proj
 
 -- | Scan directory for source files and projects
-scanDirectory :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
-scanDirectory opts dir = runTask "scanning" (subject dir ["path" .= dir]) $ do
-	S.ScanContents standSrcs projSrcs sboxes <- runTask "getting list of sources" [] $
-		liftExceptT $ S.enumDirectory dir
+scanDirectory :: (MonadIO m, MonadCatch m, MonadCatchIO m) => [String] -> FilePath -> ExceptT String (UpdateDB m) ()
+scanDirectory opts dir = runTask "scanning" dir $ Log.scope "directory" $ do
+	S.ScanContents standSrcs projSrcs sboxes <- liftExceptT $ S.enumDirectory dir
 	runTasks [scanProject opts (view projectCabal p) | (p, _) <- projSrcs]
 	runTasks $ map (scanCabal opts) sboxes
 	mapMOf_ (each . _1) (watch . flip watchModule) standSrcs
@@ -285,21 +282,21 @@ 	w <- liftIO $ ghcWorker ["-haddock"] (return ())
 	runTasks $ map (scanDocs' w) ims
 	where
-		scanDocs' w im = runTask "scanning docs" (subject (view inspectedId im) []) $ do
-			Log.log Log.Trace $ "Scanning docs for $" ~~  view inspectedId im
+		scanDocs' w im = runTask "scanning docs" (view inspectedId im) $ Log.scope "docs" $ do
+			Log.log Log.Trace $ "Scanning docs for {}" ~~  view inspectedId im
 			im' <- liftExceptT $ S.scanModify (\opts _ -> inWorkerT w . inspectDocsGhc opts) im
-			Log.log Log.Trace $ "Docs for $ updated" ~~ view inspectedId im
+			Log.log Log.Trace $ "Docs for {} updated" ~~ view inspectedId im
 			updater $ return $ fromModule im'
 		inWorkerT w = ExceptT . inWorker w . runExceptT 
 
 inferModTypes :: (MonadIO m, MonadCatchIO m) => [InspectedModule] -> ExceptT String (UpdateDB m) ()
 inferModTypes = runTasks . map inferModTypes' where
-	inferModTypes' im = runTask "inferring types" (subject (view inspectedId im) []) $ do
+	inferModTypes' im = runTask "inferring types" (view inspectedId im) $ Log.scope "infer" $ do
 		-- TODO: locate sandbox
 		sets <- ask
-		Log.log Log.Trace $ "Inferring types for $" ~~ view inspectedId im
+		Log.log Log.Trace $ "Inferring types for {}" ~~ view inspectedId im
 		im' <- liftExceptT $ S.scanModify (infer' sets) im
-		Log.log Log.Trace $ "Types for $ inferred" ~~ view inspectedId im
+		Log.log Log.Trace $ "Types for {} inferred" ~~ view inspectedId im
 		updater $ return $ fromModule im'
 	infer' :: Settings -> [String] -> Cabal -> Module -> ExceptT String IO Module
 	infer' sets opts cabal m = case preview (moduleLocation . moduleFile) m of
@@ -308,7 +305,7 @@ 			inferTypes opts cabal m
 
 -- | Generic scan function. Reads cache only if data is not already loaded, removes obsolete modules and rescans changed modules.
-scan :: (MonadIO m, MonadCatch m)
+scan :: (MonadIO m, MonadCatch m, MonadCatchIO m)
 	=> (FilePath -> ExceptT String IO Structured)
 	-- ^ Read data from cache
 	-> (Database -> Database)
@@ -320,20 +317,20 @@ 	-> ([S.ModuleToScan] -> ExceptT String (UpdateDB m) ())
 	-- ^ Function to update changed modules
 	-> ExceptT String (UpdateDB m) ()
-scan cache' part' mlocs opts act = do
+scan cache' part' mlocs opts act = Log.scope "scan" $ do
 	dbval <- getCache cache' part'
 	let
 		obsolete = filterDB (\m -> view moduleIdLocation m `notElem` (mlocs ^.. each . _1)) (const False) dbval
-	changed <- runTask "getting list of changed modules" [] $ liftExceptT $ S.changedModules dbval opts mlocs
-	runTask "removing obsolete modules" ["modules" .= map (view moduleLocation) (allModules obsolete)] $ cleaner $ return obsolete
+	changed <- liftExceptT $ S.changedModules dbval opts mlocs
+	cleaner $ return obsolete
 	act changed
 
 updateEvent :: (MonadIO m, MonadCatch m, MonadCatchIO m) => Watched -> Event -> ExceptT String (UpdateDB m) ()
 updateEvent (WatchedProject proj projOpts) e
 	| isSource e = do
-		Log.log Log.Info $ "File '${file}' in project ${proj} changed" ~~
-			("file" %= view eventPath e) %
-			("proj" %= view projectName proj)
+		Log.log Log.Info $ "File '{file}' in project {proj} changed"
+			~~ ("file" %= view eventPath e)
+			~~ ("proj" %= view projectName proj)
 		dbval <- readDB
 		let
 			opts = fromMaybe [] $ do
@@ -341,17 +338,20 @@ 				preview (inspection . inspectionOpts) $ getInspected dbval m
 		scanFile opts $ view eventPath e
 	| isCabal e = do
-		Log.log Log.Info $ "Project ${proj} changed" ~~ ("proj" %= view projectName proj)
+		Log.log Log.Info $ "Project {proj} changed"
+			~~ ("proj" %= view projectName proj)
 		scanProject projOpts $ view projectCabal proj
 	| otherwise = return ()
 updateEvent (WatchedSandbox cabal cabalOpts) e
 	| isConf e = do
-		Log.log Log.Info $ "Sandbox ${cabal} changed" ~~ ("cabal" %= cabal)
+		Log.log Log.Info $ "Sandbox {cabal} changed"
+			~~ ("cabal" %= cabal)
 		scanCabal cabalOpts cabal
 	| otherwise = return ()
 updateEvent WatchedModule e
 	| isSource e = do
-		Log.log Log.Info $ "Module ${file} changed" ~~ ("file" %= view eventPath e)
+		Log.log Log.Info $ "Module {file} changed"
+			~~ ("file" %= view eventPath e)
 		dbval <- readDB
 		let
 			opts = fromMaybe [] $ do
@@ -366,9 +366,6 @@ -- | Lift errors
 liftExceptT :: MonadIO m => ExceptT String IO a -> ExceptT String m a
 liftExceptT = mapExceptT liftIO
-
-subject :: Display a => a -> [Pair] -> [Pair]
-subject x ps = ["name" .= display x, "type" .= displayType x] ++ ps
 
 watch :: (MonadIO m, MonadReader Settings m) => (Watcher -> IO ()) -> m ()
 watch f = do
src/HsDev/Database/Update/Types.hs view
@@ -24,7 +24,6 @@ import HsDev.Symbols
 import HsDev.Util ((.::))
 import HsDev.Watcher.Types
-import System.Console.Args
 
 data Status = StatusWorking | StatusOk | StatusError String
 
@@ -55,50 +54,52 @@ data Task = Task {
 	taskName :: String,
 	taskStatus :: Status,
-	taskParams :: Object,
-	taskProgress :: Maybe Progress,
-	taskChild :: Maybe Task }
+	taskSubjectType :: String,
+	taskSubjectName :: String,
+	taskProgress :: Maybe Progress }
 
 instance ToJSON Task where
 	toJSON t = object [
-		"status" .= taskStatus t,
 		"task" .= taskName t,
-		"params" .= taskParams t,
-		"progress" .= taskProgress t,
-		"child" .= taskChild t]
+		"status" .= taskStatus t,
+		"type" .= taskSubjectType t,
+		"name" .= taskSubjectName t,
+		"progress" .= taskProgress t]
 
 instance FromJSON Task where
 	parseJSON = withObject "task" $ \v -> Task <$>
 		(v .:: "task") <*>
 		(v .:: "status") <*>
-		(v .:: "params") <*>
-		(v .:: "progress") <*>
-		(v .:: "child")
+		(v .:: "type") <*>
+		(v .:: "name") <*>
+		(v .:: "progress")
 
 data Settings = Settings {
 	database :: Async Database,
 	databaseCacheReader :: (FilePath -> ExceptT String IO Structured) -> IO (Maybe Database),
 	databaseCacheWriter :: Database -> IO (),
-	onStatus :: Task -> IO (),
+	onStatus :: [Task] -> IO (),
 	ghcOptions :: [String],
 	updateDocs :: Bool,
 	runInferTypes :: Bool,
 	settingsGhcModWorker :: Worker (ReaderT WorkerMap IO),
 	settingsLogger :: Log.Log,
-	settingsWatcher :: Watcher }
+	settingsWatcher :: Watcher,
+	settingsDefines :: [(String, String)] }
 
-settings :: CommandOptions -> Opts String -> Settings
-settings copts as = Settings
+settings :: CommandOptions -> [String] -> Bool -> Bool -> Settings
+settings copts ghcOpts' docs' infer' = Settings
 	(commandDatabase copts)
 	(commandReadCache copts)
 	(commandWriteCache copts)
 	(commandNotify copts . Notification . toJSON)
-	(listArg "ghc" as)
-	(flagSet "docs" as)
-	(flagSet "infer" as)
+	ghcOpts'
+	docs'
+	infer'
 	(commandGhcMod copts)
 	(commandLogger copts)
 	(commandWatcher copts)
+	(commandDefines copts)
 
 newtype UpdateDB m a = UpdateDB { runUpdateDB :: ReaderT Settings (WriterT [ModuleLocation] m) a }
 	deriving (Applicative, Monad, MonadIO, MonadCatchIO, MonadThrow, MonadCatch, Functor, MonadReader Settings, MonadWriter [ModuleLocation])
src/HsDev/Display.hs view
@@ -37,11 +37,11 @@ 	display = id
 	displayType _ = "path"
 
-instance Format Cabal where
-	format = display
+instance FormatBuild Cabal where
+	formatBuild = formatBuild . display
 
-instance Format ModuleLocation where
-	format = display
+instance FormatBuild ModuleLocation where
+	formatBuild = formatBuild . display
 
-instance Format Project where
-	format = display
+instance FormatBuild Project where
+	formatBuild = formatBuild . display
src/HsDev/Inspect.hs view
@@ -6,6 +6,8 @@ 	inspectFile, fileInspection, 	projectDirs, projectSources, 	inspectProject,+	getDefines,+	preprocess, preprocess_,  	module Control.Monad.Except 	) where@@ -30,6 +32,7 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, getPOSIXTime) import qualified Data.Map as M import qualified Language.Haskell.Exts as H+import qualified Language.Preprocessor.Cpphs as Cpphs import qualified System.Directory as Dir import System.FilePath import Data.Generics.Uniplate.Data@@ -43,14 +46,14 @@ -- | Analize source contents analyzeModule :: [String] -> Maybe FilePath -> String -> Either String Module analyzeModule exts file source = case H.parseFileContentsWithMode (parseMode file exts) source' of-		H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason-		H.ParseOk (H.Module _ (H.ModuleName mname) _ _ mexports imports declarations) -> Right Module {-			_moduleName = fromString mname,-			_moduleDocs =  Nothing,-			_moduleLocation = ModuleSource Nothing,-			_moduleExports = fmap (concatMap getExports) mexports,-			_moduleImports = map getImport imports,-			_moduleDeclarations = sortDeclarations $ getDecls declarations }+	H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason+	H.ParseOk (H.Module _ (H.ModuleName mname) _ _ mexports imports declarations) -> Right Module {+		_moduleName = fromString mname,+		_moduleDocs =  Nothing,+		_moduleLocation = ModuleSource Nothing,+		_moduleExports = fmap (concatMap getExports) mexports,+		_moduleImports = map getImport imports,+		_moduleDeclarations = sortDeclarations $ getDecls declarations } 	where 		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces 		source' = map untab source@@ -106,8 +109,8 @@ -- | Get exports getExports :: H.ExportSpec -> [Export] getExports (H.EModuleContents (H.ModuleName m)) = [ExportModule $ fromString m]-getExports (H.EVar _ n) = [uncurry ExportName (identOfQName n) ExportNothing]-getExports (H.EAbs n) = [uncurry ExportName (identOfQName n) ExportNothing]+getExports (H.EVar n) = [uncurry ExportName (identOfQName n) ExportNothing]+getExports (H.EAbs _ n) = [uncurry ExportName (identOfQName n) ExportNothing] getExports (H.EThingAll n) = [uncurry ExportName (identOfQName n) ExportAll] getExports (H.EThingWith n ns) = [uncurry ExportName (identOfQName n) $ ExportWith (map toStr ns)] where 	toStr :: H.CName -> Text@@ -149,8 +152,8 @@ 		mergeInfos l _ = l  -- | Get definitions-getBinds :: H.Binds -> [Declaration]-getBinds (H.BDecls decls) = getDecls decls+getBinds :: Maybe H.Binds -> [Declaration]+getBinds (Just (H.BDecls decls)) = getDecls decls getBinds _ = []  -- | Get declaration and child declarations@@ -197,7 +200,7 @@  -- | Get GADT constructor and record fields declarations getGConDecl :: H.GadtDecl -> [Declaration]-getGConDecl (H.GadtDecl loc n fields r) = mkFun loc n (Function (Just $ oneLinePrint $ map snd fields `tyFun` r) [] Nothing) : concatMap (uncurry (getRec loc r)) fields where+getGConDecl (H.GadtDecl loc n fields r) = mkFun loc n (Function (Just $ oneLinePrint $ map snd fields `tyFun` r) [] Nothing) : concatMap (uncurry (getRec loc r)) fields  -- | Get record field declaration getRec :: H.SrcLoc -> H.Type -> [H.Name] -> H.Type -> [Declaration]@@ -319,9 +322,10 @@ 	_ -> throwError "Can inspect only source file docs"  -- | Inspect contents-inspectContents :: String -> [String] -> String -> ExceptT String IO InspectedModule-inspectContents name opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do-	analyzed <- ExceptT $ return $ analyzeModule exts (Just name) cts <|> analyzeModule_ exts (Just name) cts+inspectContents :: String -> [(String, String)] -> [String] -> String -> ExceptT String IO InspectedModule+inspectContents name defines opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do+	cts' <- lift $ preprocess_ defines exts name cts+	analyzed <- ExceptT $ return $ analyzeModule exts (Just name) cts' <|> analyzeModule_ exts (Just name) cts' 	return $ set moduleLocation (ModuleSource $ Just name) analyzed 	where 		exts = mapMaybe flagExtension opts@@ -330,8 +334,8 @@ contentsInspection _ _ = return InspectionNone -- crc or smth  -- | Inspect file-inspectFile :: [String] -> FilePath -> Maybe String -> ExceptT String IO InspectedModule-inspectFile opts file mcts = do+inspectFile :: [(String, String)] -> [String] -> FilePath -> Maybe String -> ExceptT String IO InspectedModule+inspectFile defines opts file mcts = do 	proj <- liftE $ locateProject file 	absFilename <- liftE $ Dir.canonicalizePath file 	ex <- liftE $ Dir.doesFileExist absFilename@@ -342,7 +346,7 @@ 		-- 	else liftM Just $ hdocs (FileModule absFilename Nothing) opts 		forced <- ExceptT $ E.handle onError $ do 			analyzed <- liftM (\s -> analyzeModule exts (Just absFilename) s <|> analyzeModule_ exts (Just absFilename) s) $-				maybe (readFileUtf8 absFilename) return mcts+				maybe (readFileUtf8 absFilename >>= preprocess_ defines exts file) return mcts 			force analyzed `deepseq` return analyzed 		-- return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced 		return $ set moduleLocation (FileModule absFilename proj) forced@@ -385,11 +389,37 @@ 	liftM (ordNub . concat) $ triesMap (liftM sequenceA . traverse (liftE . enumHs)) dirs  -- | Inspect project-inspectProject :: [String] -> Project -> ExceptT String IO (Project, [InspectedModule])-inspectProject opts p = do+inspectProject :: [(String, String)] -> [String] -> Project -> ExceptT String IO (Project, [InspectedModule])+inspectProject defines 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 exts) (view entity exts) Nothing) <|> return Nothing+		inspectFile' exts = liftM return (inspectFile defines (opts ++ extensionsOpts exts) (view entity exts) Nothing) <|> return Nothing++-- | Get actual defines+getDefines :: IO [(String, String)]+getDefines = do+	tmp <- Dir.getTemporaryDirectory+	writeFile (tmp </> "defines.hs") ""+	_ <- runWait "ghc.exe" ["-E", "-optP-dM", "-cpp", tmp </> "defines.hs"] ""+	cts <- readFileUtf8 (tmp </> "defines.hspp")+	Dir.removeFile (tmp </> "defines.hs")+	Dir.removeFile (tmp </> "defines.hspp")+	return $ mapMaybe (\g -> (,) <$> g 1 <*> g 2) $ mapMaybe (matchRx rx) $ lines cts+	where+		rx = "#define ([^\\s]+) (.*)"++preprocess :: [(String, String)] -> FilePath -> String -> ExceptT String IO String+preprocess defines fpath cts = do+	cts' <- liftE $ Cpphs.cppIfdef fpath defines [] Cpphs.defaultBoolOptions cts+	return $ unlines $ map snd cts'++preprocess_ :: [(String, String)] -> [String] -> FilePath -> String -> IO String+preprocess_ defines exts fpath cts+	| hasCPP = runExceptT (preprocess defines fpath cts) >>= either (const $ return cts) return+	| otherwise = return cts+	where+		exts' = map H.parseExtension exts ++ maybe [] snd (H.readExtensions cts)+		hasCPP = H.EnableExtension H.CPP `elem` exts'
src/HsDev/Project.hs view
@@ -209,12 +209,11 @@ 		lang = maybe [] (\l -> ["default-language: " ++ display l]) $ _infoLanguage i
 		exts
 			| null (_infoExtensions i) = []
-			| otherwise = ["extensions:"] ++ map (tab 1 . display) (_infoExtensions i)
+			| otherwise = "extensions:" : map (tab 1 . display) (_infoExtensions i)
 		opts
 			| null (_infoGHCOptions i) = []
-			| otherwise = ["ghc-options:"] ++ map (tab 1) (_infoGHCOptions i)
-		sources = ["source-dirs:"] ++
-			(map (tab 1) $ _infoSourceDirs i)
+			| otherwise = "ghc-options:" : map (tab 1) (_infoGHCOptions i)
+		sources = "source-dirs:" : (map (tab 1) $ _infoSourceDirs i)
 
 instance ToJSON Info where
 	toJSON i = object [
src/HsDev/Scan.hs view
@@ -14,9 +14,9 @@ 	) where
 
 import Control.Applicative ((<|>))
+import Control.DeepSeq
 import Control.Lens (view, preview, set, _Right, _1, _2, _3, (^.))
 import Control.Monad.Except
-import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromMaybe, isJust)
 import System.Directory
 
@@ -47,6 +47,9 @@ 	projectsToScan :: [ProjectToScan],
 	sandboxesToScan :: [SandboxToScan] }
 
+instance NFData ScanContents where
+	rnf (ScanContents ms ps ss) = rnf ms `seq` rnf ps `seq` rnf ss
+
 -- | Enum project sources
 enumProject :: Project -> ExceptT String IO ProjectToScan
 enumProject p = do
@@ -76,7 +79,7 @@ 	projs <- triesMap (enumProject . project) projects
 	let
 		projPaths = map (view projectPath . fst) projs
-		standalone = map ((`FileModule` Nothing)) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
+		standalone = map (`FileModule` Nothing) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
 	return ScanContents {
 		modulesToScan = [(s, [], Nothing) | s <- standalone],
 		projectsToScan = projs,
@@ -89,8 +92,8 @@ 	loadProject proj
 
 -- | Scan module
-scanModule :: [String] -> ModuleLocation -> Maybe String -> ExceptT String IO InspectedModule
-scanModule opts (FileModule f p) mcts = liftM setProj $ inspectFile opts f mcts where
+scanModule :: [(String, String)] -> [String] -> ModuleLocation -> Maybe String -> ExceptT String IO InspectedModule
+scanModule defines opts (FileModule f p) mcts = liftM setProj $ inspectFile defines opts f mcts where
 	setProj =
 		set (inspectedId . moduleProject) p .
 		set (inspectionResult . _Right . moduleLocation . moduleProject) p
@@ -98,8 +101,8 @@ -- 	infer' m = tryInfer <|> return m where
 -- 		tryInfer = mapExceptT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $
 -- 			runGhcMod defaultOptions $ inferTypes opts Cabal m
-scanModule opts (CabalModule c p n) _ = browse opts c n p
-scanModule _ (ModuleSource _) _ = throwError "Can inspect only modules in file or cabal"
+scanModule _ opts (CabalModule c p n) _ = browse opts c n p
+scanModule _ _ (ModuleSource _) _ = throwError "Can inspect only modules in file or cabal"
 
 -- | Scan additional info and modify scanned module. Dones't fail on error, just left module unchanged
 scanModify :: ([String] -> Cabal -> Module -> ExceptT String IO Module) -> InspectedModule -> ExceptT String IO InspectedModule
@@ -115,17 +118,17 @@ 	_ -> return False
 
 -- | Rescan inspected module
-rescanModule :: [String] -> InspectedModule -> ExceptT String IO (Maybe InspectedModule)
-rescanModule opts im = do
+rescanModule :: [(String, String)] -> [String] -> InspectedModule -> ExceptT String IO (Maybe InspectedModule)
+rescanModule defines opts im = do
 	up <- upToDate opts im
 	if up
 		then return Nothing
-		else fmap Just $ scanModule opts (view inspectedId im) Nothing
+		else fmap Just $ scanModule defines opts (view inspectedId im) Nothing
 
 -- | Is module new or recently changed
 changedModule :: Database -> [String] -> ModuleLocation -> ExceptT String IO Bool
 changedModule db opts m = maybe (return True) (liftM not . upToDate opts) m' where
-	m' = M.lookup m (databaseModules db)
+	m' = lookupInspected m db
 
 -- | Returns new (to scan) and changed (to rescan) modules
 changedModules :: Database -> [String] -> [ModuleToScan] -> ExceptT String IO [ModuleToScan]
+ src/HsDev/Server/Base.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE CPP, OverloadedStrings #-}
+
+module HsDev.Server.Base (
+	initLog, runServer, Server, startServer, inServer,
+	withCache, writeCache, readCache,
+
+	module HsDev.Server.Types,
+	module HsDev.Server.Message
+	) where
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Control.Monad.Except
+import Control.Monad.Reader
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T (pack, unpack)
+import System.Log.Simple hiding (Level(..), Message(..), Command(..))
+import System.Log.Simple.Base (writeLog)
+import qualified System.Log.Simple.Base as Log
+
+import qualified Control.Concurrent.FiniteChan as F
+import qualified System.Directory.Watcher as Watcher
+import Text.Format ((~~), FormatBuild(..))
+
+import qualified HsDev.Cache.Structured as SC
+import qualified HsDev.Client.Commands as Client
+import HsDev.Database
+import qualified HsDev.Database.Async as DB
+import qualified HsDev.Database.Update as Update
+import HsDev.Inspect (getDefines)
+import HsDev.Tools.Ghc.Worker
+import HsDev.Tools.GhcMod (ghcModMultiWorker)
+import HsDev.Server.Types
+import HsDev.Server.Message
+import HsDev.Util
+
+#if mingw32_HOST_OS
+import System.Win32.FileMapping.NamePool
+#else
+import System.Posix.Process
+import System.Posix.IO
+#endif
+
+
+-- | Inits log chan and returns functions (print message, wait channel)
+initLog :: ServerOpts -> IO (Log, Log.Level -> String -> IO (), ([String] -> IO ()) -> IO (), IO ())
+initLog sopts = do
+	msgs <- F.newChan
+	outputDone <- newEmptyMVar
+	void $ forkIO $ finally
+		(F.readChan msgs >>= mapM_ (const $ return ()))
+		(putMVar outputDone ())
+	l <- newLog (constant [rule']) $ concat [
+		[logger text console],
+		[logger text (chaner msgs)],
+		maybeToList $ (logger text . file) <$> serverLog sopts]
+	Log.writeLog l Log.Info ("Log politics: low = {}, high = {}" ~~ logLow ~~ logHigh)
+	let
+		listenLog f = logException "listen log" (F.putChan msgs) $ do
+			msgs' <- F.dupChan msgs
+			F.readChan msgs' >>= f
+	return (l, \lev -> writeLog l lev . T.pack, listenLog, F.closeChan msgs >> takeMVar outputDone)
+	where
+		rule' :: Log.Rule
+		rule' = parseRule_ $ T.pack ("/: " ++ serverLogConfig sopts)
+		(Log.Politics logLow logHigh) = Log.rulePolitics rule' Log.defaultPolitics
+
+instance FormatBuild Log.Level where
+
+-- | Run server
+runServer :: ServerOpts -> (CommandOptions -> IO ()) -> IO ()
+runServer sopts act = bracket (initLog sopts) (\(_, _, _, x) -> x) $ \(logger', outputStr, listenLog, waitOutput) -> Log.scopeLog logger' (T.pack "hsdev") $ Watcher.withWatcher $ \watcher -> do
+	db <- DB.newAsync
+	when (serverLoad sopts) $ withCache sopts () $ \cdir -> do
+		outputStr Log.Info $ "Loading cache from " ++ cdir
+		dbCache <- liftA merge <$> SC.load cdir
+		case dbCache of
+			Left err -> outputStr Log.Error $ "Failed to load cache: " ++ err
+			Right dbCache' -> DB.update db (return dbCache')
+#if mingw32_HOST_OS
+	mmapPool <- Just <$> createPool "hsdev"
+#endif
+	ghcw <- ghcWorker [] (return ())
+	ghciw <- ghciWorker
+	ghcmodw <- ghcModMultiWorker
+	defs <- getDefines
+	let
+		copts = CommandOptions
+			db
+			(writeCache sopts outputStr)
+			(readCache sopts outputStr)
+			"."
+			outputStr
+			logger'
+			listenLog
+			waitOutput
+			watcher
+#if mingw32_HOST_OS
+			mmapPool
+#endif
+			ghcw
+			ghciw
+			ghcmodw
+			(const $ return ())
+			(return ())
+			(return ())
+			(return ())
+			defs
+	_ <- forkIO $ Update.onEvent watcher (Update.processEvent $ Update.settings copts [] False False)
+	act copts
+
+type Server = Worker (ReaderT CommandOptions IO)
+
+startServer :: ServerOpts -> IO Server
+startServer sopts = startWorker (runServer sopts . runReaderT) id id
+
+inServer :: Server -> Command -> IO Result
+inServer srv c = inWorker srv (ReaderT (`Client.runCommand` c))
+
+chaner :: F.Chan String -> Consumer Text
+chaner ch = Consumer withChan where
+	withChan f = f (F.putChan ch . T.unpack)
+
+-- | Perform action on cache
+withCache :: ServerOpts -> a -> (FilePath -> IO a) -> IO a
+withCache sopts v onCache = case serverCache sopts of
+	Nothing -> return v
+	Just cdir -> onCache cdir
+
+writeCache :: ServerOpts -> (Log.Level -> String -> IO ()) -> Database -> IO ()
+writeCache sopts logMsg' d = withCache sopts () $ \cdir -> do
+	logMsg' Log.Info $ "writing cache to " ++ cdir
+	logIO "cache writing exception: " (logMsg' Log.Error) $ do
+		let
+			sd = structurize d
+		SC.dump cdir sd
+		forM_ (M.keys (structuredCabals sd)) $ \c -> logMsg' Log.Debug ("cache write: cabal " ++ show c)
+		forM_ (M.keys (structuredProjects sd)) $ \p -> logMsg' Log.Debug ("cache write: project " ++ p)
+		case allModules (structuredFiles sd) of
+			[] -> return ()
+			ms -> logMsg' Log.Debug $ "cache write: " ++ show (length ms) ++ " files"
+	logMsg' Log.Info $ "cache saved to " ++ cdir
+
+readCache :: ServerOpts -> (Log.Level -> String -> IO ()) -> (FilePath -> ExceptT String IO Structured) -> IO (Maybe Database)
+readCache sopts logMsg' act = withCache sopts Nothing $ join . liftM (either cacheErr cacheOk) . runExceptT . act where
+	cacheErr e = logMsg' Log.Error ("Error reading cache: " ++ e) >> return Nothing
+	cacheOk s = do
+		forM_ (M.keys (structuredCabals s)) $ \c -> logMsg' Log.Debug ("cache read: cabal " ++ show c)
+		forM_ (M.keys (structuredProjects s)) $ \p -> logMsg' Log.Debug ("cache read: project " ++ p)
+		case allModules (structuredFiles s) of
+			[] -> return ()
+			ms -> logMsg' Log.Debug $ "cache read: " ++ show (length ms) ++ " files"
+		return $ Just $ merge s
src/HsDev/Server/Commands.hs view
@@ -1,22 +1,17 @@-{-# LANGUAGE OverloadedStrings, CPP, PatternGuards, LambdaCase #-}
+{-# LANGUAGE OverloadedStrings, CPP, PatternGuards, LambdaCase, TemplateHaskell #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Server.Commands (
-	commands,
-	serverOpts, serverDefCfg,
-	clientOpts, clientDefCfg,
-
-	clientCmd, sendCmd,
-
-	initLog, runServer,
-	processRequest, processClient,
-
-	withCache, writeCache, readCache
+	ServerCommand(..), ServerOpts(..), ClientOpts(..),
+	Request(..),
+	sendCommand, runServerCommand,
+	findPath,
+	processRequest, processClient, processClientSocket,
+	module HsDev.Server.Types
 	) where
 
-import Control.Applicative
-import Control.Arrow (second)
 import Control.Concurrent
+import Control.Concurrent.Async
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
@@ -25,41 +20,30 @@ import qualified Data.ByteString.Char8 as BS
 import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as L
-import Data.Either (isLeft)
 import qualified Data.Map as M
 import Data.Maybe
-import Data.Text (Text)
-import qualified Data.Text as T (pack, unpack)
+import qualified Data.Text as T (pack)
 import Network.Socket hiding (connect)
 import qualified Network.Socket as Net hiding (send)
 import qualified Network.Socket.ByteString as Net (send)
 import qualified Network.Socket.ByteString.Lazy as Net (getContents)
 import System.Directory
 import System.Exit
+import System.FilePath
 import System.IO
-import System.Log.Simple hiding (Level(..), Message(..))
-import System.Log.Simple.Base (writeLog)
 import qualified System.Log.Simple.Base as Log
-import Text.Read (readMaybe)
 
-import Control.Apply.Util
 import Control.Concurrent.Util
 import qualified Control.Concurrent.FiniteChan as F
-import Data.Lisp
-import qualified System.Directory.Watcher as Watcher
-import System.Console.Cmd hiding (run)
-import Text.Format ((~~), (%), Format(..))
+import Text.Format ((~~))
+import System.Directory.Paths
 
-import qualified HsDev.Cache.Structured as SC
 import qualified HsDev.Client.Commands as Client
-import HsDev.Database
 import qualified HsDev.Database.Async as DB
-import qualified HsDev.Database.Update as Update
-import HsDev.Tools.Ghc.Worker
-import HsDev.Tools.GhcMod (ghcModMultiWorker)
-import HsDev.Server.Message as M
+import HsDev.Server.Base
 import HsDev.Server.Types
 import HsDev.Util
+import HsDev.Version
 
 #if mingw32_HOST_OS
 import Data.Aeson.Types hiding (Result, Error)
@@ -75,223 +59,23 @@ import System.Posix.IO
 #endif
 
--- | Server commands
-commands :: [Cmd (IO ())]
-commands = [
-	cmd' "start" server' "start remote server" start',
-	cmd' "run" server' "run server" run',
-	cmd' "stop" client' "stop remote server" stop',
-	cmd' "connect" client' "connect to send commands directly" connect']
-	where
-		cmd' :: String -> ([Opt], Opts String) -> String -> (Args -> IO ()) -> Cmd (IO ())
-		cmd' nm (opts', defOpts') desc' act' =
-			cmd nm [] opts' desc' act' `with` [defaultOpts defOpts']
-
-		server' = (serverOpts, serverDefCfg)
-		client' = (clientOpts, clientDefCfg)
-
-		-- | Start remote server
-		start' :: Args -> IO ()
-		start' (Args _ sopts) = do
-#if mingw32_HOST_OS
-			let
-				args = ["run"] ++ toArgs (Args [] sopts)
-			myExe <- getExecutablePath
-			curDir <- getCurrentDirectory
-			let
-				-- one escape for start-process and other for callable process
-				-- seems, that start-process just concats arguments into one string
-				-- start-process foo 'bar baz' ⇒ foo bar baz -- not expected
-				-- start-process foo '"bar baz"' ⇒ foo "bar baz" -- ok
-				biescape = escape quote . escape quoteDouble
-				script = "try { start-process $ $ -WindowStyle Hidden -WorkingDirectory $ } catch { $$_.Exception, $$_.InvocationInfo.Line }" ~~ (
-					escape quote myExe %
-					(intercalate ", " (map biescape args)) %
-					escape quote curDir)
-			r <- readProcess "powershell" [
-				"-Command",
-				script] ""
-			if all isSpace r
-				then putStrLn $ "Server started at port " ++ (fromJust $ arg "port" sopts)
-				else mapM_ putStrLn [
-					"Failed to start server",
-					"\tCommand: " ++ script,
-					"\tResult: " ++ 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' (Args [] sopts)
-
-			handle forkError $ do
-				_ <- forkProcess proxy
-				putStrLn $ "Server started at port " ++ fromJust (arg "port" sopts)
-#endif
-
-		-- | Run server
-		run' :: Args -> IO ()
-		run' (Args _ sopts)
-			| flagSet "as-client" sopts = runServer sopts $ \copts -> do
-				commandLog copts Log.Info $ "Server started as client connecting at port " ++ fromJust (arg "port" sopts)
-				me <- myThreadId
-				s <- socket AF_INET Stream defaultProtocol
-				addr' <- inet_addr "127.0.0.1"
-				Net.connect s $ SockAddrInet (fromIntegral $ fromJust $ iarg "port" sopts) addr'
-				flip finally (close s) $ processClientSocket s (copts {
-					commandExit = killThread me })
-			| otherwise = runServer sopts $ \copts -> do
-				commandLog copts Log.Info $ "Server started at port " ++ fromJust (arg "port" sopts)
-
-				waitListen <- newEmptyMVar
-				clientChan <- F.newChan
-
-				void $ forkIO $ do
-					accepter <- myThreadId
-
-					let
-						serverStop :: IO ()
-						serverStop = void $ forkIO $ do
-							void $ tryPutMVar waitListen ()
-							killThread accepter
-
-					s <- socket AF_INET Stream defaultProtocol
-					bind s $ SockAddrInet (fromIntegral $ fromJust $ iarg "port" sopts) iNADDR_ANY
-					listen s maxListenQueue
-					forever $ logIO "accept client exception: " (commandLog copts Log.Error) $ do
-						s' <- fst <$> accept s
-						void $ forkIO $ logIO (show s' ++ " exception: ") (commandLog copts Log.Error) $
-							flip finally (close s') $
-								bracket newEmptyMVar (`putMVar` ()) $ \done -> do
-									me <- myThreadId
-									let
-										timeoutWait = do
-											notDone <- isEmptyMVar done
-											when notDone $ do
-												void $ forkIO $ do
-													threadDelay 1000000
-													void $ tryPutMVar done ()
-													killThread me
-												takeMVar done
-										-- waitForever = forever $ hGetLineBS h
-									F.putChan clientChan timeoutWait
-									processClientSocket s' (copts {
-										-- commandHold = waitForever,
-										commandExit = serverStop })
-
-				takeMVar waitListen
-				DB.readAsync (commandDatabase copts) >>= writeCache sopts (commandLog copts)
-				F.stopChan clientChan >>= sequence_
-				commandLog copts Log.Info "server stopped"
-
-		-- | Stop remote server
-		stop' :: Args -> IO ()
-		stop' (Args _ copts) = runArgs (map clientCmd Client.commands) onDef onError (Args ["exit"] copts) where
-			onDef = putStrLn "Command 'exit' not found"
-			onError es = putStrLn $ "Failed to stop server: " ++ es
-
-		-- | Connect to remote server
-		connect' :: Args -> IO ()
-		connect' (Args _ copts) = do
-			curDir <- getCurrentDirectory
-			s <- socket AF_INET Stream defaultProtocol
-			addr' <- inet_addr "127.0.0.1"
-			Net.connect s (SockAddrInet (fromIntegral $ fromJust $ iarg "port" copts) addr')
-			bracket (socketToHandle s ReadWriteMode) hClose $ \h -> forM_ [(1 :: Integer)..] $ \i -> ignoreIO $ do
-				input' <- hGetLineBS stdin
-				case decodeLispOrJSON input' of
-					Left _ -> L.putStrLn $ encodeValue False $ object ["error" .= ("invalid command" :: String)]
-					Right (isLisp, req') -> do
-						L.hPutStrLn h $ encodeLispOrJSON isLisp $ Message (Just $ show i) $
-							req' `M.withOpts` ["current-directory" %-- curDir]
-						waitResp h
-			where
-				pretty = flagSet "pretty" copts
-
-				encodeValue :: ToJSON a => Bool -> a -> L.ByteString
-				encodeValue True = encodeLisp
-				encodeValue False
-					| pretty = encodePretty
-					| otherwise = encode
-
-				waitResp h = do
-					resp <- hGetLineBS h
-					parseResp h resp
-
-				parseResp h str = case decodeLispOrJSON str of
-					Left e -> putStrLn $ "Can't decode response: " ++ e
-					Right (isLisp, Message i r) -> do
-						r' <- unMmap r
-						putStrLn $ fromMaybe "_" i ++ ":" ++ fromUtf8 (encodeValue isLisp r')
-						case r of
-							Left _ -> waitResp h
-							_ -> return ()
-
--- | Server options
-serverOpts :: [Opt]
-serverOpts = [
-	req "port" "number" `desc` "listen port",
-	req "timeout" "msec" `desc` "query timeout",
-	req "log" "file" `short` ['l'] `desc` "log file",
-	req "log-config" "config" `desc` "config log",
-	req "cache" "path" `desc` "cache directory",
-	flag "load" `desc` "force load all data from cache on startup"]
-
--- | Client options
-clientOpts :: [Opt]
-clientOpts = [
-	req "port" "number" `desc` "connection port",
-	flag "pretty" `desc` "pretty json output",
-	flag "stdin" `desc` "pass data to stdin",
-	req "timeout" "msec" `desc` "overwrite timeout duration",
-	flag "silent" `desc` "supress notifications"]
-
--- | Server default options
-serverDefCfg :: Opts String
-serverDefCfg = mconcat [
-	"port" %-- (4567 :: Int),
-	"timeout" %-- (1000 :: Int)]
-
--- | Client default options
-clientDefCfg :: Opts String
-clientDefCfg = mconcat ["port" %-- (4567 :: Int)]
-
--- | Command to send to client
-clientCmd :: Cmd CommandAction -> Cmd (IO ())
-clientCmd c = cmd (cmdName c) (cmdArgs c) (cmdOpts c ++ clientOpts) (cmdDesc c) (sendCmd (cmdName c))
-	`with` [defaultOpts clientDefCfg]
-
--- | Send command to server
-sendCmd :: String -> Args -> IO ()
-sendCmd name (Args args opts) = do
-	var <- newEmptyMVar
-	thId <- forkIO $ ignoreIO sendReceive >> putMVar var ()
-	handle (\(SomeException _) -> killThread thId) $ takeMVar var
+sendCommand :: ClientOpts -> Bool -> Command -> (Notification -> IO a) -> IO Result
+sendCommand copts noFile c onNotification = do
+	asyncAct <- async sendReceive
+	res <- waitCatch asyncAct
+	case res of
+		Left e -> return $ Error (show e) $ M.fromList []
+		Right r -> return r
 	where
-		(copts, opts') = splitOpts clientOpts opts
-		reqCall = Request name args opts'
-		pretty = flagSet "pretty" copts
 		encodeValue :: ToJSON a => a -> L.ByteString
 		encodeValue
-			| pretty = encodePretty
+			| clientPretty copts = encodePretty
 			| otherwise = encode
 		sendReceive = do
 			curDir <- getCurrentDirectory
-			input <- if flagSet "stdin" copts
+			input <- if clientStdin copts
 				then liftM Just L.getContents
-				else return $ fmap toUtf8 $ arg "data" copts
+				else return $ fmap toUtf8 $ Nothing -- arg "data" copts
 			let
 				parseData :: L.ByteString -> IO Value
 				parseData cts = case eitherDecode cts of
@@ -301,13 +85,9 @@ 
 			s <- socket AF_INET Stream defaultProtocol
 			addr' <- inet_addr "127.0.0.1"
-			Net.connect s (SockAddrInet (fromIntegral $ fromJust $ iarg "port" copts) addr')
+			Net.connect s (SockAddrInet (fromIntegral $ clientPort copts) addr')
 			bracket (socketToHandle s ReadWriteMode) hClose $ \h -> do
-				L.hPutStrLn h $ encode $ Message Nothing $ reqCall `M.withOpts` [
-					"current-directory" %-- curDir,
-					"data" %-? (fromUtf8 . encode <$> dat),
-					"timeout" %-? (iarg "timeout" copts :: Maybe Integer),
-					if flagSet "silent" copts then hoist "silent" else mempty]
+				L.hPutStrLn h $ encode $ Message Nothing $ Request c curDir noFile (clientTimeout copts) (clientSilent copts)
 				hFlush h
 				peekResponse h
 
@@ -315,126 +95,172 @@ 			resp <- hGetLineBS h
 			parseResponse h resp
 
-		parseResponse h str = case decodeLispOrJSON str of
-			Left e -> putStrLn $ "Can't decode response: " ++ e
-			Right (_, Message _ r) -> do
+		parseResponse h str = case eitherDecode str of
+			Left e -> return $ Error e $ M.fromList [("response", toJSON $ fromUtf8 str)]
+			Right (Message _ r) -> do
 				r' <- unMmap r
-				L.putStrLn $ case r' of
-					Left n -> encodeValue n
-					Right (Result v) -> encodeValue v
-					Right e -> encodeValue e
-				when (isLeft r') $ peekResponse h
+				case r' of
+					Left n -> onNotification n >> peekResponse h
+					Right r -> return r
 
-chaner :: F.Chan String -> Consumer Text
-chaner ch = Consumer withChan where
-	withChan f = f (F.putChan ch . T.unpack)
+runServerCommand :: ServerCommand -> IO ()
+runServerCommand Version = putStrLn $cabalVersion
+runServerCommand (Start sopts) = do
+#if mingw32_HOST_OS
+	let
+		args = "run" : serverOptsArgs sopts
+	myExe <- getExecutablePath
+	curDir <- getCurrentDirectory
+	let
+		-- one escape for start-process and other for callable process
+		-- seems, that start-process just concats arguments into one string
+		-- start-process foo 'bar baz' ⇒ foo bar baz -- not expected
+		-- start-process foo '"bar baz"' ⇒ foo "bar baz" -- ok
+		biescape = escape quote . escape quoteDouble
+		script = "try {{ start-process {} {} -WindowStyle Hidden -WorkingDirectory {} }} catch {{ $_.Exception, $_.InvocationInfo.Line }}"
+			~~ escape quote myExe
+			~~ intercalate ", " (map biescape args)
+			~~ escape quote curDir
+	r <- readProcess "powershell" [
+		"-Command",
+		script] ""
+	if all isSpace r
+		then putStrLn $ "Server started at port " ++ show (serverPort sopts)
+		else mapM_ putStrLn [
+			"Failed to start server",
+			"\tCommand: " ++ script,
+			"\tResult: " ++ r]
+#else
+	let
+		forkError :: SomeException -> IO ()
+		forkError e  = putStrLn $ "Failed to start server: " ++ show e
 
-instance Format Log.Level where
+		proxy :: IO ()
+		proxy = do
+			_ <- createSession
+			_ <- forkProcess serverAction
+			exitImmediately ExitSuccess
 
--- | Inits log chan and returns functions (print message, wait channel)
-initLog :: Opts String -> IO (Log, Log.Level -> String -> IO (), ([String] -> IO ()) -> IO (), IO ())
-initLog sopts = do
-	msgs <- F.newChan
-	outputDone <- newEmptyMVar
-	void $ forkIO $ finally
-		(F.readChan msgs >>= mapM_ (const $ return ()))
-		(putMVar outputDone ())
-	l <- newLog (constant [rule']) $ concat [
-		[logger text console],
-		[logger text (chaner msgs)],
-		maybeToList $ (logger text . file) <$> arg "log" sopts]
-	Log.writeLog l Log.Info ("Log politics: low = $, high = $" ~~ (logLow % logHigh))
-	let
-		listenLog f = logException "listen log" (F.putChan msgs) $ do
-			msgs' <- F.dupChan msgs
-			F.readChan msgs' >>= f
-	return (l, \lev -> writeLog l lev . T.pack, listenLog, F.closeChan msgs >> takeMVar outputDone)
-	where
-		rule' :: Log.Rule
-		rule' = fromMaybe (Log.Rule null $ const Log.tracePolitics) $
-			(parseRule_ . T.pack . ("/: " ++)) <$>
-			arg "log-config" sopts
-		(Log.Politics logLow logHigh) = Log.rulePolitics rule' Log.defaultPolitics
+		serverAction :: IO ()
+		serverAction = do
+			mapM_ closeFd [stdInput, stdOutput, stdError]
+			nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags
+			mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError]
+			closeFd nullFd
+			runServerCommand (Run sopts)
 
--- | Run server
-runServer :: Opts String -> (CommandOptions -> IO ()) -> IO ()
-runServer sopts act = bracket (initLog sopts) (\(_, _, _, x) -> x) $ \(logger', outputStr, listenLog, waitOutput) -> Log.scopeLog logger' (T.pack "hsdev") $ Watcher.withWatcher $ \watcher -> do
-	db <- DB.newAsync
-	when (flagSet "load" sopts) $ withCache sopts () $ \cdir -> do
-		outputStr Log.Info $ "Loading cache from " ++ cdir
-		dbCache <- liftA merge <$> SC.load cdir
-		case dbCache of
-			Left err -> outputStr Log.Error $ "Failed to load cache: " ++ err
-			Right dbCache' -> DB.update db (return dbCache')
-#if mingw32_HOST_OS
-	mmapPool <- Just <$> createPool "hsdev"
-#endif
-	ghcw <- ghcWorker [] (return ())
-	ghciw <- ghciWorker
-	ghcmodw <- ghcModMultiWorker
-	let
-		copts = CommandOptions
-			db
-			(writeCache sopts outputStr)
-			(readCache sopts outputStr)
-			"."
-			outputStr
-			logger'
-			listenLog
-			waitOutput
-			watcher
-#if mingw32_HOST_OS
-			mmapPool
+	handle forkError $ do
+		_ <- forkProcess proxy
+		putStrLn $ "Server started at port " ++ show (serverPort sopts)
 #endif
-			ghcw
-			ghciw
-			ghcmodw
-			(const $ return ())
-			(return ())
-			(return ())
-			(return ())
-	_ <- forkIO $ Update.onEvent watcher (Update.processEvent $ Update.settings copts mempty)
-	act copts
+runServerCommand (Run sopts) = runServer sopts $ \copts -> do
+	commandLog copts Log.Info $ "Server started at port " ++ show (serverPort sopts)
 
-decodeLispOrJSON :: FromJSON a => ByteString -> Either String (Bool, a)
-decodeLispOrJSON str =
-	((,) <$> pure False <*> eitherDecode str) <|>
-	((,) <$> pure True <*> decodeLisp str)
+	waitListen <- newEmptyMVar
+	clientChan <- F.newChan
 
-encodeLispOrJSON :: ToJSON a => Bool -> a -> ByteString
-encodeLispOrJSON True = encodeLisp
-encodeLispOrJSON False = encode
+	void $ forkIO $ do
+		accepter <- myThreadId
 
--- | Process request, notifications can be sent during processing
-processRequest :: CommandOptions -> (Notification -> IO ()) -> Request -> IO Result
-processRequest copts onNotify req' =
-	runArgs
-		Client.commands
-		unknownCommand
-		requestError
-		(requestToArgs req')
-		(copts { commandNotify = onNotify })
+		let
+			serverStop :: IO ()
+			serverStop = void $ forkIO $ do
+				void $ tryPutMVar waitListen ()
+				killThread accepter
+
+		s <- socket AF_INET Stream defaultProtocol
+		bind s $ SockAddrInet (fromIntegral $ serverPort sopts) iNADDR_ANY
+		listen s maxListenQueue
+		forever $ logAsync (commandLog copts Log.Fatal) $ logIO "accept client exception: " (commandLog copts Log.Error) $ do
+			s' <- fst <$> accept s
+			void $ forkIO $ logAsync (commandLog copts Log.Fatal) $ logIO (show s' ++ " exception: ") (commandLog copts Log.Error) $
+				flip finally (close s') $
+					bracket newEmptyMVar (`putMVar` ()) $ \done -> do
+						me <- myThreadId
+						let
+							timeoutWait = do
+								notDone <- isEmptyMVar done
+								when notDone $ do
+									void $ forkIO $ do
+										threadDelay 1000000
+										void $ tryPutMVar done ()
+										killThread me
+									takeMVar done
+							-- waitForever = forever $ hGetLineBS h
+						F.putChan clientChan timeoutWait
+						processClientSocket s' (copts {
+							-- commandHold = waitForever,
+							commandExit = serverStop })
+
+	takeMVar waitListen
+	DB.readAsync (commandDatabase copts) >>= writeCache sopts (commandLog copts)
+	F.stopChan clientChan >>= sequence_
+	commandLog copts Log.Info "server stopped"
+runServerCommand (Stop copts) = runServerCommand (Remote copts False Exit)
+runServerCommand (Connect copts) = do
+	curDir <- getCurrentDirectory
+	s <- socket AF_INET Stream defaultProtocol
+	addr' <- inet_addr "127.0.0.1"
+	Net.connect s (SockAddrInet (fromIntegral $ clientPort copts) addr')
+	bracket (socketToHandle s ReadWriteMode) hClose $ \h -> forM_ [(1 :: Integer)..] $ \i -> ignoreIO $ do
+		input' <- hGetLineBS stdin
+		case eitherDecode input' of
+			Left _ -> L.putStrLn $ encodeValue $ object ["error" .= ("invalid command" :: String)]
+			Right req' -> do
+				L.hPutStrLn h $ encode $ Message (Just $ show i) $ Request req' curDir True (clientTimeout copts) False
+				waitResp h
 	where
-		unknownCommand :: CommandAction
-		unknownCommand _ = return $ Error "Unknown command" M.empty
+		pretty = clientPretty copts
 
-		requestError :: String -> CommandAction
-		requestError errs _ = return $ Error "Command syntax error" $ M.fromList [
-			("what", toJSON $ lines errs)]
+		encodeValue :: ToJSON a => a -> L.ByteString
+		encodeValue
+			| pretty = encodePretty
+			| otherwise = encode
 
+		waitResp h = do
+			resp <- hGetLineBS h
+			parseResp h resp
+
+		parseResp h str = case eitherDecode str of
+			Left e -> putStrLn $ "Can't decode response: " ++ e
+			Right (Message i r) -> do
+				r' <- unMmap r
+				putStrLn $ fromMaybe "_" i ++ ":" ++ fromUtf8 (encodeValue r')
+				case r of
+					Left _ -> waitResp h
+					_ -> return ()
+runServerCommand (Remote copts noFile c) = sendCommand copts noFile c printValue >>= printResult where
+	printValue :: ToJSON a => a -> IO ()
+	printValue = L.putStrLn . encodeValue
+	printResult :: Result -> IO ()
+	printResult (Result r) = printValue r
+	printResult e = printValue e
+	encodeValue :: ToJSON a => a -> L.ByteString
+	encodeValue = if clientPretty copts then encodePretty else encode
+
+findPath :: MonadIO m => CommandOptions -> FilePath -> m FilePath
+findPath copts f = liftIO $ canonicalizePath (normalise f') where
+	f'
+		| isRelative f = commandRoot copts </> f
+		| otherwise = f
+
+-- | Process request, notifications can be sent during processing
+processRequest :: CommandOptions -> (Notification -> IO ()) -> Command -> IO Result
+processRequest copts onNotify c = paths (findPath copts) c >>= Client.runCommand (copts { commandNotify = onNotify })
+
 -- | Process client, listen for requests and process them
 processClient :: String -> IO ByteString -> (ByteString -> IO ()) -> CommandOptions -> IO ()
 processClient name receive send' copts = do
 	commandLog copts Log.Info $ name ++ " connected"
 	respChan <- newChan
-	void $ forkIO $ getChanContents respChan >>= mapM_ (send' . uncurry encodeLispOrJSON)
+	void $ forkIO $ getChanContents respChan >>= mapM_ (send' . encode)
 	linkVar <- newMVar $ return ()
 	let
-		answer :: Bool -> Message Response -> IO ()
-		answer isLisp m@(Message _ r) = do
-			when (not $ isNotification r) $
+		answer :: Message Response -> IO ()
+		answer m@(Message _ r) = do
+			unless (isNotification r) $
 				commandLog copts Log.Trace $ " << " ++ ellipsis (fromUtf8 (encode r))
-			writeChan respChan (isLisp, m)
+			writeChan respChan m
 			where
 				ellipsis :: String -> String
 				ellipsis s
@@ -443,44 +269,31 @@ 	flip finally (disconnected linkVar) $ forever $ Log.scopeLog (commandLogger copts) (T.pack name) $ do
 		req' <- receive
 		commandLog copts Log.Trace $ " => " ++ fromUtf8 req'
-		case second (fmap extractMeta) <$> decodeLispOrJSON req' of
+		case eitherDecode req' of
 			Left _ -> do
 				commandLog copts Log.Warning $ "Invalid request: " ++ fromUtf8 req'
-				answer False $ Message Nothing $ responseError "Invalid request" [
+				answer $ Message Nothing $ responseError "Invalid request" [
 					"request" .= fromUtf8 req']
-			Right (isLisp, m) -> Log.scopeLog (commandLogger copts) (T.pack $ fromMaybe "_" (messageId m)) $ do
-				resp' <- flip traverse m $ \(cdir, noFile, silent, tm, reqArgs) -> do
+			Right m -> Log.scopeLog (commandLogger copts) (T.pack $ fromMaybe "_" (messageId m)) $ do
+				resp' <- for m $ \(Request c cdir noFile tm silent) -> do
 					let
 						onNotify n
 							| silent = return ()
-							| otherwise = traverse (const $ mmap' noFile (Left n)) m >>= answer isLisp
-					commandLog copts Log.Trace $ name ++ " >> " ++ fromUtf8 (encode reqArgs)
+							| otherwise = traverse (const $ mmap' noFile (Left n)) m >>= answer
+					commandLog copts Log.Trace $ name ++ " >> " ++ fromUtf8 (encode c)
 					resp <- fmap Right $ handleTimeout tm $ handleError $
 						processRequest
 							(copts {
 								commandRoot = cdir,
 								commandLink = void (swapMVar linkVar $ commandExit copts) })
 							onNotify
-							reqArgs
+							c
 					mmap' noFile resp
-				answer isLisp resp'
+				answer resp'
 	where
-		extractMeta :: Request -> (FilePath, Bool, Bool, Maybe Int, Request)
-		extractMeta c = (cdir, noFile, silent, tm, c { requestOpts = opts' }) where
-			cdir = fromMaybe (commandRoot copts) $ arg "current-directory" metaOpts
-			noFile = flagSet "no-file" metaOpts
-			silent = flagSet "silent" metaOpts
-			tm = join $ fmap readMaybe $ arg "timeout" metaOpts
-			(metaOpts, opts') = splitOpts [
-				req "current-directory" "path",
-				flag "no-file",
-				flag "silent",
-				req "timeout" "ms"]
-				(requestOpts c)
-
-		handleTimeout :: Maybe Int -> IO Result -> IO Result
-		handleTimeout Nothing = id
-		handleTimeout (Just tm) = fmap (fromMaybe $ Error "Timeout" M.empty) . timeout tm
+		handleTimeout :: Int -> IO Result -> IO Result
+		handleTimeout 0 = id
+		handleTimeout tm = fmap (fromMaybe $ Error "Timeout" M.empty) . timeout tm
 
 		handleError :: IO Result -> IO Result
 		handleError = handle onErr where
@@ -499,12 +312,6 @@ 			commandLog copts Log.Info $ name ++ " disconnected"
 			join $ takeMVar var
 
-{-
--- | Process client by Handle
-processClientHandle :: Show a => a -> Handle -> CommandOptions -> IO ()
-processClientHandle n h = processClient (show n) (hGetLineBS h) (\s -> L.hPutStrLn h s >> hFlush h)
--}
-
 -- | Process client by socket
 processClientSocket :: Socket -> CommandOptions -> IO ()
 processClientSocket s copts = do
@@ -530,37 +337,6 @@ 			| otherwise = do
 				sent <- Net.send sock bs
 				when (sent > 0) $ sendAll sock (BS.drop sent bs)
-
--- | Perform action on cache
-withCache :: Opts String -> a -> (FilePath -> IO a) -> IO a
-withCache sopts v onCache = case arg "cache" sopts of
-	Nothing -> return v
-	Just cdir -> onCache cdir
-
-writeCache :: Opts String -> (Log.Level -> String -> IO ()) -> Database -> IO ()
-writeCache sopts logMsg' d = withCache sopts () $ \cdir -> do
-	logMsg' Log.Info $ "writing cache to " ++ cdir
-	logIO "cache writing exception: " (logMsg' Log.Error) $ do
-		let
-			sd = structurize d
-		SC.dump cdir sd
-		forM_ (M.keys (structuredCabals sd)) $ \c -> logMsg' Log.Debug ("cache write: cabal " ++ show c)
-		forM_ (M.keys (structuredProjects sd)) $ \p -> logMsg' Log.Debug ("cache write: project " ++ p)
-		case allModules (structuredFiles sd) of
-			[] -> return ()
-			ms -> logMsg' Log.Debug $ "cache write: " ++ show (length ms) ++ " files"
-	logMsg' Log.Info $ "cache saved to " ++ cdir
-
-readCache :: Opts String -> (Log.Level -> String -> IO ()) -> (FilePath -> ExceptT String IO Structured) -> IO (Maybe Database)
-readCache sopts logMsg' act = withCache sopts Nothing $ join . liftM (either cacheErr cacheOk) . runExceptT . act where
-	cacheErr e = logMsg' Log.Error ("Error reading cache: " ++ e) >> return Nothing
-	cacheOk s = do
-		forM_ (M.keys (structuredCabals s)) $ \c -> logMsg' Log.Debug ("cache read: cabal " ++ show c)
-		forM_ (M.keys (structuredProjects s)) $ \p -> logMsg' Log.Debug ("cache read: project " ++ p)
-		case allModules (structuredFiles s) of
-			[] -> return ()
-			ms -> logMsg' Log.Debug $ "cache read: " ++ show (length ms) ++ " files"
-		return $ Just $ merge s
 
 #if mingw32_HOST_OS
 data MmapFile = MmapFile String
src/HsDev/Server/Message.hs view
@@ -3,8 +3,6 @@ module HsDev.Server.Message (
 	Message(..),
 	messagesById,
-	Request(..), requestToArgs,
-	withOpts, withoutOpts,
 	Notification(..), Result(..), ResultPart(..),
 	Response, isNotification, notification, result, responseError, resultPart,
 	groupResponses, responsesById
@@ -17,12 +15,10 @@ import Data.Aeson.Types (Pair)
 import Data.Either (lefts, isRight)
 import Data.List (unfoldr)
-import Data.Maybe
 import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Text (unpack)
 
-import System.Console.Args hiding (withOpts)
 import HsDev.Util ((.::), (.::?), objectUnion)
 
 -- | Message with id to link request and response
@@ -48,37 +44,6 @@ messagesById :: Maybe String -> [Message a] -> [a]
 messagesById i = map message . filter ((== i) . messageId)
 
--- | Request from client
-data Request = Request {
-	requestCommand :: String,
-	requestArgs :: [String],
-	requestOpts :: Opts String }
-
-requestToArgs :: Request -> Args
-requestToArgs (Request c as opts) = Args (words c ++ as) opts
-
-instance ToJSON Request where
-	toJSON (Request c as os) = object [
-		"command" .= c,
-		"args" .= as,
-		"opts" .= os]
-
-instance FromJSON Request where
-	parseJSON = withObject "request" $ \v -> Request <$>
-		v .:: "command" <*>
-		(fromMaybe [] <$> v .::? "args") <*>
-		(fromMaybe mempty <$> v .::? "opts")
-
--- | Add options to request
-withOpts :: Request -> [Opts String] -> Request
-withOpts r os = r {
-	requestOpts = mconcat (requestOpts r : os) }
-
--- | Remove options from request
-withoutOpts :: Request -> [String] -> Request
-withoutOpts r os = r {
-	requestOpts = Opts $ foldr (.) id (map M.delete os) $ getOpts (requestOpts r) }
-
 -- | Notification from server
 data Notification = Notification Value
 
@@ -96,16 +61,15 @@ 	-- ^ Error
 
 instance ToJSON Result where
-	toJSON (Result r) = object [
-		"result" .= r]
+	toJSON (Result r) = object ["result" .= r]
 	toJSON (Error msg rs) = object [
 		"error" .= msg,
 		"details" .= toJSON rs]
 
 instance FromJSON Result where
-	parseJSON = withObject "result" $ \v -> foldr1 (<|>) [
-		Result <$> v .:: "result",
-		Error <$> v .:: "error" <*> v .:: "details"]
+	parseJSON = withObject "result" $ \v ->
+		(Result <$> v .:: "result") <|>
+		(Error <$> v .:: "error" <*> v .:: "details")
 
 -- | Part of result list, returns via notification
 data ResultPart = ResultPart Value
src/HsDev/Server/Types.hs view
@@ -2,26 +2,41 @@ 
 module HsDev.Server.Types (
 	CommandOptions(..), CommandError(..), commandError_, commandError,
-	CommandAction, CommandM, CommandActionT,
-	ResultValue(..)
+	CommandM,
+	ServerCommand(..), ServerOpts(..), ClientOpts(..), serverOptsArgs, Request(..),
+
+	Command(..), AddedContents(..),
+	GhcModCommand(..),
+	AutoFixCommand(..),
+	FileContents(..), TargetFilter(..), SearchQuery(..), SearchType(..),
+	FromCmd(..),
 	) where
 
 import Control.Applicative
+import Control.Lens (each)
 import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Aeson hiding (Result, Error)
-import Data.Aeson.Types (Pair)
-import qualified Data.HashMap.Strict as HM (null)
-import System.Log.Simple
+import Data.Aeson hiding (Result(..), Error)
+import qualified Data.Aeson.Types as A
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Default
+import Data.Foldable (asum)
+import Options.Applicative
+import System.Log.Simple hiding (Command)
 
+import System.Directory.Paths
+
 import HsDev.Database
 import qualified HsDev.Database.Async as DB
 import HsDev.Project
 import HsDev.Symbols
 import HsDev.Server.Message
 import HsDev.Watcher.Types (Watcher)
-import HsDev.Tools.GhcMod (OutputMessage, TypedRegion, WorkerMap)
+import HsDev.Tools.GhcMod (OutputMessage, WorkerMap)
 import HsDev.Tools.Ghc.Worker (Worker, Ghc)
+import HsDev.Tools.Types (Note)
+import HsDev.Tools.AutoFix (Correction)
+import HsDev.Util
 
 #if mingw32_HOST_OS
 import System.Win32.FileMapping.NamePool (Pool)
@@ -46,9 +61,10 @@ 	commandNotify :: Notification -> IO (),
 	commandLink :: IO (),
 	commandHold :: IO (),
-	commandExit :: IO () }
+	commandExit :: IO (),
+	commandDefines :: [(String, String)] }
 
-data CommandError = CommandError String [Pair]
+data CommandError = CommandError String [A.Pair]
 
 instance Monoid CommandError where
 	mempty = CommandError "" []
@@ -57,65 +73,552 @@ commandError_ :: String -> ExceptT CommandError IO a
 commandError_ m = commandError m []
 
-commandError :: String -> [Pair] -> ExceptT CommandError IO a
+commandError :: String -> [A.Pair] -> ExceptT CommandError IO a
 commandError m ps = throwError $ CommandError m ps
 
-type CommandAction = CommandOptions -> IO Result
-
 type CommandM a = ExceptT CommandError IO a
 
-type CommandActionT a = CommandOptions -> CommandM a
+-- | Server control command
+data ServerCommand =
+	Version |
+	Start ServerOpts |
+	Run ServerOpts |
+	Stop ClientOpts |
+	Connect ClientOpts |
+	Remote ClientOpts Bool Command
+		deriving (Show)
 
-data ResultValue =
-	ResultDatabase Database |
-	ResultDeclaration Declaration |
-	ResultModuleDeclaration ModuleDeclaration |
-	ResultModuleId ModuleId |
-	ResultModule Module |
-	ResultInspectedModule InspectedModule |
-	ResultPackage ModulePackage |
-	ResultProject Project |
-	ResultTyped TypedRegion |
-	ResultOutputMessage OutputMessage |
-	ResultList [ResultValue] |
-	ResultMap (Map String ResultValue) |
-	ResultJSON Value |
-	ResultString String |
-	ResultNone
+-- | Server options
+data ServerOpts = ServerOpts {
+	serverPort :: Int,
+	serverTimeout :: Int,
+	serverLog :: Maybe FilePath,
+	serverLogConfig :: String,
+	serverCache :: Maybe FilePath,
+	serverLoad :: Bool }
+		deriving (Show)
 
-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 (ResultOutputMessage e) = toJSON e
-	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 Default ServerOpts where
+	def = ServerOpts 4567 0 Nothing "use default" Nothing False
 
-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,
-		ResultOutputMessage <$> parseJSON v,
-		ResultList <$> parseJSON v,
-		ResultMap <$> parseJSON v,
-		pure $ ResultJSON v,
-		ResultString <$> parseJSON v]
+-- | Client options
+data ClientOpts = ClientOpts {
+	clientPort :: Int,
+	clientPretty :: Bool,
+	clientStdin :: Bool,
+	clientTimeout :: Int,
+	clientSilent :: Bool }
+		deriving (Show)
+
+instance Default ClientOpts where
+	def = ClientOpts 4567 False False 0 False
+
+instance FromCmd ServerCommand where
+	cmdP = serv <|> remote where
+		serv = subparser $ mconcat [
+			cmd "version" "hsdev version" (pure Version),
+			cmd "start" "start remote server" (Start <$> cmdP),
+			cmd "run" "run server" (Run <$> cmdP),
+			cmd "stop" "stop remote server" (Stop <$> cmdP),
+			cmd "connect" "connect to send commands directly" (Connect <$> cmdP)]
+		remote = Remote <$> cmdP <*> noFileFlag <*> cmdP
+
+instance FromCmd ServerOpts where
+	cmdP = ServerOpts <$>
+		(portArg <|> pure (serverPort def)) <*>
+		(timeoutArg <|> pure (serverTimeout def)) <*>
+		optional logArg <*>
+		(logConfigArg <|> pure (serverLogConfig def)) <*>
+		optional cacheArg <*>
+		loadFlag
+
+instance FromCmd ClientOpts where
+	cmdP = ClientOpts <$>
+		(portArg <|> pure (clientPort def)) <*>
+		prettyFlag <*>
+		stdinFlag <*>
+		(timeoutArg <|> pure (clientTimeout def)) <*>
+		silentFlag
+
+portArg = option auto (long "port" <> metavar "number" <> help "connection port")
+timeoutArg = option auto (long "timeout" <> metavar "msec" <> help "query timeout")
+logArg = strOption (long "log" <> short 'l' <> metavar "file" <> help "log file")
+logConfigArg = strOption (long "log-config" <> metavar "rule" <> help "log config: low [low], high [high], set [low] [high], use [default/debug/trace/silent/supress]")
+cacheArg = strOption (long "cache" <> metavar "path" <> help "cache directory")
+noFileFlag = switch (long "no-file" <> help "don't use mmap files")
+loadFlag = switch (long "load" <> help "force load all data from cache on startup")
+prettyFlag = switch (long "pretty" <> help "pretty json output")
+stdinFlag = switch (long "stdin" <> help "pass data to stdin")
+silentFlag = switch (long "silent" <> help "supress notifications")
+
+serverOptsArgs :: ServerOpts -> [String]
+serverOptsArgs sopts = concat [
+	["--port", show $ serverPort sopts],
+	["--timeout", show $ serverTimeout sopts],
+	marg "--log" (serverLog sopts),
+	["--log-config", serverLogConfig sopts],
+	marg "--cache" (serverCache sopts),
+	["--load" | serverLoad sopts]]
+	where
+		marg :: String -> Maybe String -> [String]
+		marg n (Just v) = [n, v]
+		marg _ _ = []
+
+data Request = Request {
+	requestCommand :: Command,
+	requestDirectory :: FilePath,
+	requestNoFile :: Bool,
+	requestTimeout :: Int,
+	requestSilent :: Bool }
+
+instance ToJSON Request where
+	toJSON (Request c dir f tm s) = object ["current-directory" .= dir, "no-file" .= f, "timeout" .= tm, "silent" .= s] `objectUnion` toJSON c
+
+instance FromJSON Request where
+	parseJSON = withObject "request" $ \v -> Request <$>
+		parseJSON (Object v) <*>
+		((v .:: "current-directory") <|> pure ".") <*>
+		((v .:: "no-file") <|> pure False) <*>
+		((v .:: "timeout") <|> pure 0) <*>
+		((v .:: "silent") <|> pure False)
+
+-- FIXME: Why so much commands in options?
+-- | Command from client
+data Command =
+	Ping |
+	Listen |
+	AddData { addedContents :: [AddedContents] } |
+	Scan {
+		scanProjects :: [FilePath],
+		scanSandboxes :: [Cabal],
+		scanFiles :: [FilePath],
+		scanPaths :: [FilePath],
+		scanContents :: [FileContents],
+		scanGhcOpts :: [String],
+		scanDocs :: Bool,
+		scanInferTypes :: Bool } |
+	RefineDocs {
+		docsProjects :: [FilePath],
+		docsFiles :: [FilePath],
+		docsModules :: [String] } |
+	InferTypes {
+		inferProjects :: [FilePath],
+		inferFiles :: [FilePath],
+		inferModules :: [String] } |
+	Remove {
+		removeProjects :: [FilePath],
+		removePackages :: [String],
+		removeSandboxes :: [Cabal],
+		removeFiles :: [FilePath] } |
+	InfoModules TargetFilter |
+	InfoPackages |
+	InfoProjects |
+	InfoSandboxes |
+	InfoSymbol SearchQuery TargetFilter |
+	InfoModule SearchQuery TargetFilter |
+	InfoResolve FilePath Bool |
+	InfoProject (Either String FilePath) |
+	InfoSandbox FilePath |
+	Lookup String FilePath |
+	Whois String FilePath |
+	ResolveScopeModules FilePath |
+	ResolveScope SearchQuery Bool FilePath |
+	Complete String Bool FilePath |
+	Hayoo {
+		hayooQuery :: String,
+		hayooPage :: Int,
+		hayooPages :: Int } |
+	CabalList { cabalListPackages :: [String] } |
+	Lint {
+		lintFiles :: [FilePath],
+		lintContents :: [FileContents] } |
+	Check {
+		checkFiles :: [FilePath],
+		checkContents :: [FileContents],
+		checkGhcOpts :: [String] } |
+	CheckLint {
+		checkLintFiles :: [FilePath],
+		checkLintContents :: [FileContents],
+		checkLintGhcOpts :: [String] } |
+	Types {
+		typesFiles :: [FilePath],
+		typesContents :: [FileContents],
+		typesGhcOpts :: [String] } |
+	GhcMod { ghcModCommand :: GhcModCommand } |
+	AutoFix { autoFixCommand :: AutoFixCommand } |
+	GhcEval { ghcEvalExpressions :: [String] } |
+	Link { linkHold :: Bool } |
+	Exit
+		deriving (Show)
+
+data AddedContents =
+	AddedDatabase Database |
+	AddedModule InspectedModule |
+	AddedProject Project
+
+instance Show AddedContents where
+	show = L.unpack . encode
+
+data GhcModCommand =
+	GhcModLang |
+	GhcModFlags |
+	GhcModType Position FilePath [String] |
+	GhcModLint [FilePath] [String] |
+	GhcModCheck [FilePath] [String] |
+	GhcModCheckLint [FilePath] [String] [String]
+		deriving (Show)
+
+data AutoFixCommand =
+	AutoFixShow [Note OutputMessage] |
+	AutoFixFix [Note Correction] [Note Correction] Bool
+		deriving (Show)
+
+data FileContents = FileContents FilePath String deriving (Show)
+-- TODO: Why deps is just string?
+data TargetFilter =
+	TargetProject String |
+	TargetFile FilePath |
+	TargetModule String |
+	TargetDepsOf String |
+	TargetCabal Cabal |
+	TargetPackage String |
+	TargetSourced |
+	TargetStandalone |
+	TargetAny
+		deriving (Eq, Show)
+data SearchQuery = SearchQuery String SearchType deriving (Show)
+data SearchType = SearchExact | SearchPrefix | SearchInfix | SearchSuffix | SearchRegex deriving (Show)
+
+instance Paths Command where
+	paths f (Scan projs cs fs ps fcts ghcs docs infer) = Scan <$>
+		each f projs <*>
+		(each . paths) f cs <*>
+		each f fs <*>
+		each f ps <*>
+		(each . paths) f fcts <*>
+		pure ghcs <*>
+		pure docs <*>
+		pure infer
+	paths f (RefineDocs projs fs ms) = RefineDocs <$> each f projs <*> each f fs <*> pure ms
+	paths f (InferTypes projs fs ms) = InferTypes <$> each f projs <*> each f fs <*> pure ms
+	paths f (Remove projs ps cs fs) = Remove <$> each f projs <*> pure ps <*> (each . paths) f cs <*> each f fs
+	paths f (InfoModules t) = InfoModules <$> paths f t
+	paths f (InfoSymbol q t) = InfoSymbol <$> pure q <*> paths f t
+	paths f (InfoModule q t) = InfoModule <$> pure q <*> paths f t
+	paths f (InfoResolve fpath es) = InfoResolve <$> f fpath <*> pure es
+	paths f (InfoProject (Right proj)) = InfoProject <$> (Right <$> f proj)
+	paths f (InfoSandbox fpath) = InfoSandbox <$> f fpath
+	paths f (Lookup n fpath) = Lookup <$> pure n <*> f fpath
+	paths f (Whois n fpath) = Whois <$> pure n <*> f fpath
+	paths f (ResolveScopeModules fpath) = ResolveScopeModules <$> f fpath
+	paths f (ResolveScope q g fpath) = ResolveScope q g <$> f fpath
+	paths f (Complete n g fpath) = Complete n g <$> f fpath
+	paths f (Lint fs fcts) = Lint <$> each f fs <*> (each . paths) f fcts
+	paths f (Check fs fcts ghcs) = Check <$> each f fs <*> (each . paths) f fcts <*> pure ghcs
+	paths f (CheckLint fs fcts ghcs) = CheckLint <$> each f fs <*> (each . paths) f fcts <*> pure ghcs
+	paths f (Types fs fcts ghcs) = Types <$> each f fs <*> (each . paths) f fcts <*> pure ghcs
+	paths f (GhcMod g) = GhcMod <$> paths f g
+	paths _ c = pure c
+
+instance Paths GhcModCommand where
+	paths f (GhcModType pos fpath opts) = GhcModType <$> pure pos <*> f fpath <*> pure opts
+	paths f (GhcModLint fs hlints) = GhcModLint <$> traverse f fs <*> pure hlints
+	paths f (GhcModCheck fs ghcs) = GhcModCheck <$> traverse f fs <*> pure ghcs
+	paths f (GhcModCheckLint fs ghcs hlints) = GhcModCheckLint <$> traverse f fs <*> pure ghcs <*> pure hlints
+	paths _ g = pure g
+
+instance Paths FileContents where
+	paths f (FileContents fpath cts) = FileContents <$> f fpath <*> pure cts
+
+instance Paths TargetFilter where
+	paths f (TargetFile fpath) = TargetFile <$> f fpath
+	paths f (TargetCabal c) = TargetCabal <$> paths f c
+	paths _ t = pure t
+
+instance FromCmd Command where
+	cmdP = subparser $ mconcat [
+		cmd "ping" "ping server" (pure Ping),
+		cmd "listen" "listen server log" (pure Listen),
+		cmd "add" "add info to database" (AddData <$> option readJSON idm),
+		cmd "scan" "scan sources" $ Scan <$>
+			many projectArg <*>
+			many cabalArg <*>
+			many fileArg <*>
+			many (pathArg $ help "path") <*>
+			many cmdP <*>
+			ghcOpts <*>
+			docsFlag <*>
+			inferFlag,
+		cmd "docs" "scan docs" $ RefineDocs <$> many projectArg <*> many fileArg <*> many moduleArg,
+		cmd "infer" "infer types" $ InferTypes <$> many projectArg <*> many fileArg <*> many moduleArg,
+		cmd "remove" "remove modules info" $ Remove <$>
+			many projectArg <*>
+			many packageArg <*>
+			many cabalArg <*>
+			many fileArg,
+		cmd "modules" "list modules" (InfoModules <$> cmdP),
+		cmd "packages" "list packages" (pure InfoPackages),
+		cmd "projects" "list projects" (pure InfoProjects),
+		cmd "sandboxes" "list sandboxes" (pure InfoSandboxes),
+		cmd "symbol" "get symbol info" (InfoSymbol <$> cmdP <*> cmdP),
+		cmd "module" "get module info" (InfoModule <$> cmdP <*> cmdP),
+		cmd "resolve" "resolve module scope (or exports)" (InfoResolve <$> fileArg <*> exportsFlag),
+		cmd "project" "get project info" (InfoProject <$> ((Left <$> projectArg) <|> (Right <$> pathArg idm))),
+		cmd "sandbox" "get sandbox info" (InfoSandbox <$> (pathArg $ help "locate sandbox in parent of this path")),
+		cmd "lookup" "lookup for symbol" (Lookup <$> strArgument idm <*> ctx),
+		cmd "whois" "get info for symbol" (Whois <$> strArgument idm <*> ctx),
+		cmd "scope" "get declarations accessible from module or within a project" (
+			subparser (cmd "modules" "get modules accessible from module or within a project" (ResolveScopeModules <$> ctx)) <|>
+			ResolveScope <$> cmdP <*> globalFlag <*> ctx),
+		cmd "complete" "show completions for input" (Complete <$> strArgument idm <*> wideFlag <*> ctx),
+		cmd "hayoo" "find declarations online via Hayoo" (Hayoo <$> strArgument idm <*> hayooPageArg <*> hayooPagesArg),
+		cmd "cabal" "cabal commands" (subparser $ cmd "list" "list cabal packages" (CabalList <$> many (strArgument idm))),
+		cmd "lint" "lint source files or file contents" (Lint <$> many fileArg <*> many cmdP),
+		cmd "check" "check source files or file contents" (Check <$> many fileArg <*> many cmdP <*> ghcOpts),
+		cmd "check-lint" "check and lint source files or file contents" (CheckLint <$> many fileArg <*> many cmdP <*> ghcOpts),
+		cmd "types" "get types for file expressions" (Types <$> many fileArg <*> many cmdP <*> ghcOpts),
+		cmd "ghc-mod" "ghc-mod commands" (GhcMod <$> cmdP),
+		cmd "autofix" "autofix commands" (AutoFix <$> cmdP),
+		cmd "ghc" "ghc commands" (subparser $ cmd "eval" "evaluate expression" (GhcEval <$> many (strArgument idm))),
+		cmd "link" "link to server" (Link <$> holdFlag),
+		cmd "exit" "exit" (pure Exit)]
+
+instance FromCmd GhcModCommand where
+	cmdP = subparser $ mconcat [
+		cmd "lang" "get LANGUAGE pragmas" (pure GhcModLang),
+		cmd "flags" "get OPTIONS_GHC pragmas" (pure GhcModFlags),
+		cmd "type" "infer type with 'ghc-mod type'" (GhcModType <$> (Position <$> argument auto idm <*> argument auto idm) <*> fileArg <*> ghcOpts),
+		cmd "lint" "lint source files" (GhcModLint <$> many (strArgument idm) <*> hlintOpts),
+		cmd "check" "check source files" (GhcModCheck <$> many (strArgument idm) <*> ghcOpts),
+		cmd "check-lint" "check & lint source files" (GhcModCheckLint <$> many (strArgument idm) <*> ghcOpts <*> hlintOpts)]
+
+instance FromCmd AutoFixCommand where
+	cmdP = subparser $ mconcat [
+		cmd "show" "generate corrections for check & lint messages" (AutoFixShow <$> option readJSON (long "data" <> metavar "message" <> help "messages to make fixes for")),
+		cmd "fix" "fix errors and return rest corrections with updated regions" (AutoFixFix <$>
+			option readJSON (long "data" <> metavar "message" <> help "messages to fix") <*>
+			option readJSON (long "rest" <> metavar "correction" <> short 'r' <> help "update corrections") <*>
+			pureFlag)]
+
+instance FromCmd FileContents where
+	cmdP = option readJSON (long "contents")
+
+instance FromCmd TargetFilter where
+	cmdP = asum [TargetProject <$> projectArg, TargetFile <$> fileArg, TargetModule <$> moduleArg, TargetDepsOf <$> depsArg, TargetCabal <$> cabalArg, TargetPackage <$> packageArg, flag' TargetSourced (long "src"), flag' TargetStandalone (long "stand"), pure TargetAny]
+
+instance FromCmd SearchQuery where
+	cmdP = SearchQuery <$> (strArgument idm <|> pure "") <*> (asum [
+		flag' SearchExact (long "exact"),
+		flag' SearchRegex (long "regex"),
+		flag' SearchInfix (long "infix"),
+		flag' SearchSuffix (long "suffix"),
+		pure SearchPrefix <* switch (long "prefix")])
+
+readJSON :: FromJSON a => ReadM a
+readJSON = str >>= maybe (readerError "Can't parse JSON argument") return . decode . L.pack
+
+cabalArg = flag' Cabal (long "cabal") <|> (Sandbox <$> sandboxArg)
+ctx = fileArg
+depsArg = strOption (long "deps" <> metavar "object" <> help "filter to such that in dependency of specified object (file or project)")
+docsFlag = switch (long "docs" <> help "scan source file docs")
+exportsFlag = switch (long "exports" <> short 'e' <> help "resolve module exports")
+fileArg = strOption (long "file" <> metavar "path" <> short 'f')
+ghcOpts = many (strOption (long "ghc" <> metavar "option" <> short 'g' <> help "options to pass to GHC"))
+globalFlag = switch (long "global" <> help "scope of project")
+hayooPageArg = option auto (long "page" <> metavar "n" <> short 'p' <> help "page number (0 by default)" <> value 0)
+hayooPagesArg = option auto (long "pages" <> metavar "count" <> short 'n' <> help "pages count (1 by default)" <> value 1)
+hlintOpts = many (strOption (long "hlint" <> metavar "option" <> short 'h' <> help "options to pass to hlint"))
+holdFlag = switch (long "hold" <> short 'h' <> help "don't return any response")
+inferFlag = switch (long "infer" <> help "infer types")
+-- localsArg = switch (long "locals" <> short 'l' <> help "look in local declarations")
+moduleArg = strOption (long "module" <> metavar "name" <> short 'm' <> help "module name")
+packageArg = strOption (long "package" <> metavar "name" <> help "module package")
+pathArg f = strOption (long "path" <> metavar "path" <> short 'p' <> f)
+projectArg = strOption (long "project" <> long "proj" <> metavar "project")
+pureFlag = switch (long "pure" <> help "don't modify actual file, just return result")
+sandboxArg = strOption (long "sandbox" <> metavar "path" <> help "path to cabal sandbox")
+wideFlag = switch (long "wide" <> short 'w' <> help "wide mode - complete as if there were no import lists")
+
+instance ToJSON Command where
+	toJSON Ping = cmdJson "ping" []
+	toJSON Listen = cmdJson "listen" []
+	toJSON (AddData cts) = cmdJson "add" ["data" .= cts]
+	toJSON (Scan projs cabals fs ps contents ghcs docs' infer') = cmdJson "scan" [
+		"projects" .= projs,
+		"sandboxes" .= cabals,
+		"files" .= fs,
+		"paths" .= ps,
+		"contents" .= contents,
+		"ghc-opts" .= ghcs,
+		"docs" .= docs',
+		"infer" .= infer']
+	toJSON (RefineDocs projs fs ms) = cmdJson "docs" ["projects" .= projs, "files" .= fs, "modules" .= ms]
+	toJSON (InferTypes projs fs ms) = cmdJson "docs" ["projects" .= projs, "files" .= fs, "modules" .= ms]
+	toJSON (Remove projs packages cabals fs) = cmdJson "remove" ["projects" .= projs, "packages" .= packages, "sandboxes" .= cabals, "files" .= fs]
+	toJSON (InfoModules tf) = cmdJson "modules" ["filter" .= tf]
+	toJSON InfoPackages = cmdJson "packages" []
+	toJSON InfoProjects = cmdJson "projects" []
+	toJSON InfoSandboxes = cmdJson "sandboxes" []
+	toJSON (InfoSymbol q tf) = cmdJson "symbol" ["query" .= q, "filter" .= tf]
+	toJSON (InfoModule q tf) = cmdJson "module" ["query" .= q, "filter" .= tf]
+	toJSON (InfoResolve f es) = cmdJson "resolve" ["file" .= f, "exports" .= es]
+	toJSON (InfoProject p) = cmdJson "project" $ either (\pname -> ["name" .= pname]) (\ppath -> ["path" .= ppath]) p
+	toJSON (InfoSandbox p) = cmdJson "sandbox" ["path" .= p]
+	toJSON (Lookup n f) = cmdJson "lookup" ["name" .= n, "file" .= f]
+	toJSON (Whois n f) = cmdJson "whois" ["name" .= n, "file" .= f]
+	toJSON (ResolveScopeModules f) = cmdJson "scope modules" ["file" .= f]
+	toJSON (ResolveScope q g f) = cmdJson "scope" ["query" .= q, "global" .= g, "file" .= f]
+	toJSON (Complete q w f) = cmdJson "complete" ["prefix" .= q, "wide" .= w, "file" .= f]
+	toJSON (Hayoo q p ps) = cmdJson "hayoo" ["query" .= q, "page" .= p, "pages" .= ps]
+	toJSON (CabalList ps) = cmdJson "cabal list" ["packages" .= ps]
+	toJSON (Lint fs cs) = cmdJson "lint" ["files" .= fs, "contents" .= cs]
+	toJSON (Check fs cs ghcs) = cmdJson "check" ["files" .= fs, "contents" .= cs, "ghc-opts" .= ghcs]
+	toJSON (CheckLint fs cs ghcs) = cmdJson "check-lint" ["files" .= fs, "contents" .= cs, "ghc-opts" .= ghcs]
+	toJSON (Types fs cs ghcs) = cmdJson "types" ["files" .= fs, "contents" .= cs, "ghc-opts" .= ghcs]
+	toJSON (GhcMod gcmd) = toJSON gcmd
+	toJSON (AutoFix acmd) = toJSON acmd
+	toJSON (GhcEval exprs) = cmdJson "ghc eval" ["exprs" .= exprs]
+	toJSON (Link h) = cmdJson "link" ["hold" .= h]
+	toJSON Exit = cmdJson "exit" []
+
+instance FromJSON Command where
+	parseJSON = withObject "command" $ \v -> asum [
+		guardCmd "ping" v *> pure Ping,
+		guardCmd "listen" v *> pure Listen,
+		guardCmd "add" v *> (AddData <$> v .:: "data"),
+		guardCmd "scan" v *> (Scan <$>
+			v .:: "projects" <*>
+			v .:: "sandboxes" <*>
+			v .:: "files" <*>
+			v .:: "paths" <*>
+			v .:: "contents" <*>
+			v .:: "ghc-opts" <*>
+			v .:: "docs" <*>
+			v .:: "infer"),
+		guardCmd "docs" v *> (RefineDocs <$> v .:: "projects" <*> v .:: "files" <*> v .:: "modules"),
+		guardCmd "infer" v *> (InferTypes <$> v .:: "projects" <*> v .:: "files" <*> v .:: "modules"),
+		guardCmd "remove" v *> (Remove <$>
+			v .:: "projects" <*>
+			v .:: "packages" <*>
+			v .:: "sandboxes" <*>
+			v .:: "files"),
+		guardCmd "modules" v *> (InfoModules <$> v .:: "filter"),
+		guardCmd "packages" v *> pure InfoPackages,
+		guardCmd "projects" v *> pure InfoProjects,
+		guardCmd "sandboxes" v *> pure InfoSandboxes,
+		guardCmd "symbol" v *> (InfoSymbol <$> v .:: "query" <*> v .:: "filter"),
+		guardCmd "module" v *> (InfoModule <$> v .:: "query" <*> v .:: "filter"),
+		guardCmd "resolve" v *> (InfoResolve <$> v .:: "file" <*> v .:: "exports"),
+		guardCmd "project" v *> (InfoProject <$> asum [Left <$> v .:: "name", Right <$> v .:: "path"]),
+		guardCmd "sandbox" v *> (InfoSandbox <$> v .:: "path"),
+		guardCmd "lookup" v *> (Lookup <$> v .:: "name" <*> v .:: "file"),
+		guardCmd "whois" v *> (Whois <$> v .:: "name" <*> v .:: "file"),
+		guardCmd "scope modules" v *> (ResolveScopeModules <$> v .:: "file"),
+		guardCmd "scope" v *> (ResolveScope <$> v .:: "query" <*> v .:: "global" <*> v .:: "file"),
+		guardCmd "complete" v *> (Complete <$> v .:: "prefix" <*> v .:: "wide" <*> v .:: "file"),
+		guardCmd "hayoo" v *> (Hayoo <$> v .:: "query" <*> v .:: "page" <*> v .:: "pages"),
+		guardCmd "cabal list" v *> (CabalList <$> v .:: "packages"),
+		guardCmd "lint" v *> (Lint <$> v .:: "files" <*> v .:: "contents"),
+		guardCmd "check" v *> (Check <$> v .:: "files" <*> v .:: "contents" <*> v .:: "ghc-opts"),
+		guardCmd "check-lint" v *> (CheckLint <$> v .:: "files" <*> v .:: "contents" <*> v .:: "ghc-opts"),
+		guardCmd "types" v *> (Types <$> v .:: "files" <*> v .:: "contents" <*> v .:: "ghc-opts"),
+		GhcMod <$> parseJSON (Object v),
+		AutoFix <$> parseJSON (Object v),
+		guardCmd "ghc eval" v *> (GhcEval <$> v .:: "exprs"),
+		guardCmd "link" v *> (Link <$> v .:: "hold"),
+		guardCmd "exit" v *> pure Exit]
+
+instance ToJSON AddedContents where
+	toJSON (AddedDatabase db) = object ["database" .= db]
+	toJSON (AddedModule im) = object ["module" .= im]
+	toJSON (AddedProject p) = object ["project" .= p]
+
+instance FromJSON AddedContents where
+	parseJSON = withObject "added-contents" $ \v -> asum [
+		AddedDatabase <$> v .:: "database",
+		AddedModule <$> v .:: "module",
+		AddedProject <$> v .:: "project"]
+
+instance ToJSON GhcModCommand where
+	toJSON GhcModLang = cmdJson "ghc-mod lang" []
+	toJSON GhcModFlags = cmdJson "ghc-mod flags" []
+	toJSON (GhcModType pos f ghcs) = cmdJson "ghc-mod type" ["position" .= pos, "file" .= f, "ghc-opts" .= ghcs]
+	toJSON (GhcModLint fs lints) = cmdJson "ghc-mod lint" ["files" .= fs, "hlint-opts" .= lints]
+	toJSON (GhcModCheck fs ghcs) = cmdJson "ghc-mod check" ["files" .= fs, "ghc-opts" .= ghcs]
+	toJSON (GhcModCheckLint fs ghcs lints) = cmdJson "ghc-mod check-lint" ["files" .= fs, "ghc-opts" .= ghcs, "hlint-opts" .= lints]
+
+instance FromJSON GhcModCommand where
+	parseJSON = withObject "ghc-mod-command" $ \v -> asum [
+		guardCmd "ghc-mod lang" v *> pure GhcModLang,
+		guardCmd "ghc-mod flags" v *> pure GhcModFlags,
+		guardCmd "ghc-mod type" v *> (GhcModType <$> v .:: "position" <*> v .:: "file" <*> v .:: "ghc-opts"),
+		guardCmd "ghc-mod lint" v *> (GhcModLint <$> v .:: "files" <*> v .:: "hlint-opts"),
+		guardCmd "ghc-mod check" v *> (GhcModCheck <$> v .:: "files" <*> v .:: "ghc-opts"),
+		guardCmd "ghc-mod check-lint" v *> (GhcModCheckLint <$> v .:: "files" <*> v .:: "ghc-opts" <*> v .:: "hlint-opts")]
+
+instance ToJSON AutoFixCommand where
+	toJSON (AutoFixShow ns) = cmdJson "autofix show" ["messages" .= ns]
+	toJSON (AutoFixFix ns rests pure') = cmdJson "autofix fix" ["messages" .= ns, "rest" .= rests, "pure" .= pure']
+
+instance FromJSON AutoFixCommand where
+	parseJSON = withObject "auto-fix-command" $ \v -> asum [
+		guardCmd "autofix show" v *> (AutoFixShow <$> v .:: "messages"),
+		guardCmd "autofix fix" v *> (AutoFixFix <$> v .:: "messages" <*> v .:: "rest" <*> v .:: "pure")]
+
+instance ToJSON FileContents where
+	toJSON (FileContents fpath cts) = object ["file" .= fpath, "contents" .= cts]
+
+instance FromJSON FileContents where
+	parseJSON = withObject "file-contents" $ \v -> FileContents <$> v .:: "file" <*> v .:: "contents"
+
+instance ToJSON TargetFilter where
+	toJSON (TargetProject pname) = object ["project" .= pname]
+	toJSON (TargetFile fpath) = object ["file" .= fpath]
+	toJSON (TargetModule mname) = object ["module" .= mname]
+	toJSON (TargetDepsOf dep) = object ["deps" .= dep]
+	toJSON (TargetCabal cabal) = object ["cabal" .= cabal]
+	toJSON (TargetPackage pname) = object ["package" .= pname]
+	toJSON TargetSourced = toJSON ("sourced" :: String)
+	toJSON TargetStandalone = toJSON ("standalone" :: String)
+	toJSON TargetAny = toJSON ()
+
+instance FromJSON TargetFilter where
+	parseJSON j = obj j <|> str' <|> any' where
+		obj = withObject "target-filter" $ \v -> asum [
+			TargetProject <$> v .:: "project",
+			TargetFile <$> v .:: "file",
+			TargetModule <$> v .:: "module",
+			TargetDepsOf <$> v .:: "deps",
+			TargetCabal <$> v .:: "cabal",
+			TargetPackage <$> v .:: "package"]
+		str' = do
+			s <- parseJSON j :: A.Parser String
+			case s of
+				"sourced" -> return TargetSourced
+				"standalone" -> return TargetStandalone
+				_ -> empty
+		any' = (\() -> TargetAny) <$> parseJSON j
+
+instance ToJSON SearchQuery where
+	toJSON (SearchQuery q st) = object ["input" .= q, "type" .= st]
+
+instance FromJSON SearchQuery where
+	parseJSON = withObject "search-query" $ \v -> SearchQuery <$> v .:: "input" <*> v .:: "type"
+
+instance ToJSON SearchType where
+	toJSON SearchExact = toJSON ("exact" :: String)
+	toJSON SearchPrefix = toJSON ("prefix" :: String)
+	toJSON SearchInfix = toJSON ("infix" :: String)
+	toJSON SearchSuffix = toJSON ("suffix" :: String)
+	toJSON SearchRegex = toJSON ("regex" :: String)
+
+instance FromJSON SearchType where
+	parseJSON v = do
+		str' <- parseJSON v :: A.Parser String
+		case str' of
+			"exact" -> return SearchExact
+			"prefix" -> return SearchPrefix
+			"infix" -> return SearchInfix
+			"suffix" -> return SearchInfix
+			"regex" -> return SearchRegex
+			_ -> empty
src/HsDev/Symbols.hs view
@@ -19,7 +19,6 @@ 	importQualifier,
 
 	-- * Utility
-	Canonicalize(..),
 	locateProject, searchProject,
 	locateSourceDir,
 	moduleOpts,
@@ -50,6 +49,8 @@ import System.Directory
 import System.FilePath
 
+import System.Directory.Paths
+
 import HsDev.Symbols.Types
 import HsDev.Symbols.Class
 import HsDev.Symbols.Documented (Documented(..))
@@ -165,24 +166,17 @@ 		merge' [] = error "mergeExported: impossible"
 		merge' ds@(d:_) = ExportedDeclaration (map (view declarationModuleId) ds) (view moduleDeclaration d)
 
--- | Canonicalize all paths within something
-class Canonicalize a where
-	canonicalize :: a -> IO a
-
-instance Canonicalize FilePath where
-	canonicalize = canonicalizePath
-
-instance Canonicalize Cabal where
-	canonicalize Cabal = return Cabal
-	canonicalize (Sandbox p) = fmap Sandbox $ canonicalizePath p
+instance Paths Cabal where
+	paths _ Cabal = pure Cabal
+	paths f (Sandbox p) = Sandbox <$> f p
 
-instance Canonicalize Project where
-	canonicalize (Project nm p c desc) = liftM3 (Project nm) (canonicalizePath p) (canonicalizePath c) (return desc)
+instance Paths Project where
+	paths f (Project nm p c desc) = Project nm <$> f p <*> f c <*> pure 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 (ModuleSource m) = return $ ModuleSource m
+instance Paths ModuleLocation where
+	paths f (FileModule fpath p) = FileModule <$> f fpath <*> traverse (paths f) p
+	paths f (CabalModule c p n) = CabalModule <$> paths f c <*> pure p <*> pure n
+	paths _ (ModuleSource m) = pure $ ModuleSource m
 
 -- | Find project file is related to
 locateProject :: FilePath -> IO (Maybe Project)
src/HsDev/Symbols/Location.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
 
 module HsDev.Symbols.Location (
-	ModulePackage(..), ModuleLocation(..), moduleStandalone, noLocation,
+	ModulePackage(..), ModuleLocation(..), moduleStandalone, locationId, noLocation,
 	Position(..), Region(..), region, regionAt, regionLines, regionStr,
 	Location(..),
 
@@ -82,6 +82,11 @@ 
 moduleStandalone :: ModuleLocation -> Bool
 moduleStandalone = (== Just Nothing) . preview moduleProject
+
+locationId :: ModuleLocation -> String
+locationId (FileModule fpath _) = fpath
+locationId (CabalModule cabal mpack nm) = intercalate ":" [show cabal, maybe "" show mpack, nm]
+locationId (ModuleSource msrc) = fromMaybe "" msrc
 
 instance NFData ModuleLocation where
 	rnf (FileModule f p) = rnf f `seq` rnf p
src/HsDev/Symbols/Util.hs view
@@ -174,8 +174,7 @@ -- | Remove duplicate modules, leave only `preferredModule`
 uniqueModules :: Cabal -> Maybe Project -> [ModuleId] -> [ModuleId]
 uniqueModules cabal proj =
-	catMaybes .
-	map (preferredModule cabal proj) .
+	mapMaybe (preferredModule cabal proj) .
 	groupBy ((==) `on` view moduleIdName) .
 	sortBy (comparing (view moduleIdName))
src/HsDev/Tools/AutoFix.hs view
@@ -1,33 +1,35 @@ {-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Tools.AutoFix (
 	Correction(..), correctionMessage, corrector,
 	correct, corrections,
-	autoFix_, autoFix, updateRange,
+	autoFix,
 	CorrectorMatch,
 	correctors,
 	match,
 	findCorrector,
 
-	module Data.Mark,
+	module Data.Text.Region,
 	module HsDev.Tools.Types
 	) where
 
 import Control.Applicative
-import Control.Lens (makeLenses, set, view)
+import Control.Lens (makeLenses, set, view, (^.), over)
 import Data.Aeson
 import Data.Maybe (listToMaybe, mapMaybe)
+import Data.Text.Region hiding (Region(..))
+import qualified Data.Text.Region as R
 
-import Data.Mark hiding (at, length)
-import HsDev.Symbols.Location
+import HsDev.Symbols.Location (Position(..), Region(..))
 import HsDev.Tools.Base
 import HsDev.Tools.Types
 import HsDev.Util ((.::))
 
 data Correction = Correction {
 	_correctionMessage :: String,
-	_corrector :: Replace String () }
-		deriving (Eq, Read, Show)
+	_corrector :: Replace String }
+		deriving (Eq, Show)
 
 instance ToJSON Correction where
 	toJSON (Correction msg cor) = object [
@@ -39,10 +41,16 @@ 		v .:: "message" <*>
 		v .:: "corrector"
 
+instance ApplyMap Correction where
+	applyMap m (Correction msg c) = Correction msg (applyMap m c)
+
+instance ApplyMap a => ApplyMap (Note a) where
+	applyMap m = over note (applyMap m)
+
 makeLenses ''Correction
 
-correct :: Correction -> EditM String ()
-correct c = run [_corrector c]
+correct :: Correction -> Edit String
+correct c = Chain [_corrector c]
 
 corrections :: [Note OutputMessage] -> [Note Correction]
 corrections = mapMaybe toCorrection where
@@ -56,21 +64,12 @@ 				note
 				(Correction
 					(view (note . message) n)
-					(replace (fromRegion $ view noteRegion n) sugg))
+					(replace (fromRegion $ view noteRegion n) (by sugg)))
 				n
 
 -- | Apply corrections
-autoFix_ :: [Correction] -> EditM String ()
-autoFix_ = mapM_ correct
-
--- | Apply corrections and update rest correction positions
-autoFix :: [Correction] -> [Correction] -> EditM String [Correction]
-autoFix fix' up' = autoFix_ fix' >> mapM updateRange up'
-
-updateRange :: Correction -> EditM String Correction
-updateRange corr = do
-	region' <- mapRange $ replaceRange (_corrector corr)
-	return $ corr { _corrector = (_corrector corr) { replaceRange = region' } }
+autoFix :: ApplyMap r => [Correction] -> EditM String r ()
+autoFix = run . mconcat . map correct
 
 type CorrectorMatch = Note OutputMessage -> Maybe (Note Correction)
 
@@ -78,16 +77,15 @@ correctors = [
 	match "^The (?:qualified )?import of `([\\w\\.]+)' is redundant" $ \_ rgn -> Correction
 		"Redundant import"
-		(replace
-			(expandLines rgn)
-			""),
+		(cut
+			(expandLines rgn)),
 	match "^(.*?)\nFound:\n  (.*?)\nWhy not:\n  (.*?)$" $ \g rgn -> Correction
 		(g `at` 1)
 		(replace
-			(rangeFrom rgn `rangeSize` stringSize (length $ g `at` 2))
-			(g `at` 3))]
+			((rgn ^. regionFrom) `regionSize` pt 0 (length $ g `at` 2))
+			(by $ g `at` 3))]
 
-match :: String -> ((Int -> Maybe String) -> Range -> Correction) -> CorrectorMatch
+match :: String -> ((Int -> Maybe String) -> R.Region -> Correction) -> CorrectorMatch
 match pat f n = do
 	g <- matchRx pat (view (note . message) n)
 	return $ set note (f g (fromRegion $ view noteRegion n)) n
@@ -95,8 +93,8 @@ findCorrector :: Note OutputMessage -> Maybe (Note Correction)
 findCorrector n = listToMaybe $ mapMaybe ($ n) correctors
 
-fromRegion :: Region -> Range
+fromRegion :: Region -> R.Region
 fromRegion (Region f t) = fromPosition f `till` fromPosition t
 
 fromPosition :: Position -> Point
-fromPosition (Position l c) = point (pred l) (pred c)
+fromPosition (Position l c) = pt (pred l) (pred c)
src/HsDev/Tools/Cabal.hs view
@@ -43,7 +43,7 @@ 		(v .:: "name") <*>
 		(v .:: "synopsis") <*>
 		((join . fmap simpleParse) <$> (v .:: "default-version")) <*>
-		((mapMaybe simpleParse) <$> (v .:: "installed-versions")) <*>
+		(mapMaybe simpleParse <$> (v .:: "installed-versions")) <*>
 		(v .:: "homepage") <*>
 		((join . fmap simpleParse) <$> (v .:: "license"))
src/HsDev/Tools/Ghc/Check.hs view
@@ -14,22 +14,18 @@ import Control.Lens (preview, view, each, _Just, (^..))
 import Control.Monad.Except
 import Control.Concurrent.FiniteChan
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Version (showVersion)
-import Data.Time.Clock (getCurrentTime)
+import Data.Maybe (fromMaybe)
 import HsDev.Tools.Ghc.Worker
 import System.FilePath (makeRelative)
 import System.Directory (doesDirectoryExist)
-import Text.Read (readMaybe)
 
 import GHC hiding (Warning, Module, moduleName)
 import Outputable
-import qualified Packages as GHC
-import StringBuffer (stringToStringBuffer)
 import FastString (unpackFS)
 import qualified ErrUtils as E
 
-import HsDev.Symbols (Canonicalize(..), moduleOpts)
+import System.Directory.Paths
+import HsDev.Symbols (moduleOpts)
 import HsDev.Symbols.Location
 import HsDev.Symbols.Types
 import HsDev.Tools.Base
@@ -66,7 +62,6 @@ 				cabalOpt cabal,
 				moduleOpts pkgs m,
 				opts]
-			tm <- liftIO getCurrentTime
 			clearTargets
 			target <- makeTarget (makeRelative dir file) msrc
 			loadTargets [target]
src/HsDev/Tools/Ghc/Types.hs view
@@ -25,6 +25,7 @@ import PprTyThing
 import Pretty
 
+import System.Directory.Paths (canonicalize)
 import HsDev.Symbols
 import HsDev.Tools.Ghc.Worker
 import HsDev.Tools.Types
src/HsDev/Tools/Ghc/Worker.hs view
@@ -108,7 +108,7 @@ 
 -- | Get list of installed packages
 listPackages :: Ghc [ModulePackage]
-listPackages = getSessionDynFlags >>= return . mapMaybe readPackage . fromMaybe [] . pkgDatabase
+listPackages = liftM (mapMaybe readPackage . fromMaybe [] . pkgDatabase) getSessionDynFlags
 
 readPackage :: PackageConfig -> Maybe ModulePackage
 readPackage pc = readMaybe $ packageNameString pc ++ "-" ++ showVersion (packageVersion pc)
src/HsDev/Tools/GhcMod.hs view
@@ -48,9 +48,10 @@ import System.FilePath (normalise)
 import Text.Read (readMaybe)
 
-import Language.Haskell.GhcMod (GhcModT, runGhcModT, withOptions)
+import Language.Haskell.GhcMod (GhcModT, withOptions)
 import qualified Language.Haskell.GhcMod as GhcMod
-import qualified Language.Haskell.GhcMod.Internal as GhcMod
+import qualified Language.Haskell.GhcMod.Monad as GhcMod
+import qualified Language.Haskell.GhcMod.Types as GhcMod
 
 import Control.Concurrent.Worker
 import HsDev.Cabal
@@ -58,10 +59,10 @@ import HsDev.Symbols
 import HsDev.Tools.Base
 import HsDev.Tools.Types
-import HsDev.Util ((.::), liftIOErrors, liftThrow, withCurrentDirectory, readFileUtf8, ordNub)
+import HsDev.Util ((.::), liftIOErrors, liftThrow, readFileUtf8, ordNub)
 
 list :: [String] -> Cabal -> ExceptT String IO [ModuleLocation]
-list opts cabal = runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = opts }) $ do
+list opts cabal = runGhcMod (GhcMod.defaultOptions { GhcMod.optGhcUserOptions = opts }) $ do
 	ms <- (map splitPackage . lines) <$> GhcMod.modules
 	return [CabalModule cabal (readMaybe p) m | (m, p) <- ms]
 	where
@@ -70,7 +71,7 @@ 
 browse :: [String] -> Cabal -> String -> Maybe ModulePackage -> ExceptT String IO InspectedModule
 browse opts cabal mname mpackage = inspect thisLoc (return $ browseInspection opts) $ runGhcMod
-	(GhcMod.defaultOptions { GhcMod.detailed = True, GhcMod.qualified = True, GhcMod.ghcUserOptions = packageOpt mpackage ++ opts }) $ do
+	(GhcMod.defaultOptions { GhcMod.optDetailed = True, GhcMod.optQualified = True, GhcMod.optGhcUserOptions = packageOpt mpackage ++ opts }) $ do
 		ds <- (mapMaybe parseDecl . lines) <$> GhcMod.browse mpkgname
 		return Module {
 			_moduleName = fromString mname,
@@ -115,7 +116,7 @@ info :: [String] -> Cabal -> FilePath -> String -> GhcModT IO Declaration
 info opts cabal file sname = do
 	fileCts <- liftIO $ readFileUtf8 file
-	rs <- withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $
+	rs <- withOptions (\o -> o { GhcMod.optGhcUserOptions = cabalOpt cabal ++ opts }) $
 		liftM nullToNL $ GhcMod.info file (GhcMod.Expression sname)
 	toDecl fileCts rs
 	where
@@ -173,7 +174,7 @@ 		v .:: "type"
 
 typeOf :: [String] -> Cabal -> FilePath -> Int -> Int -> GhcModT IO [TypedRegion]
-typeOf opts cabal file line col = withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
+typeOf opts cabal file line col = withOptions (\o -> o { GhcMod.optGhcUserOptions = cabalOpt cabal ++ opts }) $ do
 	fileCts <- liftIO $ readFileUtf8 file
 	let
 		Position line' col' = calcTabs fileCts 8 (Position line col)
@@ -218,19 +219,35 @@ check :: [String] -> Cabal -> [FilePath] -> Maybe Project -> GhcModT IO [Note OutputMessage]
 check opts cabal files _ = do
 	cts <- liftIO $ mapM readFileUtf8 files
-	withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
+	withOptions (\o -> o { GhcMod.optGhcUserOptions = cabalOpt cabal ++ opts }) $ do
 		res <- GhcMod.checkSyntax files
 		return $ map (recalcOutputMessageTabs (zip files cts)) $ parseOutputMessages res
 
 lint :: [String] -> FilePath -> GhcModT IO [Note OutputMessage]
 lint opts file = do
 	cts <- liftIO $ readFileUtf8 file
-	withOptions (\o -> o { GhcMod.hlintOpts = opts }) $ do
+	withOptions (\o -> o { GhcMod.optHlintOpts = opts }) $ do
 		res <- GhcMod.lint file
 		return $ map (recalcOutputMessageTabs [(file, cts)]) $ parseOutputMessages res
 
+gmOut :: IO GhcMod.GhcModOut
+gmOut = do
+	ch <- newChan
+	return GhcMod.GhcModOut {
+		GhcMod.gmoOptions = GhcMod.OutputOpts {
+			GhcMod.ooptLogLevel = GhcMod.GmSilent,
+			GhcMod.ooptStyle = GhcMod.PlainStyle,
+			GhcMod.ooptLineSeparator = GhcMod.LineSeparator "\0",
+			GhcMod.ooptLinePrefix = Nothing },
+		GhcMod.gmoChan = ch }
+
 runGhcMod :: (GhcMod.IOish m, MonadCatch m) => GhcMod.Options -> GhcModT m a -> ExceptT String m a
-runGhcMod opts act = liftIOErrors $ ExceptT $ liftM (left show . fst) $ runGhcModT opts act
+runGhcMod opts act = do
+	out <- liftIO gmOut
+	cur <- liftIO getCurrentDirectory
+	liftIOErrors $ ExceptT $ liftM (left show . right fst . fst) $ flip runReaderT out $ GhcMod.unGmOutT $
+		GhcMod.withGhcModEnv cur opts $ \env ->
+			GhcMod.runGhcModT' env GhcMod.defaultGhcModState act
 
 locateGhcModEnv :: FilePath -> IO (Either Project Cabal)
 locateGhcModEnv f = do
@@ -246,14 +263,13 @@ 	home <- getHomeDirectory
 	startWorker (runGhcModT'' $ ghcModEnvPath home p) id liftThrow
 	where
-		-- TODO: Uncomment comment below after ghc-mod exports neccessary functions
-		functionNotExported = False
 		runGhcModT'' :: FilePath -> GhcModT IO () -> IO ()
-		runGhcModT'' cur act
-			| functionNotExported = withCurrentDirectory cur $
-				void $ runGhcModT GhcMod.defaultOptions $ act `catchError` (void . return)
-			| otherwise = do
-				void $ GhcMod.runGhcModT' cur GhcMod.defaultOptions $ act `catchError` (void . return)
+		runGhcModT'' cur act = void $ do
+			out <- gmOut
+			flip runReaderT out $
+				GhcMod.unGmOutT $
+				GhcMod.withGhcModEnv cur GhcMod.defaultOptions $ \env ->
+					GhcMod.runGhcModT' env GhcMod.defaultGhcModState (act `catchError` (void . return))
 
 type WorkerMap = MVar (M.Map FilePath (Worker (GhcModT IO)))
 
@@ -261,13 +277,19 @@ ghcModMultiWorker :: IO (Worker (ReaderT WorkerMap IO))
 ghcModMultiWorker = newMVar M.empty >>= \m -> startWorker (`runReaderT` m) id id
 
+instance MonadThrow (GhcMod.GmOutT IO) where
+	throwM = lift . throwM
+
+instance MonadCatch (GhcMod.GmOutT IO) where
+	catch = gcatch
+
 instance MonadThrow (GhcModT IO) where
 	throwM = lift . throwM
 
 instance MonadCatch (GhcModT IO) where
 	catch = gcatch
 
-dispatch :: FilePath -> GhcModT IO a -> ReaderT WorkerMap IO (Task a)
+dispatch :: FilePath -> GhcModT IO a -> ReaderT WorkerMap IO (Async a)
 dispatch file act = do
 	mvar <- ask
 	home <- liftIO getHomeDirectory
@@ -282,8 +304,8 @@ waitMultiGhcMod :: Worker (ReaderT WorkerMap IO) -> FilePath -> GhcModT IO a -> ExceptT String IO a
 waitMultiGhcMod w f =
 	liftIO . pushTask w . dispatch f >=>
-	asExceptT . taskWait >=>
-	asExceptT . taskWait
+	asExceptT . waitCatch >=>
+	asExceptT . waitCatch
 	where
 		asExceptT :: Monad m => m (Either SomeException a) -> ExceptT String m a
 		asExceptT = ExceptT . liftM (left (\(SomeException e) -> show e))
src/HsDev/Tools/HLint.hs view
@@ -15,7 +15,7 @@ import Language.Haskell.Exts.SrcLoc
 import qualified Language.Haskell.HLint3 as HL (Severity(..))
 
-import HsDev.Symbols (Canonicalize(..))
+import System.Directory.Paths (canonicalize)
 import HsDev.Symbols.Location
 import HsDev.Tools.Base
 import HsDev.Util (readFileUtf8, split)
src/HsDev/Tools/Hayoo.hs view
@@ -64,7 +64,7 @@ 		[] -> hayooName f
 		(m:_) -> m ++ "." ++ hayooName f
 	symbolDocs = Just . fromString . hayooDescription
-	symbolLocation r = Location (ModuleSource $ Just $ resultUri r) Nothing where
+	symbolLocation r = Location (ModuleSource $ Just $ resultUri r) Nothing
 
 instance Documented HayooSymbol where
 	brief f
src/HsDev/Tools/Types.hs view
@@ -11,7 +11,8 @@ import Control.Monad
 import Data.Aeson hiding (Error)
 
-import HsDev.Symbols (Canonicalize(..))
+import System.Directory.Paths
+import HsDev.Symbols ()
 import HsDev.Symbols.Location
 import HsDev.Util ((.::), (.::?))
 
@@ -43,6 +44,7 @@ 	_noteRegion :: Region,
 	_noteLevel :: Maybe Severity,
 	_note :: a }
+		deriving (Eq, Show)
 
 makeLenses ''Note
 
@@ -70,13 +72,14 @@ 	recalcTabs cts n' (Note s r l n) = Note s (recalcTabs cts n' r) l n
 	calcTabs cts n' (Note s r l n) = Note s (calcTabs cts n' r) l n
 
-instance Canonicalize (Note a) where
-	canonicalize (Note s r l n) = Note <$> canonicalize s <*> pure r <*> pure l <*> pure n
+instance Paths (Note a) where
+	paths f (Note s r l n) = Note <$> paths f s <*> pure r <*> pure l <*> pure n
 
 -- | Output message from some tool (ghc, ghc-mod, hlint) with optional suggestion
 data OutputMessage = OutputMessage {
 	_message :: String,
 	_messageSuggestion :: Maybe String }
+		deriving (Eq, Ord, Read, Show)
 
 instance NFData OutputMessage where
 	rnf (OutputMessage m s) = rnf m `seq` rnf s
src/HsDev/Util.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
 
 module HsDev.Util (
 	withCurrentDirectory,
@@ -10,9 +10,9 @@ 	-- * String utils
 	tab, tabs, trim, split,
 	-- * Other utils
-	ordNub,
+	ordNub, uniqueBy, mapBy,
 	-- * Helper
-	(.::), (.::?), objectUnion,
+	(.::), (.::?), objectUnion, jsonUnion,
 	-- * Exceptions
 	liftException, liftE, liftEIO, tries, triesMap, liftExceptionM, liftIOErrors,
 	eitherT,
@@ -20,24 +20,29 @@ 	-- * UTF-8
 	fromUtf8, toUtf8, readFileUtf8, writeFileUtf8,
 	-- * IO
-	hGetLineBS, logException, logIO, ignoreIO,
-	-- * Task
-	liftTask,
+	hGetLineBS, logException, logIO, ignoreIO, logAsync,
+	-- * Async
+	liftAsync,
+	-- * Command line
+	FromCmd(..),
+	cmdJson, withCmd, guardCmd,
+	withHelp, cmd, parseArgs,
 
 	-- * Reexportss
 	module Control.Monad.Except,
 	MonadIO(..)
 	) where
 
-import Control.Arrow (second, left)
+import Control.Arrow (second, left, (&&&))
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
 import qualified Control.Monad.Catch as C
-import Data.Aeson
-import Data.Aeson.Types (Parser)
+import Data.Aeson hiding (Result(..), Error)
+import qualified Data.Aeson.Types as A
 import Data.Char (isSpace)
 import Data.List (isPrefixOf, unfoldr)
+import qualified Data.Map as M
 import Data.Maybe (catMaybes)
 import qualified Data.Set as Set
 import qualified Data.HashMap.Strict as HM (HashMap, toList, union)
@@ -47,11 +52,12 @@ import Data.Text (Text)
 import qualified Data.Text.Lazy as T
 import qualified Data.Text.Lazy.Encoding as T
+import Options.Applicative
 import System.Directory
 import System.FilePath
 import System.IO
 
-import Control.Concurrent.Task
+import Control.Concurrent.Async
 
 -- | Run action with current directory set
 withCurrentDirectory :: FilePath -> IO a -> IO a
@@ -123,19 +129,25 @@ split :: (a -> Bool) -> [a] -> [[a]]
 split p = takeWhile (not . null) . unfoldr (Just . second (drop 1) . break p)
 
--- | ordNub is quadratic, https://github.com/nh2/haskell-ordnub/#ordnub
+-- | nub is quadratic, https://github.com/nh2/haskell-ordnub/#ordnub
 ordNub :: Ord a => [a] -> [a]
-ordNub l = go Set.empty l where
+ordNub = go Set.empty where
 	go _ [] = []
 	go s (x:xs)
 		| x `Set.member` s = go s xs
 		| otherwise = x : go (Set.insert x s) xs
 
+uniqueBy :: Ord b => (a -> b) -> [a] -> [a]
+uniqueBy f = M.elems . mapBy f
+
+mapBy :: Ord b => (a -> b) -> [a] -> M.Map b a
+mapBy f = M.fromList . map (f &&& id)
+
 -- | 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
+(.::) :: FromJSON a => HM.HashMap Text Value -> Text -> A.Parser a
 v .:: name = maybe (fail $ "key " ++ show name ++ " not present") parseJSON $ lookup name $ HM.toList v
 
-(.::?) :: FromJSON a => HM.HashMap Text Value -> Text -> Parser (Maybe a)
+(.::?) :: FromJSON a => HM.HashMap Text Value -> Text -> A.Parser (Maybe a)
 v .::? name = traverse parseJSON $ lookup name $ HM.toList v
 
 -- | Union two JSON objects
@@ -145,9 +157,13 @@ objectUnion _ (Object r) = Object r
 objectUnion _ _ = Null
 
+-- | Union two JSON objects
+jsonUnion :: (ToJSON a, ToJSON b) => a -> b -> Value
+jsonUnion x y = objectUnion (toJSON x) (toJSON y)
+
 -- | Lift IO exception to ExceptT
 liftException :: C.MonadCatch m => m a -> ExceptT String m a
-liftException = ExceptT . liftM (left $ \(SomeException e) -> show e) . C.try
+liftException = ExceptT . liftM (left $ \(SomeException e) -> displayException e) . C.try
 
 -- | Same as @liftException@
 liftE :: C.MonadCatch m => m a -> ExceptT String m a
@@ -167,7 +183,7 @@ -- | Lift IO exception to MonadError
 liftExceptionM :: (C.MonadCatch m, MonadError String m) => m a -> m a
 liftExceptionM act = C.catch act onError where
-	onError = throwError . (\(SomeException e) -> show e)
+	onError = throwError . (\(SomeException e) -> displayException e)
 
 -- | Lift IO exceptions to ExceptT
 liftIOErrors :: C.MonadCatch m => ExceptT String m a -> ExceptT String m a
@@ -204,15 +220,51 @@ logException :: String -> (String -> IO ()) -> IO () -> IO ()
 logException pre out = handle onErr where
 	onErr :: SomeException -> IO ()
-	onErr e = out $ pre ++ show e
+	onErr e = out $ pre ++ displayException e
 
 logIO :: String -> (String -> IO ()) -> IO () -> IO ()
 logIO pre out = handle onIO where
 	onIO :: IOException -> IO ()
-	onIO e = out $ pre ++ show e
+	onIO e = out $ pre ++ displayException e
 
+logAsync :: (String -> IO ()) -> IO () -> IO ()
+logAsync out = handle onAsync where
+	onAsync :: AsyncException -> IO ()
+	onAsync e = out (displayException e) >> throwIO e
+
 ignoreIO :: IO () -> IO ()
 ignoreIO = handle (const (return ()) :: IOException -> IO ())
 
-liftTask :: (C.MonadThrow m, C.MonadCatch m, MonadIO m) => IO (Task a) -> ExceptT String m a
-liftTask = liftExceptionM . ExceptT . liftIO . liftM (left show) . join . liftM taskWait
+liftAsync :: (C.MonadThrow m, C.MonadCatch m, MonadIO m) => IO (Async a) -> ExceptT String m a
+liftAsync = liftExceptionM . ExceptT . liftIO . liftM (left displayException) . join . liftM waitCatch
+
+class FromCmd a where
+	cmdP :: Parser a
+
+cmdJson :: String -> [A.Pair] -> Value
+cmdJson nm ps = object $ ("command" .= nm) : ps
+
+withCmd :: String -> (Object -> A.Parser a) -> Value -> A.Parser a
+withCmd nm fn = withObject ("command " ++ nm) $ \v -> guardCmd nm v *> fn v
+
+guardCmd :: String -> Object -> A.Parser ()
+guardCmd nm obj = do
+	cmdName <- obj .:: "command"
+	guard (nm == cmdName)
+
+-- | Add help command to parser
+withHelp :: Parser a -> Parser a
+withHelp = (helper' <*>) where
+	helper' = abortOption ShowHelpText $ long "help" <> short '?' <> help "show help" <> hidden
+
+-- | Subcommand
+cmd :: String -> String -> Parser a -> Mod CommandFields a
+cmd n d p = command n (info (withHelp p) (progDesc d))
+
+-- | Parse arguments or return help
+parseArgs :: String -> ParserInfo a -> [String] -> Either String a
+parseArgs nm p = handle' . execParserPure (prefs mempty) (p { infoParser = withHelp (infoParser p) }) where
+	handle' :: ParserResult a -> Either String a
+	handle' (Success r) = Right r
+	handle' (Failure f) = Left $ fst $ renderFailure f nm
+	handle' _ = Left "error: completion invoked result"
− src/System/Console/Args.hs 
@@ -1,295 +0,0 @@-{-# LANGUAGE FlexibleInstances, TupleSections #-}
-
-module System.Console.Args (
-	Args(..), Opts(..), Arg(..), Opt(..),
-	withOpts, defOpts, defArgs, selectOpts, splitOpts,
-	(%--), (%-?), hoist, has, arg, narg, iarg, listArg, flagSet,
-	flag, req, list, manyReq,
-	desc, alias, short,
-	parse, parse_, tryParse, toArgs, info,
-
-	-- * Helpers
-	splitArgs, unsplitArgs, verify,
-
-	module Data.Help
-	) where
-
-import Control.Arrow
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Loops
-import Data.Aeson
-import Data.Char
-import qualified Data.HashMap.Strict as HM
-import Data.List
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Maybe
-import Data.String (fromString)
-import qualified Data.Text as T
-import Text.Read (readMaybe)
-
-import Data.Help
-import Text.Format
-
-data Args = Args {
-	posArgs :: [String],
-	namedArgs :: Opts String }
-		deriving (Eq, Show)
-
-instance Monoid Args where
-	mempty = Args [] mempty
-	(Args largs lopts) `mappend` (Args rargs ropts) = Args (largs ++ rargs) (lopts `mappend` ropts)
-
-newtype Opts a = Opts { getOpts :: Map String [a] } deriving (Eq, Show)
-
---instance Eq a => Eq (Opts a) where
---	Opts l == Opts r = l == r
-
-instance Functor Opts where
-	fmap f = Opts . fmap (fmap f) . getOpts
-
-instance Foldable Opts where
-	foldMap f = foldMap (foldMap f) . getOpts
-
-instance Traversable Opts where
-	traverse f = fmap Opts . traverse (traverse f) . getOpts
-
-instance Monoid (Opts a) where
-	mempty = Opts mempty
-	(Opts l) `mappend` (Opts r) = Opts $ M.unionWith mappend l r
-
-instance ToJSON a => ToJSON (Opts a) where
-	toJSON (Opts opts) = object $ map toPair $ M.toList opts where
-		toPair (n, []) = fromString n .= Null
-		toPair (n, [v]) = fromString n .= v
-		toPair (n, vs) = fromString n .= vs
-
-instance FromJSON a => FromJSON (Opts a) where
-	parseJSON = withObject "options" $ fmap (Opts . M.fromList) . mapM fromPair . HM.toList where
-		fromPair (n, v) = (T.unpack n,) <$> case v of
-			Null -> return []
-			Number n' -> return <$> parseJSON (toJSON $ show n')
-			_ -> (return <$> parseJSON v) <|> parseJSON v
-
-data Arg = Flag | Required String | List String deriving (Eq, Ord, Show)
-
-argName :: Arg -> Maybe String
-argName Flag = Nothing
-argName (Required n) = Just n
-argName (List n) = Just $ n ++ "..."
-
-data Opt = Opt {
-	optName :: String,
-	optShort :: [Char],
-	optLong :: [String],
-	optDescription :: Maybe String,
-	optArg :: Arg }
-		deriving (Eq, Show)
-
-withOpts :: (Opts String -> Opts String) -> Args -> Args
-withOpts f (Args a o) = Args a (f o)
-
--- | Set default values, if option doesn't present
-defOpts :: Opts String -> Opts String -> Opts String
-defOpts (Opts def) (Opts new) = Opts $ new `M.union` def
-
-defArgs :: Opts String -> Args -> Args
-defArgs = withOpts . defOpts
-
-selectOpts :: [Opt] -> Opts a -> Opts a
-selectOpts opts = Opts . M.filterWithKey (\n _ -> n `elem` optNames) . getOpts where
-	optNames = map optName opts
-
-splitOpts :: [Opt] -> Opts a -> (Opts a, Opts a)
-splitOpts opts = (Opts *** Opts) . M.partitionWithKey (\n _ -> n `elem` optNames) . getOpts where
-	optNames = map optName opts
-
-(%--) :: Format a => String -> a -> Opts String
-n %-- v = Opts $ M.singleton n [format v]
-
-(%-?) :: Format a => String -> Maybe a -> Opts String
-n %-? v = maybe mempty (n %--) v
-
--- | Make 'Opts' with flag set
-hoist :: String -> Opts a
-hoist n = Opts $ M.singleton n []
-
-has :: String -> Opts a -> Bool
-has n = M.member n . getOpts
-
--- | Get argument value
-arg :: String -> Opts a -> Maybe a
-arg n = (M.lookup n . getOpts) >=> listToMaybe
-
--- | Get numeric value
-narg :: (Read a, Num a) => String -> Opts String -> Maybe a
-narg n = join . fmap readMaybe . arg n
-
--- | Get integer value
-iarg :: String -> Opts String -> Maybe Integer
-iarg = narg
-
--- | Get list argument
-listArg :: String -> Opts a -> [a]
-listArg n = fromMaybe [] . M.lookup n . getOpts
-
--- | Is flag set
-flagSet :: String -> Opts a -> Bool
-flagSet n = isJust . M.lookup n . getOpts
-
--- | Flag option
-flag :: String -> Opt
-flag n = Opt n [] [] Nothing Flag
-
--- | Required option
-req :: String -> String -> Opt
-req n v = Opt n [] [] Nothing (Required v)
-
--- | List option
-list :: String -> String -> Opt
-list n v = Opt n [] [] Nothing (List v)
-
--- | Convert req option to list
-manyReq :: Opt -> Opt
-manyReq o@(Opt { optArg = (Required n) }) = o { optArg = List n }
-manyReq _ = error "manyReq: invalid argument"
-
--- | Set description
---
--- >flag "quiet" `desc` "quiet mode"
-desc :: Opt -> String -> Opt
-desc o d = o { optDescription = Just d }
-
--- | Set aliases
---
--- >fliag "quiet" `alias` 
-alias :: Opt -> [String] -> Opt
-alias o ls = o { optLong = optLong o ++ ls }
-
--- | Shortcuts
-short :: Opt -> [Char] -> Opt
-short o ss = o { optShort = optShort o ++ ss }
-
-findOpt :: String -> [Opt] -> Maybe Opt
-findOpt n = find opt' where
-	opt' :: Opt -> Bool
-	opt' (Opt n' s l _ _) = n `elem` (n' : (map return s ++ l))
-
-parse :: [Opt] -> [String] -> Either String Args
-parse os = unfoldrM parseCmd >=> (verify os . mconcat) where
-	parseCmd :: [String] -> Either String (Maybe (Args, [String]))
-	parseCmd [] = Right Nothing
-	parseCmd (cmd:cmds)
-		| isFlag cmd = do
-			opt' <- lookOpt cmd os
-			case optArg opt' of
-				Flag -> Right $ Just (Args [] $ Opts $ M.singleton (optName opt') [], cmds)
-				Required _ -> case cmds of
-					(value:cmds')
-						| not (isFlag value) -> Right $ Just (Args [] $ Opts $ M.singleton (optName opt') [value], cmds')
-						| otherwise -> Left $ "No value specified for option '$'" ~~ optName opt'
-					[] -> Left $ "No value specified for option '" ++ optName opt' ++ "'"
-				List _ -> case cmds of
-					(value:cmds')
-						| not (isFlag value) -> Right $ Just (Args [] $ Opts $ M.singleton (optName opt') [value], cmds')
-						| otherwise -> Left $ "No value specified for option '$'" ~~ optName opt'
-					[] -> Left $ "No value specified for option '$'" ~~ optName opt'
-		| otherwise = Right $ Just (Args [cmd] mempty, cmds)
-
-	lookOpt :: String -> [Opt] -> Either String Opt
-	lookOpt n = maybe (Left $ "Invalid option '$'" ~~ n) Right . findOpt (dropWhile (== '-') n)
-
--- | Parse with no options declarations
-parse_ :: [String] -> Args
-parse_ = mconcat . unfoldr parseCmd where
-	parseCmd :: [String] -> Maybe (Args, [String])
-	parseCmd [] = Nothing
-	parseCmd (cmd:cmds)
-		| isFlag cmd = case cmds of
-			(value:cmds')
-				| not (isFlag value) -> Just (Args [] $ Opts $ M.singleton cmd [value], cmds')
-				| otherwise -> Just (Args [] $ Opts $ M.singleton cmd [], cmds)
-			[] -> Just (Args [] $ Opts $ M.singleton cmd [], [])
-		| otherwise = Just (Args [cmd] mempty, cmds)
-
-tryParse :: [Opt] -> [String] -> Args
-tryParse os s = either (const $ parse_ s) id $ parse os s
-
-toArgs :: Args -> [String]
-toArgs (Args p o) = p ++ (concatMap toArgs' . M.toList . getOpts $ o) where
-	toArgs' :: (String, [String]) -> [String]
-	toArgs' (n, []) = ["--" ++ n]
-	toArgs' (n, vs) = concat [["--" ++ n, v] | v <- vs]
-
-instance Help Opt where
-	brief (Opt n _ _ _ arg') = concat [
-		longOpt n,
-		maybe "" (" " ++) $ argName arg']
-	help (Opt n ss ls desc' arg') = [concat [
-		unwords (map shortOpt ss ++ map longOpt (n : ls)),
-		maybe "" (" " ++) $ argName arg',
-		maybe "" (" -- " ++) desc']]
-
-instance Help [Opt] where
-	brief = unwords . map ((\s -> "[" ++ s ++ "]") . brief)
-	help = concatMap help
-
-info :: [Opt] -> String
-info = unlines . indented
-
-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]
-
-verify :: [Opt] -> Args -> Either String Args
-verify os = withOpts' $ fmap (Opts . M.fromList) . mapM (uncurry verify') . M.toList . getOpts where
-	withOpts' :: Functor f => (Opts String -> f (Opts String)) -> Args -> f Args
-	withOpts' f (Args a o) = Args a <$> f o
-	verify' :: String -> [String] -> Either String (String, [String])
-	verify' n v = case findOpt n os of
-		Nothing -> Left $ "Invalid option '$'" ~~ n
-		Just opt -> maybe (Right (n, v)) Left $ case (optArg opt, v) of
-			(Flag, []) -> Nothing
-			(Flag, _) -> Just $ "Flag '$' has a value" ~~ n
-			(Required _, []) -> Just $ "No value for '$'" ~~ n
-			(Required _, [_]) -> Nothing
-			(Required _, _:_) -> Just $ "Too much values for '$'" ~~ n
-			(List _, []) -> Just $ "No values for '$'" ~~ n
-			(List _, _) -> Nothing
-
-isFlag :: String -> Bool
-isFlag ('-':'-':s) = not $ null s
-isFlag ('-':_:[]) = True
-isFlag _ = False
-
-longOpt :: String -> String
-longOpt = ("--" ++)
-
-shortOpt :: Char -> String
-shortOpt = ('-':) . return
− src/System/Console/Cmd.hs 
@@ -1,168 +0,0 @@-module System.Console.Cmd (
-	CmdAction, notMatch, failMatch, runCmd, defaultOpts, validateArgs, alterArgs,
-	Cmd(..), cmdAct, cutName, cmda, cmda_, cmd, cmd_, defCmd,
-	CmdHelp(..), helpCommand, withHelp, printWith,
-	run, runArgs, runOn,
-
-	module System.Console.Args
-	) where
-
-import Control.Arrow (Arrow((&&&)))
-import Control.Monad ()
-import Data.List (stripPrefix, isPrefixOf)
-import Control.Monad.Except
-import Data.Map ()
-import Data.Maybe
-import qualified Data.Map as M (delete)
-
-import System.Console.Args
-import Text.Format ((~~), (%))
-
-type CmdAction a = ExceptT String Maybe a
-
--- | Arguments doesn't match command
-notMatch :: CmdAction a
-notMatch = lift Nothing
-
--- | Invalid command arguments
-failMatch :: String -> CmdAction a
-failMatch = throwError
-
-data Cmd a = Cmd {
-	cmdName :: String,
-	cmdArgs :: [String],
-	cmdOpts :: [Opt],
-	cmdDesc :: String,
-	cmdGetArgs :: Args -> CmdAction Args,
-	-- ^ Get command arguments from source arguments, by default it cuts command name
-	cmdAction :: Args -> CmdAction a }
-
-instance Functor Cmd where
-	fmap f cmd' = cmd' {
-		cmdAction = fmap f . cmdAction cmd' }
-
--- | Run cmd
-runCmd :: Cmd a -> Args -> CmdAction a
-runCmd c = cmdGetArgs c >=> cmdAction c
-
--- | Set default opts
-defaultOpts :: Opts String -> Cmd a -> Cmd a
-defaultOpts opts = alterArgs (cmdAct $ withOpts $ defOpts opts)
-
--- | Validate Args in command
-validateArgs :: (Args -> CmdAction ()) -> Cmd a -> Cmd a
-validateArgs p c = c {
-	cmdAction = \a -> p a >> cmdAction c a }
-
--- | Alter Args in command
-alterArgs :: (Args -> CmdAction Args) -> Cmd a -> Cmd a
-alterArgs f c = c {
-	cmdGetArgs = f >=> cmdGetArgs c }
-
--- | Make CmdAction function
-cmdAct :: (b -> a) -> b -> CmdAction a
-cmdAct f = return . f
-
--- | Cut name of command from arguments and checks if it matches
---
--- > cutName >=> cmdAct act
-cutName :: String -> Args -> CmdAction Args
-cutName name (Args as os) = case stripPrefix (words name) as of
-	Just as' -> return (Args as' os)
-	Nothing -> notMatch
-
-verifyOpts :: [Opt] -> Args -> CmdAction Args
-verifyOpts os = ExceptT . Just . verify os
-
-cmda :: String -> [String] -> [Opt] -> String -> (Args -> CmdAction a) -> Cmd a
-cmda name as os cdesc act = Cmd {
-	cmdName = name,
-	cmdArgs = as,
-	cmdOpts = os,
-	cmdDesc = cdesc,
-	cmdGetArgs = cut',
-	cmdAction = verifyOpts os >=> act }
-	where
-		cut'
-			| null name = return
-			| otherwise = cutName name
-
-cmda_ :: String -> [Opt] -> String -> (Opts String -> CmdAction a) -> Cmd a
-cmda_ name os cdesc act = validateArgs noPos $ cmda name [] os cdesc (act . namedArgs) where
-	noPos (Args [] _) = return ()
-	noPos (Args _ _) = failMatch "No positional argument expected"
-
-cmd :: String -> [String] -> [Opt] -> String -> (Args -> a) -> Cmd a
-cmd name as os cdesc act = cmda name as os cdesc (cmdAct act)
-
-cmd_ :: String -> [Opt] -> String -> (Opts String -> a) -> Cmd a
-cmd_ name os cdesc act = cmda_ name os cdesc (cmdAct act)
-
--- | Unnamed command
-defCmd :: [String] -> [Opt] -> String -> (Args -> a) -> Cmd a
-defCmd as os cdesc act = cmda "" as os cdesc (cmdAct act)
-
-data CmdHelp =
-	HelpUsage [String] |
-	HelpCommands [(String, [String])]
-		deriving (Eq, Ord, Read, Show)
-
--- | Make help command, which will show help on for specified commands
-helpCommand :: String -> (Either String CmdHelp -> a) -> [Cmd a] -> Cmd a
-helpCommand tool toCmd cmds = helpcmd where
-	helpcmd = fmap toCmd $ alterArgs (cmdAct checkHelp) $ cmd
-		"help"
-		["command"]
-		[flag "help" `short` ['?'] `desc` "show help (when using form 'command -?' or 'command --help')"]
-		("help command, can be called in form '$ [command] -?' or '$ [command] --help" ~~ tool % tool)
-		onHelp
-	checkHelp :: Args -> Args
-	checkHelp a
-		| flagSet "help" (namedArgs a) = a {
-			posArgs = "help" : posArgs a,
-			namedArgs = Opts $ M.delete "help" $ getOpts $ namedArgs a }
-		| otherwise = a
-	onHelp (Args [] _) = Right $ HelpUsage [tool ++ " " ++ brief c | c <- (helpcmd:cmds)]
-	onHelp (Args cmdname _) = case filter ((cmdname `isPrefixOf`) . words . cmdName) (helpcmd:cmds) of
-		[] -> Left $ unlines $ ("Unknown command: " ++ unwords cmdname) : tryOut
-		helps -> Right $ HelpCommands $ map (cmdName &&& (addHeader . indented)) helps
-		where
-			pre = unwords cmdname
-			maybeCmds = filter (pre `isPrefixOf`) $ map cmdName (helpcmd:cmds)
-			tryOut = case maybeCmds of
-				[] -> []
-				_ -> "\tMaybe you mean:" : map ("\t\t" ++) maybeCmds
-	addHeader [] = []
-	addHeader (h:hs) = (tool ++ " " ++ h) : hs
-
--- | Add help command
-withHelp :: String -> (Either String CmdHelp -> a) -> [Cmd a] -> [Cmd a]
-withHelp tool toCmd cmds = helpCommand tool toCmd cmds : cmds
-
-printWith :: (String -> a) -> (Either String CmdHelp -> a)
-printWith fn = fn . either id (unlines . print') where
-	print' :: CmdHelp -> [String]
-	print' (HelpUsage u) = map ('\t':) u
-	print' (HelpCommands cs) = map ('\t':) $ concatMap snd cs
-
-instance Help (Cmd a) where
-	brief c = unwords $ filter (not . null) $ [cmdName c, unwords (map angled (cmdArgs c)), brief (cmdOpts c)] ++ desc' where
-		angled s = "<" ++ s ++ ">"
-		desc'
-			| null (cmdDesc c) = []
-			| otherwise = ["-- " ++ cmdDesc c]
-	help = help . cmdOpts
-
--- | Run commands
-run :: [Cmd a] -> a -> (String -> a) -> [String] -> a
-run cmds onDef onError = runOn cmds onDef onError (tryParse . cmdOpts)
-
--- | Run commands with parsed args
-runArgs :: [Cmd a] -> a -> (String -> a) -> Args -> a
-runArgs cmds onDef onError = runOn cmds onDef onError (const id)
-
--- | Run commands with 
-runOn :: [Cmd a] -> a -> (String -> a) -> (Cmd a -> c -> Args) -> c -> a
-runOn cmds onDef onError f as = maybe onDef (either onError id) found where
-	found = listToMaybe $ mapMaybe (runExceptT . (`act` as)) cmds
-	act c = runCmd c . f c
+ src/System/Directory/Paths.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module System.Directory.Paths (
+	Paths(..),
+	canonicalize
+	) where
+
+import Control.Lens
+import System.Directory
+
+-- | Something with paths inside
+class Paths a where
+	paths :: Traversal' a FilePath
+
+instance Paths FilePath where
+	paths = id
+
+-- | Canonicalize all paths
+canonicalize :: Paths a => a -> IO a
+canonicalize = paths canonicalizePath
src/System/Win32/FileMapping/NamePool.hs view
@@ -24,7 +24,7 @@ 
 -- | Use free name from pool
 withName :: Pool -> (String -> IO a) -> IO a
-withName p act = bracket getName freeName act where
+withName p = bracket getName freeName where
 	getName = modifyMVar (poolFreeNames p) $ \names -> case names of
 		[] -> liftM ((,) []) $ poolNewName p
 		(n:ns) -> return (ns, n)
− src/Text/Format.hs 
@@ -1,98 +0,0 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances, DefaultSignatures #-}
-
--- | Format module
---
--- >"My name is $, I am ${age} years old, I am from $" %~ ("Vasya" % ("age" %= 20) % "Moscow")
--- >"My name is Vasya, I am 20 years old"
-module Text.Format (
-	Format(..), FormatArgs, Hole(..),
-	(%~), (~~), (%), (%=)
-	) where
-
-import Control.Arrow (first)
-import Data.List (delete, isPrefixOf)
-import Data.String
-import Text.Regex.PCRE
-
-class Format a where
-	format :: a -> String
-	default format :: Show a => a -> String
-	format = show
-
-instance Format String where
-	format = id
-instance Format Int where
-	format = show
-instance Format Integer where
-	format = show
-instance Format Bool where
-	format = show
-
-type FormatArgs = [(Maybe String, String)]
-
-class Hole a where
-	hole :: a -> FormatArgs
-
-instance Hole FormatArgs where
-	hole = id
-
-instance {-# OVERLAPPABLE #-} Format a => Hole a where
-	hole v = [(Nothing, format v)]
-
-instance Format a => Hole (String, a) where
-	hole (n, v) = [(Just n, format v)]
-
-instance Hole [(String, String)] where
-	hole = map (first Just)
-
-infixr 1 %~
-
-(%~) :: (Hole a, IsString s) => String -> a -> Either String s
-fmt %~ hargs = fmap fromString $ case fmt =~ "\\$(\\{([a-zA-Z]+)\\})?" of
-	(pre, "", "", []) -> Right pre
-	(pre, _, post, []) -> Right $ pre ++ post
-	(pre, _, post, gs) -> do
-		let
-			name = case gs of
-				_:name':_ -> name'
-				_ -> ""
-		if null name && "$" `isPrefixOf` post
-			then do
-				post' <- tail post %~ hargs
-				return $ pre ++ "$" ++ post'
-			else do
-				(arg', args') <- split' name
-				post' <- post %~ args'
-				return $ pre ++ arg' ++ post'
-	where
-		args = hole hargs
-
-		split' :: String -> Either String (String, FormatArgs)
-		split' n = maybe
-			(Left $ maybe
-				(concat [
-					"Format: not enough arguments for format string '",
-					fmt,
-					"'"])
-				("Format argument '$' not found" ~~) n')
-			(\v -> Right (v, delete (n', v) args))
-			(lookup n' args)
-			where
-				n'
-					| null n = Nothing
-					| otherwise = Just n
-
-infixr 1 ~~
-
-(~~) :: (Hole a, IsString s) => String -> a -> s
-fmt ~~ hargs = either error id $ fmt %~ hargs
-
-infixr 5 %
-
-(%) :: (Hole a, Hole b) => a -> b -> FormatArgs
-x % y = hole x ++ hole y
-
-infixr 1 %=
-
-(%=) :: Format a => String -> a -> (String, String)
-name %= value = (name, format value)
tools/Tool.hs view
@@ -2,80 +2,35 @@ 
 module Tool (
 	-- * Tool
-	ToolM, toolMain, usage,
-	-- * Json command
-	jsonCmd, jsonCmd_,
-	-- * Errors
-	toolError,
-	-- * Options
-	prettyOpt, isPretty, lispOpt, isLisp,
+	ToolM, toolMain, printExceptT, printResult,
 
-	module System.Console.Cmd
+	module Options.Applicative,
+	module HsDev.Util
 	) where
 
-import Control.Monad.Except (runExceptT, throwError)
+import Control.Monad.Except (ExceptT, runExceptT)
+import Control.Monad.IO.Class
+import Control.Monad (liftM)
 import Data.Aeson
-import Data.Aeson.Encode.Pretty (encodePretty)
-import qualified Data.ByteString.Lazy.Char8 as L (ByteString, putStrLn)
+import qualified Data.ByteString.Lazy.Char8 as L (putStrLn)
+import Options.Applicative
 import System.Environment
 import System.IO
 
-import Data.Lisp (encodeLisp)
 import HsDev.Tools.Base (ToolM)
-
-import System.Console.Cmd
+import HsDev.Util (cmd, parseArgs)
 
 -- | Run tool with commands
-toolMain :: String -> [Cmd (IO ())] -> IO ()
-toolMain name commands = do
+toolMain :: String -> String -> Parser a -> (a -> IO ()) -> IO ()
+toolMain name d p act = do
 	hSetBuffering stdout LineBuffering
 	hSetEncoding stdout utf8
 	hSetEncoding stdin utf8
-	getArgs >>= run toolCmds unknownCmd onError
-	where
-		onError :: String -> IO ()
-		onError = putStrLn
-
-		unknownCmd :: IO ()
-		unknownCmd = putStrLn "Unknown command" >> usage name toolCmds
-
-		toolCmds = withHelp name (printWith putStrLn) commands
-
--- | Print usage
-usage :: String -> [Cmd (IO ())] -> IO ()
-usage toolName = mapM_ (putStrLn . ('\t':) . ((toolName ++ " ") ++) . brief)
-
--- | Command with JSONable result
-jsonCmd :: ToJSON a => String -> [String] -> [Opt] -> String -> (Args -> ToolM a) -> Cmd (IO ())
-jsonCmd name pos os descr act = cmd name pos ([prettyOpt, lispOpt] ++ os) descr $ \(Args as opts) -> do
-	r <- runExceptT $ act (Args as opts)
-	L.putStrLn $ either (toStr opts . errorStr) (toStr opts) r
-	where
-		toStr :: ToJSON a => Opts String -> a -> L.ByteString
-		toStr opts
-			| isLisp opts = encodeLisp
-			| 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) -> Cmd (IO ())
-jsonCmd_ name pos descr act = jsonCmd name pos [] descr (act . posArgs)
-
--- | Fail with error
-toolError :: String -> ToolM a
-toolError = throwError
-
-prettyOpt :: Opt
-prettyOpt = flag "pretty" `desc` "pretty JSON output"
-
-isPretty :: Opts String -> Bool
-isPretty = flagSet "pretty"
+	res <- liftM (parseArgs name (info p (progDesc d))) getArgs
+	either putStrLn act res
 
-lispOpt :: Opt
-lispOpt = flag "lisp" `desc` "s-exp output" `short` ['l']
+printExceptT :: ExceptT String IO () -> IO ()
+printExceptT act = runExceptT act >>= either putStrLn return
 
-isLisp :: Opts String -> Bool
-isLisp = flagSet "lisp"
+printResult :: (ToJSON a, MonadIO m) => m a -> m ()
+printResult act = act >>= liftIO . L.putStrLn . encode
tools/hsautofix.hs view
@@ -2,16 +2,18 @@ 	main
 	) where
 
-import Control.Lens (each, view, preview)
+import Control.Lens (view, preview)
 import Control.Arrow ((***))
 import Control.Monad (liftM)
+import Control.Monad.State (gets)
+import Control.Monad.Except (throwError)
 import Data.Aeson
 import Data.List (partition, sort)
 import Data.Maybe (mapMaybe)
 import System.Directory (canonicalizePath)
-import Text.Read (readMaybe)
 
-import HsDev.Symbols (Canonicalize(..), moduleFile)
+import System.Directory.Paths (canonicalize)
+import HsDev.Symbols (moduleFile)
 import HsDev.Tools.Base
 import HsDev.Tools.AutoFix
 import HsDev.Tools.GhcMod (parseOutputMessages)
@@ -19,51 +21,45 @@ 
 import Tool
 
-main :: IO ()
-main = toolMain "hsautofix" [
-	jsonCmd "show" [] [jsonArg] "show what can be auto-fixed" show',
-	jsonCmd "fix" [] [nList, pureArg] "fix selected errors" fix']
-	where
-		nList = list "num" "index" `short` ['n'] `desc` "corrrection indices to apply, if nothing specified - all corrections applies"
-		pureArg = flag "pure" `desc` "don't modify files, just return updated rest corrections"
-		jsonArg = flag "json" `desc` "output messages in JSON format"
+data FixCmd = ShowCmd Bool | FixCmd [Int] Bool
 
-		show' :: Args -> ToolM [Note Correction]
-		show' (Args _ as) = do
-			input <- liftE getContents
-			msgs <- if flagSet "json" as
-				then maybe (toolError "Can't parse messages") return $ decode (toUtf8 input)
-				else return $ parseOutputMessages input
-			mapM (liftE . canonicalize) $ corrections msgs
+fixP :: Parser FixCmd
+fixP = subparser $ mconcat [
+	cmd "show" "show what can be auto-fixed" (ShowCmd <$> switch (long "json" <> help "output messages in JSON format")),
+	cmd "fix" "fix selected errors" (FixCmd <$>
+		many (argument auto (metavar "N" <> help "indices of corrections to apply")) <*>
+		switch (long "pure" <> help "don't modify files, just return updated corrections"))]
 
-		fix' :: Args -> ToolM [Note Correction]
-		fix' (Args [] as) = do
-			input <- liftE getContents
-			corrs <- maybe (toolError "Can't parse messages") return $ decode (toUtf8 input)
-			let
-				nums :: [Int]
-				nums = mapMaybe readMaybe $ listArg "num" as
-				check i
-					| has "num" as = i `elem` nums
-					| otherwise = True
-				(fixCorrs, upCorrs) = (map snd *** map snd) $ 
-					partition (check . fst) $ zip [1..] corrs
-			files <- liftE $ mapM canonicalizePath $ ordNub $ sort $ mapMaybe (preview $ noteSource . moduleFile) corrs
-			let
-				doFix :: FilePath -> EditM String [Note Correction]
-				doFix file = do
-					autoFix_ fixCorrs'
-					(each . note) updateRange upCorrs'
-					where
-						findCorrs :: FilePath -> [Note Correction] -> [Note Correction]
-						findCorrs f = filter ((== Just f) . preview (noteSource . moduleFile))
-						fixCorrs' = map (view note) $ findCorrs file fixCorrs
-						upCorrs' = findCorrs file upCorrs
-				runFix file
-					| flagSet "pure" as = return $ fst $ runEdit $ doFix file
-					| otherwise = do
-						(corrs', cts') <- liftM (`editEval` doFix file) $ liftE $ readFileUtf8 file
-						liftE $ writeFileUtf8 file cts'
-						return corrs'
-			liftM concat $ mapM runFix files
-		fix' _ = toolError "Invalid arguments"
+main :: IO ()
+main = toolMain "hsautofix" "automatically fix some errors" fixP (printExceptT . printResult . go) where
+	go (ShowCmd isJson) = do
+		input <- liftE getContents
+		msgs <- if isJson
+			then maybe (throwError "Can't parse messages") return $ decode (toUtf8 input)
+			else return $ parseOutputMessages input
+		mapM (liftE . canonicalize) $ corrections msgs
+	go (FixCmd ns pure') = do
+		input <- liftE getContents
+		corrs <- maybe (throwError "Can't parse messages") return $ decode (toUtf8 input)
+		let
+			check i = i `elem` ns || null ns
+			(fixCorrs, upCorrs) = (map snd *** map snd) $
+				partition (check . fst) $ zip [1..] corrs
+		files <- liftE $ mapM canonicalizePath $ ordNub $ sort $ mapMaybe (preview $ noteSource . moduleFile) corrs
+		let
+			doFix :: FilePath -> String -> ([Note Correction], String)
+			doFix file cts = edit cts upCorrs' $ do
+				autoFix fixCorrs'
+				gets (view regions)
+				where
+					findCorrs :: FilePath -> [Note Correction] -> [Note Correction]
+					findCorrs f = filter ((== Just f) . preview (noteSource . moduleFile))
+					fixCorrs' = map (view note) $ findCorrs file fixCorrs
+					upCorrs' = findCorrs file upCorrs
+			runFix file
+				| pure' = return $ fst $ doFix file ""
+				| otherwise = do
+					(corrs', cts') <- liftM (doFix file) $ liftE $ readFileUtf8 file
+					liftE $ writeFileUtf8 file cts'
+					return corrs'
+		liftM concat $ mapM runFix files
tools/hscabal.hs view
@@ -7,5 +7,4 @@ import Tool
 
 main :: IO ()
-main = toolMain "hscabal" [
-	jsonCmd_ "list" ["packages..."] "list hackage packages" cabalList]
+main = toolMain "hscabal" "cabal tool" (many (strArgument (metavar "package"))) $ printExceptT . printResult . cabalList
tools/hsclearimports.hs view
@@ -6,46 +6,39 @@ import Control.Exception (finally)
 import Control.Monad.Except
 import System.Directory
-import System.Environment (getArgs)
 
 import HsDev.Tools.ClearImports (clearImports)
 import HsDev.Symbols (locateSourceDir)
 import HsDev.Project (entity)
 
-import System.Console.Cmd
-
-opts :: [Opt]
-opts = [
-	list "ghc" "GHC_OPT" `short` "g" `desc` "options for GHC",
-	flag "hide-import-list" `desc` "hide import list",
-	req "max-import-list" "N" `desc` "hide long import lists"]
+import Tool
 
-cmds :: [Cmd (IO ())]
-cmds = withHelp "hsclearimports" (printWith putStrLn) $ [
-	cmd [] ["file"] opts "clear imports in haskell source" clear]
-	where
-		clear :: Args -> IO ()
-		clear (Args [f] as) = do
-			file <- canonicalizePath f
-			mroot <- liftM (fmap $ view entity) $ locateSourceDir file
-			cur <- getCurrentDirectory
-			flip finally (setCurrentDirectory cur) $ do
-				maybe (return ()) setCurrentDirectory mroot
-				void $ runExceptT $ catchError
-					(clearImports (listArg "ghc" as) file >>= mapM_ (liftIO . putStrLn . format as))
-					(\e -> liftIO (putStrLn $ "Error: " ++ e))
-		clear _ = putStrLn "Invalid arguments"
+data Opts = Opts {
+	optsFile :: String,
+	optsGHC :: [String],
+	optsHideImportList :: Bool,
+	optsMaxImportList :: Maybe Int }
 
-		format :: Opts String -> (String, String) -> String
-		format as (imp, lst)
-			| flagSet "hide-import-list" as = imp
-			| maybe False (length lst >) (narg "max-import-list" as) = imp
-			| otherwise = imp ++ " (" ++ lst ++ ")"
+opts :: Parser Opts
+opts = Opts <$>
+	strArgument (metavar "file" <> help "file to clear imports in") <*>
+	many (strOption (long "ghc" <> short 'g' <> metavar "GHC_OPT" <> help "options for GHC")) <*>
+	switch (long "hide-import-list" <> help "hide import list") <*>
+	optional (option auto (long "max-import-list" <> metavar "N" <> help "hide long import lists"))
 
 main :: IO ()
-main = do
-	args <- getArgs
-	run cmds noCmd onError args
+main = toolMain "hsclearimports" "clears imports in haskell source" opts $ \opts' -> do
+	file <- canonicalizePath (optsFile opts')
+	mroot <- liftM (fmap $ view entity) $ locateSourceDir file
+	cur <- getCurrentDirectory
+	flip finally (setCurrentDirectory cur) $ do
+		maybe (return ()) setCurrentDirectory mroot
+		void $ runExceptT $ catchError
+			(clearImports (optsGHC opts') file >>= mapM_ (liftIO . putStrLn . format opts'))
+			(\e -> liftIO (putStrLn $ "Error: " ++ e))
 	where
-		noCmd = putStrLn "Invalid command"
-		onError = putStrLn
+		format :: Opts -> (String, String) -> String
+		format as (imp, lst)
+			| optsHideImportList as = imp
+			| maybe False (length lst >) (optsMaxImportList as) = imp
+			| otherwise = imp ++ " (" ++ lst ++ ")"
tools/hsdev.hs view
@@ -1,68 +1,37 @@-{-# LANGUAGE TemplateHaskell #-}
-
 module Main (
 	main
 	) where
 
 import Control.Exception
-import Control.Monad
+import Data.List
 import Network.Socket (withSocketsDo)
+import Options.Applicative
 import System.Environment (getArgs)
 import System.Exit
 import System.IO
-import Text.Read (readMaybe)
 
-import Control.Apply.Util (chain)
-import System.Console.Cmd
-import qualified System.Console.Cmd as C (brief)
-
-import qualified HsDev.Client.Commands as Client (commands)
-import qualified HsDev.Server.Commands as Server
-import HsDev.Version
+import HsDev.Server.Commands (runServerCommand)
+import HsDev.Server.Types
+import HsDev.Util
 
 main :: IO ()
 main = handle logErr' $ withSocketsDo $ do
 	hSetBuffering stdout LineBuffering
 	hSetEncoding stdout utf8
-	as <- getArgs
-	when (null as) $ do
-		printUsage
-		exitSuccess
-	let
-		asr = if last as == "-?" then "help" : init as else as 
-	run mainCommands (onError "Unknown command") onError asr
+	as <- prepareArgs
+	case parseArgs "hsdev" (info cmdP (progDesc "hsdev tool")) as of
+		Left e -> putStrLn e >> exitFailure
+		Right scmd -> runServerCommand scmd
 	where
-		onError :: String -> IO ()
-		onError errs = putStrLn errs >> exitFailure
-
 		logErr' (SomeException e) = putStrLn $ "exception " ++ show e
 
-mainCommands :: [Cmd (IO ())]
-mainCommands = withHelp "hsdev" (printWith putStrLn) $ concat [
-	[cmd "version" [] [] "hsdev version" version'],
-	map (chain [validateOpts, noArgs]) Server.commands,
-	map Server.clientCmd Client.commands]
-	where
-		version' _ = putStrLn $cabalVersion
-
-printUsage :: IO ()
-printUsage = mapM_ (putStrLn . ('\t':) . ("hsdev " ++) . C.brief) mainCommands
-
--- | Check that specified options are numbers
-validateNums :: [String] -> Cmd a -> Cmd a
-validateNums ns = validateArgs (check . namedArgs) where
-	check os = forM_ ns $ \n -> case (readMaybe :: String -> Maybe Int) <$> arg n os of
-		Just Nothing -> failMatch "Must be a number"
-		_ -> return ()
-
--- | Check, that 'port' and 'timeout' are numbers
-validateOpts :: Cmd a -> Cmd a
-validateOpts = validateNums ["port", "timeout"]
-
--- | Ensure no positional arguments provided
-noArgs :: Cmd a -> Cmd a
-noArgs = validateArgs (noPos . posArgs) where
-	noPos ps =
-		guard (null ps)
-		`mplus`
-		failMatch "positional arguments are not expected"
+-- | Get args with '--stdin' flag replaced and 'help' command changed to flag
+prepareArgs :: IO [String]
+prepareArgs = getArgs >>= prepare where
+	prepare [] = return []
+	prepare ("head" : as) = prepare $ as ++ ["-?"]
+	prepare as
+		| "--stdin" `elem` as = do
+			input <- getContents
+			return $ delete "--stdin" as ++ ["--data", input]
+		| otherwise = return as
tools/hshayoo.hs view
@@ -3,19 +3,23 @@ 	) where
 
 import Data.Maybe
+
 import HsDev.Tools.Hayoo
 
 import Tool
 
-main :: IO ()
-main = toolMain "hshayoo" [
-	jsonCmd "" ["query"] options "search in hayoo" hayoo']
-	where
-		options = [
-			req "page" "n" `short` ['p'] `desc` "page number (0 by default)",
-			req "pages" "count" `short` ['n'] `desc` "pages count (1 by default)"]
+data HayooOpts = HayooOpts {
+	optsQuery :: String,
+	optsPage :: Int,
+	optsPages :: Int }
 
-		hayoo' (Args [q] opts) = liftM concat $ forM [page .. page + pred pages] $ \i -> liftM (mapMaybe hayooAsDeclaration . resultResult) $ hayoo q (Just i) where
-			page = fromMaybe 0 (narg "page" opts)
-			pages = fromMaybe 1 (narg "pages" opts)
-		hayoo' _ = toolError "Invalid arguments"
+hayooOpts :: Parser HayooOpts
+hayooOpts = HayooOpts <$>
+	strArgument (help "hayoo query") <*>
+	(option auto (long "page" <> short 'p' <> help "page number (0 by default") <|> pure 0) <*>
+	(option auto (long "pages" <> short 'n' <> help "pages count (1 by default") <|> pure 1)
+
+main :: IO ()
+main = toolMain "hshayoo" "hayoo search" hayooOpts $ \(HayooOpts q page pages) -> printExceptT $ printResult $
+	liftM concat $ forM [page .. page + pred pages] $ \i ->
+		liftM (mapMaybe hayooAsDeclaration . resultResult) $ hayoo q (Just i)
tools/hsinspect.hs view
@@ -12,30 +12,37 @@ 
 import HsDev.Project (readProject)
 import HsDev.Scan (scanModule, scanModify)
-import HsDev.Inspect (inspectContents, inspectDocs)
+import HsDev.Inspect (inspectContents, inspectDocs, getDefines)
 import HsDev.Symbols.Location (ModuleLocation(..), Cabal(..))
 import HsDev.Tools.GhcMod.InferType (infer)
 
 import Tool
 
-main :: IO ()
-main = toolMain "hsinspect" [
-	jsonCmd "" ["what"] [ghcOpts] "depending of what <what> is, inspect installed module, source file (.hs), cabal file (.cabal) or contents, passes as input if no <what> specified" inspect']
-	where
-		ghcOpts = list "ghc" "option" `short` ['g'] `desc` "options to pass to GHC"
-		ghcs = listArg "ghc"
+data Opts = Opts {
+	optsWhat :: Maybe String,
+	optsGHC :: [String] }
 
-		inspect' (Args [] opts) = liftIO getContents >>= liftM toJSON . inspectContents "stdin" (ghcs opts)
-		inspect' (Args [fname@(takeExtension -> ".hs")] opts) = do
-			fname' <- liftIO $ canonicalizePath fname
-			im <- scanModule (ghcs opts) (FileModule fname' Nothing) Nothing
-			let
-				scanAdditional =
-					scanModify (\opts' _ -> inspectDocs opts') >=>
-					scanModify infer
-			toJSON <$> scanAdditional im
-		inspect' (Args [fcabal@(takeExtension -> ".cabal")] _) = do
-			fcabal' <- liftIO $ canonicalizePath fcabal
-			toJSON <$> readProject fcabal'
-		inspect' (Args [mname] opts) = toJSON <$> scanModule (ghcs opts) (CabalModule Cabal Nothing mname) Nothing
-		inspect' _ = toolError "Specify module name or file name (.hs or .cabal)"
+opts :: Parser Opts
+opts = Opts <$>
+	optional (strArgument (metavar "what" <> help "depending of what <what> is, inspect installed module, source file (.hs), cabal file (.cabal) or contents, passes as input if no <what> specified")) <*>
+	many (strOption (metavar "GHC_OPT" <> long "ghc" <> short 'g' <> help "options to pass to GHC"))
+
+main :: IO ()
+main = toolMain "hsinspect" "haskell inspect" opts (printExceptT . printResult . inspect') where
+	inspect' (Opts Nothing ghcs) = do
+		cts <- liftIO getContents
+		defs <- liftIO getDefines
+		liftM toJSON $ inspectContents "stdin" defs ghcs cts
+	inspect' (Opts (Just fname@(takeExtension -> ".hs")) ghcs) = do
+		fname' <- liftIO $ canonicalizePath fname
+		defs <- liftIO getDefines
+		im <- scanModule defs ghcs (FileModule fname' Nothing) Nothing
+		let
+			scanAdditional =
+				scanModify (\opts' _ -> inspectDocs opts') >=>
+				scanModify infer
+		toJSON <$> scanAdditional im
+	inspect' (Opts (Just fcabal@(takeExtension -> ".cabal")) _) = do
+		fcabal' <- liftIO $ canonicalizePath fcabal
+		toJSON <$> readProject fcabal'
+	inspect' (Opts (Just mname) ghcs) = toJSON <$> scanModule [] ghcs (CabalModule Cabal Nothing mname) Nothing