hsdev 0.1.3.2 → 0.1.3.3

raw patch · 27 files changed

+899/−193 lines, 27 filesdep +lensnew-component:exe:hsautofix

Dependencies added: lens

Files

• hsdev.cabal +19/−1
• src/Control/Concurrent/Task.hs +14/−5
• src/Control/Concurrent/Worker.hs +7/−4
• src/Data/Mark.hs +311/−0
• src/HsDev.hs +14/−10
• src/HsDev/Cabal.hs +2/−2
• src/HsDev/Cache/Structured.hs +5/−6
• src/HsDev/Client/Commands.hs +77/−17
• src/HsDev/Commands.hs +6/−12
• src/HsDev/Database.hs +1/−3
• src/HsDev/Database/Async.hs +6/−1
• src/HsDev/Database/Update.hs +91/−32
• src/HsDev/Inspect.hs +22/−20
• src/HsDev/Scan.hs +20/−15
• src/HsDev/Scan/Browse.hs +16/−12
• src/HsDev/Server/Commands.hs +11/−12
• src/HsDev/Symbols.hs +3/−0
• src/HsDev/Symbols/Location.hs +1/−1
• src/HsDev/Tools/AutoFix.hs +107/−0
• src/HsDev/Tools/ClearImports.hs +13/−15
• src/HsDev/Tools/Ghc/Worker.hs +1/−1
• src/HsDev/Tools/GhcMod.hs +30/−11
• src/HsDev/Tools/GhcMod/InferType.hs +13/−3
• src/HsDev/Util.hs +38/−5
• tools/Tool.hs +1/−1
• tools/hsautofix.hs +60/−0
• tools/hsinspect.hs +10/−4

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.3.2
+version:             0.1.3.3
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -29,6 +29,7 @@     Data.Group
     Data.Help
     Data.Lisp
+    Data.Mark
     HsDev
     HsDev.Cabal
     HsDev.Cache
@@ -52,6 +53,7 @@     HsDev.Symbols.Documented
     HsDev.Symbols.Resolve
     HsDev.Symbols.Util
+    HsDev.Tools.AutoFix
     HsDev.Tools.Base
     HsDev.Tools.Cabal
     HsDev.Tools.ClearImports
@@ -99,6 +101,7 @@     haskell-src-exts >= 1.16.0,
     hdocs >= 0.4.0,
     HTTP >= 4000.2.0,
+    lens >= 4.7,
     monad-loops >= 0.4,
     mtl >= 2.1.0,
     network >= 2.4.0,
@@ -209,6 +212,21 @@     mtl >= 2.1.0,
     text >= 1.1.0,
     unordered-containers >= 0.2.0
+
+executable hsautofix
+  main-is: hsautofix.hs
+  hs-source-dirs: tools
+  ghc-options: -Wall
+  other-modules:
+    Tool
+  build-depends:
+    base >= 4.7 && < 5,
+    hsdev,
+    aeson >= 0.7.0,
+    aeson-pretty >= 0.7.0,
+    bytestring >= 0.10.0,
+    directory >= 1.2.0,
+    mtl >= 2.1.0
 
 test-suite test
   main-is: Test.hs

@@ -4,13 +4,13 @@ 	Task(..), TaskException(..), TaskResult(..),
 	taskStarted, taskRunning, taskStopped, taskDone, taskFailed, taskCancelled,
 	taskWaitStart, taskWait, taskKill, taskCancel, taskStop,
-	runTask, runTask_, forkTask
+	runTask, runTask_, runTaskTry, runTaskError, forkTask, tryT
 	) where
 
 import Control.Applicative
 import Control.Concurrent
 import Control.Monad
-import Control.Monad.IO.Class
+import Control.Monad.Error
 import Control.Monad.Catch
 import Data.Either
 import Data.Maybe
@@ -94,13 +94,16 @@ runTask f = runTask_ (const f)
 
 runTask_ :: (MonadCatch m, MonadIO m, MonadIO n) => (Task a -> m () -> n ()) -> m a -> n (Task a)
-runTask_ f act = do
+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 . Right
+		when ok $ act >>= liftIO . putMVar resultVar
 	return $ Task throwVar $ toResult resultVar
 	where
 		toResult :: MVar (Either SomeException a) -> TaskResult a
@@ -108,8 +111,14 @@ 			taskResultEmpty = isEmptyMVar var,
 			taskResultTryRead = tryReadMVar var,
 			taskResultTake = takeMVar var,
-			taskResultFail = void . tryPutMVar var . Left }
+			taskResultFail = void . tryPutMVar var . Left }	
 
+runTaskError :: (Show e, Error 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, Error e, MonadError e m) => m a -> m (Either SomeException a)
+tryT act = catchError (liftM Right act) (return . Left . toException . userError . show)

@@ -1,3 +1,5 @@+{-# LANGUAGE RankNTypes #-}
+
 module Control.Concurrent.Worker (
 	Worker(..),
 	startWorker,
@@ -17,11 +19,12 @@ 
 data Worker m = Worker {
 	workerChan :: Chan (Task (), m ()),
+	workerWrap :: forall a. m a -> m a,
 	workerTask :: MVar (Task ()),
 	workerRestart :: IO Bool }
 
-startWorker :: MonadIO m => (m () -> IO ()) -> (m () -> m ()) -> IO (Worker m)
-startWorker run initialize = do
+startWorker :: MonadIO m => (m () -> IO ()) -> (m () -> m ()) -> (forall a. m a -> m a) -> IO (Worker m)
+startWorker run initialize wrap = do
 	ch <- newChan
 	taskVar <- newEmptyMVar
 	let
@@ -39,10 +42,10 @@ 			stopped <- taskStopped task
 			when stopped (start >>= void . swapMVar taskVar)
 			return stopped
-	return $ Worker ch taskVar restart
+	return $ Worker ch wrap taskVar restart
 
 sendTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)
-sendTask w = runTask_ putTask' where
+sendTask w = runTask_ putTask' . workerWrap w where
 	putTask' t act = putChan (workerChan w) (fmap (const ()) t, act)
 
 pushTask :: (MonadCatch m, MonadIO m) => Worker m -> m a -> IO (Task a)

@@ -0,0 +1,311 @@+{-# LANGUAGE ViewPatterns, OverloadedStrings, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, RankNTypes #-}
+
+module Data.Mark (
+	Point(..), (.-.), (.+.), Size, linesSize, stringSize,
+	Region(..), regionLines, emptyRegion,
+	line,
+	region, regionSize, at,
+	-- * Mappings
+	Map(..), apply, back,
+	cut, insert,
+	cutRegion, insertRegion,
+	-- * Edited data
+	Contents, Edit(..),
+	EditM(..), editRegion, mapRegion, runEdit, edit, editEval,
+	Prefix(..), prefix, Suffix(..), suffix, concatCts, splitCts,
+	-- * Editable class
+	Editable(..), measure,
+	-- * Actions
+	erase, write, replace,
+	Replace(..), eraser, writer, replacer, run
+	) where
+
+import Prelude hiding (splitAt, length, lines, unlines)
+
+import Control.Arrow ((&&&))
+import Control.Applicative
+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 Data.Monoid
+
+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
+
+-- | Region from "Point" to "Point"
+data Region = Region {
+	regionFrom :: Point,
+	regionTo :: Point }
+		deriving (Eq, Ord, Read, Show)
+
+type Size = Point
+
+instance Monoid Size where
+	mempty = Point 0 0
+	l `mappend` r = r .+. l
+
+-- | Distance in @n@ lines
+linesSize :: Int -> Point
+linesSize n = Point n 0
+
+-- | Distance in @n@ chars within one line
+stringSize :: Int -> Point
+stringSize n = Point 0 n
+
+instance ToJSON Region where
+	toJSON (Region f t) = object ["from" .= f, "to" .= t]
+
+instance FromJSON Region where
+	parseJSON = withObject "region" $ \v -> Region <$> v .:: "from" <*> v .:: "to"
+
+-- | "Region" height in lines. Any "Region" at least of one line height
+regionLines :: Region -> Int
+regionLines r = succ $ pointLine (regionTo r) - pointLine (regionFrom r)
+
+-- | Is "Region" empty
+emptyRegion :: Region -> Bool
+emptyRegion r = regionTo r == regionFrom r
+
+-- | n'th line region, starts at the beginning of line and ends on the next line
+line :: Int -> Region
+line l = region (Point l 0) (Point (succ l) 0)
+
+-- | Make region
+region :: Point -> Point -> Region
+region f t = Region (min f t) (max f t)
+
+-- | Make region from starting point and its size
+regionSize :: Point -> Size -> Region
+regionSize pt sz = region pt (sz .+. pt)
+
+-- | Get contents at specified region
+at :: Editable a => Contents a -> Region -> Contents a
+at cts r =
+	onHead (snd . splitAt (pointColumn $ regionFrom r)) .
+	onLast (fst . splitAt (pointColumn $ regionTo r)) .
+	take (regionLines r) .
+	drop (pointLine (regionFrom 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 regions: inserting and cutting
+-- When something is cutted out or inserted in, region 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 regions to regions on updated data
+-- Because insert is dual to cut (and therefore composes iso), we can also get function to map regions back
+-- Combining this functions while edit, we get function, that maps regions 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' Region Region }
+
+instance Monoid Map where
+	mempty = Map $ iso id id
+	(Map l) `mappend` (Map r) = Map (r . l)
+
+-- | Apply mapping
+apply :: Map -> Region -> Region
+apply = view . mapIso
+
+-- | Back mapping
+back :: Map -> Map
+back (Map f) = Map (from f)
+
+-- | Cut region mapping
+cut :: Region -> Map
+cut rgn = Map $ iso (cutRegion rgn) (insertRegion rgn)
+
+-- | Opposite to "cut"
+insert :: Region -> Map
+insert = back . cut
+
+-- | Update second region position as if it was data cutted at first region
+cutRegion :: Region -> Region -> Region
+cutRegion (Region is ie) (Region s e) = Region
+	(if is < s then (s .-. ie) .+. is else s)
+	(if is < e then (e .-. ie) .+. is else e)
+
+-- | Update second region position as if it was data inserted at first region
+insertRegion :: Region -> Region -> Region
+insertRegion (Region is ie) (Region s e) = Region
+	(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 region 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 region 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 region, region edit function and contents updater
+-- and passes mapped region to these functions to get new state
+editRegion :: Region -> (Region -> Edit a) -> EditM a ()
+editRegion rgn edit' = do
+	rgn' <- mapRegion rgn
+	modify (`mappend` (edit' rgn'))
+
+-- | Get mapped region
+mapRegion :: Region -> EditM a Region
+mapRegion 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)
+
+-- | Erase data
+erase :: Editable s => Region -> EditM s ()
+erase rgn = editRegion rgn (\r -> Edit (erase' r) (cut r)) where
+	erase' :: Editable a => Region -> Contents a -> Contents a
+	erase' rgn' cts = fst (splitCts (regionFrom rgn') cts) `concatCts` snd (splitCts (regionTo rgn') cts)
+
+-- | Paste data at position
+write :: Editable s => Point -> Contents s -> EditM s ()
+write _ ([]) = error "Invalid argument"
+write pt cts = editRegion (pt `regionSize` measure cts) (\r -> Edit (write' r) (insert r)) where
+	write' rgn' origin = prefix (before' `concatCts` suffix cts) `concatCts` after' where
+		(before', after') = splitCts (regionFrom rgn') origin
+
+-- | Replace data with
+replace :: Editable s => Region -> Contents s -> EditM s ()
+replace rgn cts = erase rgn >> write (regionFrom rgn) cts
+
+-- | Replace action
+data Replace s = Replace {
+	replaceRegion :: Region,
+	replaceWith :: Contents s }
+		deriving (Eq, Read, Show)
+
+instance (Editable s, ToJSON s) => ToJSON (Replace s) where
+	toJSON (Replace e c) = object ["region" .= e, "contents" .= unlines c]
+
+instance (Editable s, FromJSON s) => FromJSON (Replace s) where
+	parseJSON = withObject "edit" $ \v -> Replace <$> v .:: "region" <*> (lines <$> v .:: "contents")
+
+eraser :: Monoid s => Region -> Replace s
+eraser rgn = Replace rgn [mempty]
+
+writer :: Editable s => Point -> s -> Replace s
+writer pt cts = Replace (region pt pt) $ lines cts
+
+replacer :: Editable s => Region -> s -> Replace s
+replacer rgn cts = Replace rgn (lines cts)
+
+run :: Editable s => [Replace s] -> EditM s ()
+run = mapM_ (uncurry replace . (replaceRegion &&& replaceWith))

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

@@ -14,7 +14,7 @@ import System.Directory
 import System.FilePath
 
-import HsDev.Util (searchPath)
+import HsDev.Util (searchPath, liftE)
 
 -- | Cabal or sandbox
 data Cabal = Cabal | Sandbox FilePath deriving (Eq, Ord)
@@ -72,7 +72,7 @@ 
 -- | Create sandbox by directory or package-db file
 locateSandbox :: FilePath -> ErrorT String IO Cabal
-locateSandbox p = liftIO (findPackageDb p) >>= maybe
+locateSandbox p = liftE (findPackageDb p) >>= maybe
 	(throwError $ "Can't locate package-db in sandbox: " ++ p)
 	(return . Sandbox)
 

@@ -46,7 +46,7 @@ 	loadStandaloneFiles = ErrorT $ Cache.load (dir </> Cache.standaloneCache)
 
 	loadDir p = do
-		fs <- liftIO $ liftM (filter ((== ".json") . takeExtension)) $ directoryContents p
+		fs <- liftE $ liftM (filter ((== ".json") . takeExtension)) $ directoryContents p
 		mapM (ErrorT . Cache.load) fs
 
 -- | Load data from cache
@@ -66,10 +66,9 @@ 	ErrorT $ return $ structured [] [dat] mempty
 
 -- | Load standalone files
-loadFiles :: [FilePath] -> FilePath -> ErrorT String IO Structured
-loadFiles fs dir = do
+loadFiles :: (FilePath -> Bool) -> FilePath -> ErrorT String IO Structured
+loadFiles f dir = do
 	dat <- loadData (dir </> Cache.standaloneCache)
-	ErrorT $ return $ structured [] [] $ filterDB inFiles (const False) dat
+	ErrorT $ return $ structured [] [] $ filterDB f' (const False) dat
 	where
-		inFiles = maybe False (`elem` fs') . moduleSource . moduleIdLocation
-		fs' = map normalise fs
+		f' = maybe False f . moduleSource . moduleIdLocation

@@ -38,6 +38,7 @@ import HsDev.Server.Types
 import qualified HsDev.Tools.Cabal as Cabal
 import HsDev.Tools.Ghc.Worker
+import qualified HsDev.Tools.AutoFix as AutoFix
 import qualified HsDev.Tools.GhcMod as GhcMod
 import qualified HsDev.Tools.Hayoo as Hayoo
 import qualified HsDev.Cache.Structured as SC
@@ -136,7 +137,11 @@ 	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] "check source files" ghcmodCheck',
-	cmdList' "ghc-mod lint" ["file"] [hlintOpts] "lint source file" ghcmodLint',
+	cmdList' "ghc-mod lint" ["files..."] [hlintOpts] "lint source file" ghcmodLint',
+	cmdList' "ghc-mod check-lint" ["files..."] [sandboxArg, ghcOpts, hlintOpts] "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
@@ -200,6 +205,8 @@ 		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 = [
@@ -260,18 +267,18 @@ 		scan' :: [String] -> Opts String -> CommandActionT ()
 		scan' _ as copts = do
 			cabals <- getSandboxes copts as
-			updateProcess copts as $ do
-				mapM_ (Update.scanCabal (listArg "ghc" as)) cabals
-				mapM_ (\(n, f) -> forM_ (listArg n as) (findPath copts >=> f (listArg "ghc" as))) [
+			updateProcess copts as $ concat [
+				concatMap (\(n, f) -> [findPath copts v >>= f (listArg "ghc" as) | v <- listArg n as]) [
 					("project", Update.scanProject),
 					("file", Update.scanFile),
-					("path", Update.scanDirectory)]
+					("path", Update.scanDirectory)],
+				map (Update.scanCabal (listArg "ghc" as)) cabals]
 
 		-- | Rescan data
 		rescan' :: [String] -> Opts String -> CommandActionT ()
 		rescan' _ as copts = do
 			cabals <- getSandboxes copts as
-			updateProcess copts as $ mapM_ (Update.scanCabal (listArg "ghc" as)) cabals
+			updateProcess copts as $ map (Update.scanCabal (listArg "ghc" as)) cabals
 
 			dbval <- getDb copts
 			let
@@ -301,9 +308,9 @@ 
 			if not (null errors)
 				then commandError (intercalate ", " errors) []
-				else updateProcess copts as $ Update.runTask "rescanning modules" [] $ do
+				else updateProcess copts as [Update.runTask "rescanning modules" [] $ do
 					needRescan <- Update.liftErrorT $ filterM (changedModule dbval (listArg "ghc" as) . inspectedId) rescanMods
-					Update.scanModules (listArg "ghc" as) (map (inspectedId &&& inspectionOpts . inspection) needRescan)
+					Update.scanModules (listArg "ghc" as) (map (inspectedId &&& inspectionOpts . inspection) needRescan)]
 
 		-- | Remove data
 		remove' :: [String] -> Opts String -> CommandActionT [ModuleId]
@@ -552,7 +559,7 @@ 		ghcmodCheck' [] _ _ = commandError "Specify at least one file" []
 		ghcmodCheck' files as copts = do
 			files' <- mapM (findPath copts) files
-			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM (locateProject) files')
+			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM locateProject files')
 			cabal <- getCabal copts as
 			mapErrorStr $ liftM concat $ forM files' $ \file' ->
 				GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $
@@ -560,13 +567,64 @@ 
 		-- | Ghc-mod lint
 		ghcmodLint' :: [String] -> Opts String -> CommandActionT [GhcMod.OutputMessage]
-		ghcmodLint' [] _ _ = commandError "Specify file to hlint" []
-		ghcmodLint' [file] as copts = do
-			file' <- findPath copts file
-			mapErrorStr $ GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $
-				GhcMod.lint (listArg "hlint" as) file'
-		ghcmodLint' _ _ _ = commandError "Too much files specified" []
+		ghcmodLint' [] _ _ = commandError "Specify at least one file to hlint" []
+		ghcmodLint' files as copts = do
+			files' <- mapM (findPath copts) files
+			mapErrorStr $ 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 [GhcMod.OutputMessage]
+		ghcmodCheckLint' [] _ _ = commandError "Specify at least one file" []
+		ghcmodCheckLint' files as copts = do
+			files' <- mapM (findPath copts) files
+			mproj <- (listToMaybe . catMaybes) <$> liftIO (mapM locateProject files')
+			cabal <- getCabal copts as
+			mapErrorStr $ liftM concat $ forM files' $ \file' ->
+				GhcMod.waitMultiGhcMod (commandGhcMod copts) file' $ do
+					check' <- GhcMod.check (listArg "ghc" as) cabal [file'] mproj
+					lint' <- GhcMod.lint (listArg "hlint" as) file'
+					return $ check' ++ lint'
+
+		-- | Autofix show
+		autofixShow' :: [String] -> Opts String -> CommandActionT [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 [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 (nub . sort) $ mapM (findPath copts) $ map AutoFix.correctionFile corrs
+			let
+				doFix file = AutoFix.autoFix
+					(filter ((== file) . AutoFix.correctionFile) corrs)
+					(filter ((== file) . AutoFix.correctionFile) 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'
+			mapErrorStr $ liftM concat $ mapM runFix files
+
 		-- | Evaluate expression
 		ghcEval' :: [String] -> Opts String -> CommandActionT [Value]
 		ghcEval' exprs _ copts = mapErrorStr $ liftM (map toValue) $ liftTask $
@@ -766,14 +824,16 @@ mapErrorStr = mapErrorT (liftM $ left strMsg)
 
 -- | Run DB update action
-updateProcess :: CommandOptions -> Opts String -> ErrorT String (Update.UpdateDB IO) () -> CommandM ()
-updateProcess copts as act = lift $ Update.updateDB settings act where
+updateProcess :: CommandOptions -> Opts String -> [ErrorT String (Update.UpdateDB IO) ()] -> CommandM ()
+updateProcess copts as acts = lift $ Update.updateDB settings $ sequence_ [act `catchError` logErr | act <- acts] where
 	settings = Update.Settings
 		(commandDatabase copts)
 		(commandReadCache copts)
 		(commandWriteCache copts)
 		(commandNotify copts . Notification . toJSON)
 		(listArg "ghc" as)
+	logErr :: String -> ErrorT String (Update.UpdateDB IO) ()
+	logErr e = liftIO $ commandLog copts e
 
 -- | Filter declarations with prefix and infix
 filterMatch :: Opts String -> [ModuleDeclaration] -> [ModuleDeclaration]

@@ -34,6 +34,7 @@ import HsDev.Symbols.Resolve
 import HsDev.Symbols.Util
 import HsDev.Tools.Base (matchRx, at)
+import HsDev.Util (liftE)
 
 -- | Find declaration by name
 findDeclaration :: Database -> String -> ErrorT String IO [ModuleDeclaration]
@@ -52,13 +53,13 @@ -- | Find module in file
 fileModule :: Database -> FilePath -> ErrorT String IO Module
 fileModule db src = do
-	src' <- liftIO $ canonicalizePath src
+	src' <- liftE $ canonicalizePath src
 	maybe (throwError $ "File '" ++ src' ++ "' not found") return $ lookupFile src' db
 
 -- | Find project of module
 getProject :: Database -> Project -> ErrorT String IO Project
 getProject db p = do
-	p' <- liftIO $ canonicalizePath $ projectCabal p
+	p' <- liftE $ canonicalizePath $ projectCabal p
 	maybe (throwError $ "Project " ++ p' ++ " not found") return $
 		M.lookup p' $ databaseProjects db
 
@@ -150,13 +151,6 @@ visibleFrom (Just p) this m = visible p (moduleId this) m
 visibleFrom Nothing this m = (moduleId this) == m || byCabal m
 
--- | Get module imports with Prelude and self import
-moduleImports' :: Module -> [Import]
-moduleImports' m =
-	import_ (fromString "Prelude") :
-	import_ (moduleName m) :
-	moduleImports m
-
 -- | Split identifier into module name and identifier itself
 splitIdentifier :: String -> (Maybe String, String)
 splitIdentifier name = fromMaybe (Nothing, name) $ do
@@ -170,7 +164,7 @@ -- | Get context file and project
 fileCtx :: Database -> FilePath -> ErrorT String IO (FilePath, Module, Maybe Project)
 fileCtx db file = do
-	file' <- liftIO $ canonicalizePath file
+	file' <- liftE $ canonicalizePath file
 	mthis <- fileModule db file'
 	mproj <- traverse (getProject db) $ projectOf $ moduleId mthis
 	return (file', mthis, mproj)
@@ -179,8 +173,8 @@ fileCtxMaybe :: Database -> FilePath -> ErrorT String IO (FilePath, Maybe Module, Maybe Project)
 fileCtxMaybe db file = ((\(f, m, p) -> (f, Just m, p)) <$> fileCtx db file) <|> onlyProj where
 	onlyProj = do
-		file' <- liftIO $ canonicalizePath file
-		mproj <- liftIO $ locateProject file'
+		file' <- liftE $ canonicalizePath file
+		mproj <- liftE $ locateProject file'
 		mproj' <- traverse (getProject db) mproj
 		return (file', Nothing, mproj')
 

@@ -123,9 +123,7 @@ -- | Standalone database
 standaloneDB :: Database -> Database
 standaloneDB db = filterDB (check') (const False) db where
-	check' m = noProject m && byFile m
-	noProject m = all (not . flip inProject m) ps
-	ps = M.elems $ databaseProjects db
+	check' m = standalone m && byFile m
 
 -- | Select module by predicate
 selectModules :: (Module -> Bool) -> Database -> [Module]

@@ -1,5 +1,5 @@ module HsDev.Database.Async (
-	update, wait,
+	update, clear, wait,
 	module Data.Async
 	) where
 
@@ -15,6 +15,11 @@ update db act = do
 	db' <- act
 	force db' `seq` liftIO (modifyAsync db (Append db'))
+
+clear :: MonadIO m => Async Database -> m Database -> m ()
+clear db act = do
+	db' <- act
+	force db' `seq` liftIO (modifyAsync db (Remove db'))
 
 -- | This function is used to ensure that all previous updates were applied
 wait :: MonadIO m => Async Database -> m ()

@@ -7,10 +7,11 @@ 	UpdateDB,
 	updateDB,
 
-	postStatus, waiter, updater, loadCache, runTask, runTasks,
+	postStatus, waiter, updater, loadCache, getCache, runTask, runTasks,
 	readDB,
 
 	scanModule, scanModules, scanFile, scanCabal, scanProjectFile, scanProject, scanDirectory,
+	scan,
 
 	-- * Helpers
 	liftErrorT
@@ -27,7 +28,7 @@ import Data.List (nub)
 import Data.Map (Map)
 import qualified Data.Map as M
-import Data.Maybe (mapMaybe, isJust)
+import Data.Maybe (mapMaybe, isJust, fromMaybe, catMaybes)
 import qualified Data.Text as T (unpack)
 import System.Directory (canonicalizePath)
 
@@ -35,12 +36,14 @@ import HsDev.Database
 import HsDev.Database.Async
 import HsDev.Display
+import HsDev.Inspect (inspectDocs)
 import HsDev.Project
 import HsDev.Symbols
 import HsDev.Tools.HDocs
+import HsDev.Tools.GhcMod.InferType (infer)
 import qualified HsDev.Scan as S
 import HsDev.Scan.Browse
-import HsDev.Util ((.::))
+import HsDev.Util ((.::), liftEIO, isParent)
 
 data Status = StatusWorking | StatusOk | StatusError String
 
@@ -107,7 +110,7 @@ -- | Run `UpdateDB` monad
 updateDB :: MonadIO m => Settings -> ErrorT String (UpdateDB m) () -> m ()
 updateDB sets act = do
-	updatedMods <- execWriterT (runUpdateDB (runErrorT act >> return ()) `runReaderT` sets)
+	updatedMods <- execWriterT (runUpdateDB (runErrorT act' >> return ()) `runReaderT` sets)
 	wait $ database sets
 	dbval <- liftIO $ readAsync $ database sets
 	let
@@ -120,7 +123,27 @@ 			map (`projectDB` dbval) projs,
 			[standaloneDB dbval | stand]]
 	liftIO $ databaseCacheWriter sets modifiedDb
+	where
+		act' = do
+			mlocs' <- liftM (filter (isJust . moduleSource) . snd) $ listen act
+			wait $ database sets
+			let
+				getMods = do
+					db' <- liftIO $ readAsync $ database sets
+					return $ catMaybes [M.lookup mloc' (databaseModules db') | mloc' <- mlocs']
+			getMods >>= waiter . runTask "inspecting source docs" [] . runTasks . map scanDocs
+			getMods >>= waiter . runTask "inferring types" [] . runTasks . map inferModTypes
+		scanDocs :: MonadIO m => InspectedModule -> ErrorT String (UpdateDB m) ()
+		scanDocs im = runTask "scanning docs" (subject (inspectedId im) ["module" .= inspectedId im]) $ do
+			im' <- liftErrorT $ S.scanModify (\opts _ -> inspectDocs opts) im
+			updater $ return $ fromModule im'
+		inferModTypes :: MonadIO m => InspectedModule -> ErrorT String (UpdateDB m) ()
+		inferModTypes im = runTask "inferring types" (subject (inspectedId im) ["module" .= inspectedId im]) $ do
+			-- TODO: locate sandbox
+			im' <- liftErrorT $ S.scanModify (\opts cabal -> infer opts cabal) im
+			updater $ return $ fromModule im'
 
+
 -- | Post status
 postStatus :: (MonadIO m, MonadReader Settings m) => Task -> m ()
 postStatus s = do
@@ -142,15 +165,32 @@ 	update db $ return db'
 	tell $ map moduleLocation $ allModules db'
 
--- | Load data from cache and wait
-loadCache :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => (FilePath -> ErrorT String IO Structured) -> m ()
+-- | Clear obsolete data from database
+cleaner :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => m Database -> m ()
+cleaner act = do
+	db <- asks database
+	db' <- act
+	clear db $ return db'
+
+-- | Get data from cache without updating DB
+loadCache :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => (FilePath -> ErrorT String IO Structured) -> m Database
 loadCache act = do
 	cacheReader <- asks databaseCacheReader
 	mdat <- liftIO $ cacheReader act
-	case mdat of
-		Nothing -> return ()
-		Just dat -> waiter (updater (return dat))
+	return $ fromMaybe mempty mdat
 
+-- | Load data from cache if not loaded yet and wait
+getCache :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => (FilePath -> ErrorT String IO Structured) -> (Database -> Database) -> m Database
+getCache act check = do
+	dbval <- liftM check readDB
+	if nullDatabase dbval
+		then do
+			db <- loadCache act
+			waiter $ updater $ return db
+			return db
+		else
+			return dbval
+
 -- | Run one task
 runTask :: MonadIO m => String -> [Pair] -> ErrorT String (UpdateDB m) a -> ErrorT String (UpdateDB m) a
 runTask action params act = do
@@ -193,12 +233,9 @@ 
 -- | Scan modules
 scanModules :: (MonadIO m, MonadCatch m) => [String] -> [S.ModuleToScan] -> ErrorT String (UpdateDB m) ()
-scanModules opts ms = do
-	dbval <- readDB
-	ms' <- liftErrorT $ filterM (\m -> S.changedModule dbval (opts ++ snd m) (fst m)) ms
-	runTasks $
-		[scanProjectFile opts p >> return () | p <- ps] ++
-		[scanModule (opts ++ snd m) (fst m) | m <- ms']
+scanModules opts ms = runTasks $
+	[scanProjectFile opts p >> return () | p <- ps] ++
+	[scanModule (opts ++ snd m) (fst m) | m <- ms]
 	where
 		ps = nub $ mapMaybe (toProj . fst) ms
 		toProj (FileModule _ p) = fmap projectCabal p
@@ -208,11 +245,11 @@ scanFile :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
 scanFile opts fpath = do
 	dbval <- readDB
-	fpath' <- liftIO $ canonicalizePath fpath
+	fpath' <- liftEIO $ canonicalizePath fpath
 	mloc <- case lookupFile fpath' dbval of
 		Just m -> return $ moduleLocation m
 		Nothing -> do
-			mproj <- liftIO $ locateProject fpath'
+			mproj <- liftEIO $ locateProject fpath'
 			return $ FileModule fpath' mproj
 	dirty <- liftErrorT $ S.changedModule dbval opts mloc
 	let
@@ -223,31 +260,30 @@ -- | Scan cabal modules
 scanCabal :: (MonadIO m, MonadCatch m) => [String] -> Cabal -> ErrorT String (UpdateDB m) ()
 scanCabal opts cabalSandbox = runTask "scanning" (subject cabalSandbox ["sandbox" .= cabalSandbox]) $ do
-	loadCache $ Cache.loadCabal cabalSandbox
-	dbval <- readDB
-	ms <- runTask "loading modules" [] $
-		liftErrorT $ browseFilter opts cabalSandbox (S.changedModule dbval opts)
-	docs <- runTask "loading docs" [] $
-		liftErrorT $ hdocsCabal cabalSandbox opts
-	updater $ return $ mconcat $ map (fromModule . fmap (setDocs' docs)) ms
+	mlocs <- runTask "getting list of cabal modules" [] $ 
+		liftErrorT $ listModules opts cabalSandbox
+	scan (Cache.loadCabal cabalSandbox) (cabalDB cabalSandbox) (zip mlocs $ repeat []) opts $ \mlocs' -> do
+		ms <- runTask "loading modules" [] $
+			liftErrorT $ browseModules opts cabalSandbox (map fst mlocs')
+		docs <- runTask "loading docs" [] $
+			liftErrorT $ 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 $ moduleName m) docs
 
 -- | Scan project file
 scanProjectFile :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ErrorT String (UpdateDB m) Project
-scanProjectFile opts cabal = runTask "scanning" (subject cabal ["file" .= cabal]) $ do
-	proj <- liftErrorT $ S.scanProjectFile opts cabal
-	updater $ return $ fromProject proj
-	return proj
+scanProjectFile opts cabal = runTask "scanning" (subject cabal ["file" .= cabal]) $ liftErrorT $ S.scanProjectFile opts cabal
 
 -- | Scan project
 scanProject :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
 scanProject opts cabal = runTask "scanning" (subject (project cabal) ["project" .= cabal]) $ do
 	proj <- scanProjectFile opts cabal
-	loadCache $ Cache.loadProject $ projectCabal proj
 	(_, sources) <- liftErrorT $ S.enumProject proj
-	scanModules opts sources
+	scan (Cache.loadProject $ projectCabal proj) (projectDB proj) sources opts $ \ms -> do
+		scanModules opts ms
+		updater $ return $ fromProject proj
 
 -- | Scan directory for source files and projects
 scanDirectory :: (MonadIO m, MonadCatch m) => [String] -> FilePath -> ErrorT String (UpdateDB m) ()
@@ -256,8 +292,31 @@ 		liftErrorT $ S.enumDirectory dir
 	runTasks [scanProject opts (projectCabal p) | (p, _) <- projSrcs]
 	runTasks $ map (scanCabal opts) sboxes
-	loadCache $ Cache.loadFiles $ mapMaybe (moduleSource . fst) standSrcs
-	scanModules opts standSrcs
+	scan (Cache.loadFiles (dir `isParent`)) (filterDB inDir (const False) . standaloneDB) standSrcs opts $ scanModules opts
+	where
+		inDir = maybe False (dir `isParent`) . moduleSource . moduleIdLocation
+
+-- | Generic scan function. Reads cache only if data is not already loaded, removes obsolete modules and rescans changed modules.
+scan ::
+	(MonadIO m, MonadCatch m) =>
+	(FilePath -> ErrorT String IO Structured) ->
+	-- ^ Read data from cache
+	(Database -> Database) ->
+	-- ^ Get data from database
+	[S.ModuleToScan] ->
+	-- ^ Actual modules. Other modules will be removed from database
+	[String] ->
+	-- ^ Extra scan options
+	([S.ModuleToScan] -> ErrorT String (UpdateDB m) ()) ->
+	-- ^ Function to update changed modules
+	ErrorT String (UpdateDB m) ()
+scan cache' part' mlocs opts act = do
+	dbval <- getCache cache' part'
+	let
+		obsolete = filterDB (\m -> moduleIdLocation m `notElem` map fst mlocs) (const False) dbval
+	changed <- runTask "getting list of changed modules" [] $ liftErrorT $ S.changedModules dbval opts mlocs
+	runTask "removing obsolete modules" ["modules" .= map moduleLocation (allModules obsolete)] $ cleaner $ return obsolete
+	act changed
 
 -- | Lift errors
 liftErrorT :: MonadIO m => ErrorT String IO a -> ErrorT String m a

@@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances, ViewPatterns #-}  module HsDev.Inspect (-	analyzeModule,+	analyzeModule, inspectDocs, 	inspectContents, contentsInspection, 	inspectFile, fileInspection, 	projectDirs, projectSources,@@ -20,12 +20,12 @@ import Data.Maybe (fromMaybe, mapMaybe, catMaybes) import Data.Ord (comparing) import Data.String (fromString)+import qualified Data.Text as T (unpack) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Traversable (traverse, sequenceA) import qualified Data.Map as M import qualified Language.Haskell.Exts as H import qualified System.Directory as Dir-import System.IO import System.FilePath import Data.Generics.Uniplate.Data @@ -184,6 +184,16 @@ addDocs :: Map String String -> Module -> Module addDocs docsMap m = m { moduleDeclarations = map (addDoc docsMap) (moduleDeclarations m) } +-- | Extract file docs and set them to module declarations+inspectDocs :: [String] -> Module -> ErrorT String IO Module+inspectDocs opts m = do+	let+		hdocsWorkaround = True+	docsMap <- liftE $ if hdocsWorkaround+		then hdocsProcess (fromMaybe (T.unpack $ moduleName m) $ moduleSource $ moduleLocation m) opts+		else liftM Just $ hdocs (moduleLocation m) opts+	return $ maybe id addDocs docsMap $ m+ -- | Inspect contents inspectContents :: String -> [String] -> String -> ErrorT String IO InspectedModule inspectContents name opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do@@ -200,18 +210,17 @@ -- | Inspect file inspectFile :: [String] -> FilePath -> ErrorT String IO InspectedModule inspectFile opts file = do-	let-		hdocsWorkaround = False-	proj <- liftIO $ locateProject file-	absFilename <- liftIO $ Dir.canonicalizePath file+	proj <- liftE $ locateProject file+	absFilename <- liftE $ Dir.canonicalizePath file 	inspect (FileModule absFilename proj) (fileInspection absFilename opts) $ do-		docsMap <- liftIO $ if hdocsWorkaround-			then hdocsProcess absFilename opts-			else liftM Just $ hdocs (FileModule absFilename Nothing) opts+		-- docsMap <- liftE $ if hdocsWorkaround+		-- 	then hdocsProcess absFilename opts+		-- 	else liftM Just $ hdocs (FileModule absFilename Nothing) opts 		forced <- ErrorT $ E.handle onError $ do 			analyzed <- liftM (analyzeModule exts (Just absFilename)) $ readFileUtf8 absFilename 			force analyzed `deepseq` return analyzed-		return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced+		-- return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced+		return $ setLoc absFilename proj forced 	where 		setLoc f p m = m { moduleLocation = FileModule f p } 		onError :: E.ErrorCall -> IO (Either String Module)@@ -222,7 +231,7 @@ -- | File inspection data fileInspection :: FilePath -> [String] -> ErrorT String IO Inspection fileInspection f opts = do-	tm <- liftIO $ Dir.getModificationTime f+	tm <- liftE $ Dir.getModificationTime f 	return $ InspectionAt (utcTimeToPOSIXSeconds tm) $ sort $ nub opts  -- | Enumerate project dirs@@ -239,11 +248,11 @@ 		enumCabals = liftM (map takeDirectory . filter cabalFile) . traverseDirectory 		dirs' = map entity dirs 	-- enum inner projects and dont consider them as part of this project-	subProjs <- liftIO $ liftM (delete (projectPath p) . nub . concat) $ mapM (liftIO . enumCabals) dirs'+	subProjs <- liftM (delete (projectPath p) . nub . concat) $ triesMap (liftE . enumCabals) dirs' 	let 		enumHs = liftM (filter thisProjectSource) . traverseDirectory 		thisProjectSource h = haskellSource h && not (any (`isParent` h) subProjs)-	liftIO $ liftM (nub . concat) $ mapM (liftM sequenceA . traverse (liftIO . enumHs)) dirs+	liftM (nub . concat) $ triesMap (liftM sequenceA . traverse (liftE . enumHs)) dirs  -- | Inspect project inspectProject :: [String] -> Project -> ErrorT String IO (Project, [InspectedModule])@@ -254,10 +263,3 @@ 	return (p', catMaybes modules) 	where 		inspectFile' exts = liftM return (inspectFile (opts ++ extensionsOpts (extensions exts)) (entity exts)) <|> return Nothing---- | Read file in UTF8-readFileUtf8 :: FilePath -> IO String-readFileUtf8 f = withFile f ReadMode $ \h -> do-	hSetEncoding h utf8-	cts <- hGetContents h-	length cts `seq` return cts

@@ -5,22 +5,20 @@ 
 	-- * Scan
 	scanProjectFile,
-	scanModule, upToDate, rescanModule, changedModule, changedModules
+	scanModule, scanModify, upToDate, rescanModule, changedModule, changedModules
 	) where
 
-import Control.Applicative
+import Control.Applicative ((<|>))
 import Control.Monad.Error
 import qualified Data.Map as M
 import Data.Maybe (catMaybes)
 import Data.Traversable (traverse)
-import Language.Haskell.GhcMod (defaultOptions)
 import System.Directory
 
 import HsDev.Scan.Browse (browsePackages)
 import HsDev.Symbols
 import HsDev.Database
 import HsDev.Tools.GhcMod
-import HsDev.Tools.GhcMod.InferType (inferTypes)
 import HsDev.Inspect
 import HsDev.Project
 import HsDev.Util
@@ -48,7 +46,7 @@ enumProject :: Project -> ErrorT String IO ProjectToScan
 enumProject p = do
 	p' <- loadProject p
-	cabal <- liftIO $ searchSandbox (projectPath p')
+	cabal <- liftE $ searchSandbox (projectPath p')
 	pkgs <- liftM (map packageName) $ browsePackages [] cabal
 	let
 		projOpts :: FilePath -> [String]
@@ -68,9 +66,9 @@ 	let
 		projects = filter cabalFile cts
 		sources = filter haskellSource cts
-	dirs <- liftIO $ filterM doesDirectoryExist cts
-	sboxes <- liftIO $ liftM catMaybes $ mapM findPackageDb dirs
-	projs <- mapM (enumProject . project) projects
+	dirs <- liftE $ filterM doesDirectoryExist cts
+	sboxes <- liftM catMaybes $ triesMap (liftE . findPackageDb) dirs
+	projs <- triesMap (enumProject . project) projects
 	let
 		projPaths = map (projectPath . fst) projs
 		standalone = map (\f -> FileModule f Nothing) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
@@ -82,18 +80,25 @@ -- | Scan project file
 scanProjectFile :: [String] -> FilePath -> ErrorT String IO Project
 scanProjectFile _ f = do
-	proj <- (liftIO $ locateProject f) >>= maybe (throwError "Can't locate project") return
+	proj <- (liftE $ locateProject f) >>= maybe (throwError "Can't locate project") return
 	loadProject proj
 
 -- | Scan module
 scanModule :: [String] -> ModuleLocation -> ErrorT String IO InspectedModule
-scanModule opts (FileModule f _) = inspectFile opts f >>= traverse infer' where
-	infer' m = tryInfer <|> return m where
-		tryInfer = mapErrorT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $
-			runGhcMod defaultOptions $ inferTypes opts Cabal m
+scanModule opts (FileModule f _) = inspectFile opts f
+-- scanModule opts (FileModule f _) = inspectFile opts f >>= traverse infer' where
+-- 	infer' m = tryInfer <|> return m where
+-- 		tryInfer = mapErrorT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $
+-- 			runGhcMod defaultOptions $ inferTypes opts Cabal m
 scanModule opts (CabalModule c p n) = browse opts c n p
 scanModule _ (ModuleSource _) = throwError "Can inspect only modules in file or cabal"
 
+-- | Scan additional info and modify scanned module. Dones't fail on error, just left module unchanged
+scanModify :: ([String] -> Cabal -> Module -> ErrorT String IO Module) -> InspectedModule -> ErrorT String IO InspectedModule
+scanModify f im = traverse f' im <|> return im where
+	-- TODO: Get actual sandbox
+	f' = f (inspectionOpts $ inspection im) Cabal
+
 -- | Is inspected module up to date?
 upToDate :: [String] -> InspectedModule -> ErrorT String IO Bool
 upToDate opts (Inspected insp m _) = case m of
@@ -115,5 +120,5 @@ 	m' = M.lookup m (databaseModules db)
 
 -- | Returns new (to scan) and changed (to rescan) modules
-changedModules :: Database -> [String] -> [ModuleLocation] -> ErrorT String IO [ModuleLocation]
-changedModules db opts ms = filterM (changedModule db opts) ms
+changedModules :: Database -> [String] -> [ModuleToScan] -> ErrorT String IO [ModuleToScan]
+changedModules db opts ms = filterM (\(m, opts') -> changedModule db (opts ++ opts') m) ms

@@ -2,7 +2,7 @@ 	-- * List all packages
 	browsePackages,
 	-- * Scan cabal modules
-	browseFilter, browse
+	listModules, browseModules, browse
 	) where
 
 import Control.Monad.Error
@@ -14,6 +14,7 @@ import HsDev.Cabal
 import HsDev.Symbols
 import HsDev.Tools.Base (inspect)
+import HsDev.Util (liftIOErrors)
 
 import qualified ConLike as GHC
 import qualified DataCon as GHC
@@ -33,25 +34,25 @@ 
 -- | Browse packages
 browsePackages :: [String] -> Cabal -> ErrorT String IO [ModulePackage]
-browsePackages opts cabal = withPackages (cabalOpt cabal ++ opts) $ \dflags -> do
+browsePackages opts cabal = liftIOErrors $ withPackages (cabalOpt cabal ++ opts) $ \dflags -> do
 	return $ mapMaybe (readPackage . GHC.packageConfigId) $ fromMaybe [] $ GHC.pkgDatabase dflags
 
--- | Browse modules
-browseFilter :: [String] -> Cabal -> (ModuleLocation -> ErrorT String IO Bool) -> ErrorT String IO [InspectedModule]
-browseFilter opts cabal f = withPackages_ (cabalOpt cabal ++ opts) $ do
+listModules :: [String] -> Cabal -> ErrorT String IO [ModuleLocation]
+listModules opts cabal = liftIOErrors $ withPackages_ (cabalOpt cabal ++ opts) $ do
 	ms <- lift $ GHC.packageDbModules False
-	ms' <- filterM (mapErrorT GHC.liftIO . f . loc) ms
-	liftM catMaybes $ mapM browseModule' ms'
-	where
-		loc :: GHC.Module -> ModuleLocation
-		loc m = CabalModule cabal (readPackage $ GHC.modulePackageId m) (GHC.moduleNameString $ GHC.moduleName m)
+	return $ map (ghcModuleLocation cabal) ms
 
+browseModules :: [String] -> Cabal -> [ModuleLocation] -> ErrorT String IO [InspectedModule]
+browseModules opts cabal mlocs = liftIOErrors $ withPackages_ (cabalOpt cabal ++ opts) $ do
+	ms <- lift $ GHC.packageDbModules False
+	liftM catMaybes $ mapM browseModule' [m | m <- ms, ghcModuleLocation cabal m `elem` mlocs]
+	where
 		browseModule' :: GHC.Module -> ErrorT String GHC.Ghc (Maybe InspectedModule)
-		browseModule' m = tryT $ inspect (loc m) (return $ InspectionAt 0 opts) (browseModule cabal m)
+		browseModule' m = tryT $ inspect (ghcModuleLocation cabal m) (return $ InspectionAt 0 opts) (browseModule cabal m)
 
 -- | Browse all modules
 browse :: [String] -> Cabal -> ErrorT String IO [InspectedModule]
-browse opts cabal = browseFilter opts cabal (const $ return True)
+browse opts cabal = listModules opts cabal >>= browseModules opts cabal
 
 browseModule :: Cabal -> GHC.Module -> ErrorT String GHC.Ghc Module
 browseModule cabal m = do
@@ -142,3 +143,6 @@ 
 readPackage :: GHC.PackageId -> Maybe ModulePackage
 readPackage = readMaybe . GHC.packageIdString
+
+ghcModuleLocation :: Cabal -> GHC.Module -> ModuleLocation
+ghcModuleLocation cabal m = CabalModule cabal (readPackage $ GHC.modulePackageId m) (GHC.moduleNameString $ GHC.moduleName m)

@@ -25,7 +25,6 @@ import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Either (isLeft)
-import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid
@@ -248,7 +247,7 @@ clientOpts = [
 	req "port" "number" `desc` "connection port",
 	flag "pretty" `desc` "pretty json output",
-	req "stdin" "data" `desc` "pass data to stdin",
+	flag "stdin" `desc` "pass data to stdin",
 	req "timeout" "msec" `desc` "overwrite timeout duration",
 	flag "silent" `desc` "supress notifications"]
 
@@ -283,15 +282,15 @@ 			| otherwise = encode
 		sendReceive = do
 			curDir <- getCurrentDirectory
-			stdinData <- if flagSet "data" copts
-				then do
-					cdata <- liftM (eitherDecode :: L.ByteString -> Either String Value) L.getContents
-					case cdata of
-						Left cdataErr -> do
-							putStrLn $ "Invalid data: " ++ cdataErr
-							exitFailure
-						Right dataValue -> return $ Just dataValue
-				else return Nothing
+			input <- if flagSet "stdin" copts
+				then liftM Just L.getContents
+				else return $ fmap toUtf8 $ arg "data" copts
+			let
+				parseData :: L.ByteString -> IO Value
+				parseData cts = case eitherDecode cts of
+					Left err -> putStrLn ("Invalid data: " ++ err) >> exitFailure
+					Right v -> return v
+			dat <- traverse parseData input
 
 			s <- socket AF_INET Stream defaultProtocol
 			addr' <- inet_addr "127.0.0.1"
@@ -299,7 +298,7 @@ 			bracket (socketToHandle s ReadWriteMode) hClose $ \h -> do
 				L.hPutStrLn h $ encode $ Message Nothing $ reqCall `M.withOpts` [
 					"current-directory" %-- curDir,
-					"data" %-? (fromUtf8 . encode <$> stdinData),
+					"data" %-? (fromUtf8 . encode <$> dat),
 					"timeout" %-? (iarg "timeout" copts :: Maybe Integer),
 					if flagSet "silent" copts then hoist "silent" else mempty]
 				hFlush h

@@ -547,6 +547,9 @@ 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

@@ -91,7 +91,7 @@ 
 instance Show ModuleLocation where
 	show (FileModule f p) = f ++ maybe "" (" in " ++) (fmap projectPath p)
-	show (CabalModule c p _) = show c ++ maybe "" (" in package " ++) (fmap show p)
+	show (CabalModule _ p n) = n ++ maybe "" (" in package " ++) (fmap show p)
 	show (ModuleSource m) = fromMaybe "" m
 
 instance ToJSON ModuleLocation where

@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module HsDev.Tools.AutoFix (
+	Correction(..),
+	correct, corrections,
+	autoFix_, autoFix, updateRegion,
+	CorrectorMatch,
+	correctors,
+	match,
+	findCorrector,
+
+	Canonicalize(..),
+
+	module Data.Mark
+	) where
+
+import Control.Applicative
+import Data.Aeson
+import Data.Maybe (listToMaybe, mapMaybe)
+
+import Data.Mark hiding (at, Editable(..))
+import HsDev.Symbols (Canonicalize(..))
+import HsDev.Symbols.Location (Location(..), Position(..), moduleSource)
+import HsDev.Tools.Base (matchRx, at)
+import HsDev.Tools.GhcMod
+import HsDev.Util ((.::))
+
+data Correction = Correction {
+	correctionFile :: FilePath,
+	correctionType :: String,
+	description :: String,
+	message :: String,
+	solution :: String,
+	corrector :: [Replace String] }
+		deriving (Eq, Read, Show)
+
+instance Canonicalize Correction where
+	canonicalize c = do
+		f' <- canonicalize (correctionFile c)
+		return c { correctionFile = f' }
+
+instance ToJSON Correction where
+	toJSON (Correction f t desc msg sol cor) = object [
+		"file" .= f,
+		"type" .= t,
+		"description" .= desc,
+		"message" .= msg,
+		"solution" .= sol,
+		"corrector" .= cor]
+
+instance FromJSON Correction where
+	parseJSON = withObject "correction" $ \v -> Correction <$>
+		v .:: "file" <*>
+		v .:: "type" <*>
+		v .:: "description" <*>
+		v .:: "message" <*>
+		v .:: "solution" <*>
+		v .:: "corrector"
+
+correct :: Correction -> EditM String ()
+correct = run . corrector
+
+corrections :: [OutputMessage] -> [Correction]
+corrections = mapMaybe toCorrection where
+	toCorrection :: OutputMessage -> Maybe Correction
+	toCorrection msg = do
+		file <- moduleSource $ locationModule (errorLocation msg)
+		Position l c <- locationPosition (errorLocation msg)
+		let
+			pt = Point (pred l) (pred c)
+		findCorrector file pt (errorMessage msg)
+
+-- | 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 updateRegion up'
+
+updateRegion :: Correction -> EditM String Correction
+updateRegion corr = do
+	c' <- sequence [Replace <$> mapRegion r <*> pure cts | Replace r cts <- corrector corr]
+	return $ corr { corrector = c' }
+
+type CorrectorMatch = FilePath -> Point -> String -> Maybe Correction
+
+correctors :: [CorrectorMatch]
+correctors = [
+	match "^The import of `([\\w\\.]+)' is redundant" $ \g file pt -> Correction file
+		"Redundant import"
+		("Redundant import: " ++ (g `at` 1)) ""
+		"Remove import"
+		[eraser (pt `regionSize` linesSize 1)],
+	match "Found:\n  (.*?)\nWhy not:\n  (.*?)$" $ \g file pt -> Correction file
+		"Why not?"
+		("Replace '" ++ (g `at` 1) ++ "' with '" ++ (g `at` 2) ++ "'") ""
+		"Replace with suggestion"
+		[replacer (pt `regionSize` stringSize (length $ g `at` 1)) (g `at` 2)]]
+
+match :: String -> ((Int -> Maybe String) -> FilePath -> Point -> Correction) -> CorrectorMatch
+match pat f file pt str = do
+	g <- matchRx pat str
+	return (f g file pt) { correctionFile = file, message = str }
+
+findCorrector :: FilePath -> Point -> String -> Maybe Correction
+findCorrector file pt msg = listToMaybe $ mapMaybe (\corr -> corr file pt msg) correctors

@@ -18,20 +18,22 @@ import GHC
 import GHC.Paths (libdir)
 
+import HsDev.Util
+
 -- | Dump minimal imports
 dumpMinimalImports :: [String] -> FilePath -> ErrorT String IO String
 dumpMinimalImports opts f = do
-	cur <- liftIO getCurrentDirectory
-	file <- liftIO $ canonicalizePath f
+	cur <- liftE getCurrentDirectory
+	file <- liftE $ canonicalizePath f
 
-	m <- liftIO $ Exts.parseFile file
+	m <- liftE $ Exts.parseFile file
 	mname <- case m of
 		Exts.ParseFailed loc err -> throwError $
 			"Failed to parse file at " ++
 			Exts.prettyPrint loc ++ ":" ++ err
 		Exts.ParseOk (Exts.Module _ (Exts.ModuleName mname) _ _ _ _ _) -> return mname
 
-	ErrorT $ handle onError $ liftM Right $ void $ liftIO $ runGhc (Just libdir) $ do
+	void $ liftE $ runGhc (Just libdir) $ do
 		df <- getSessionDynFlags
 		let
 			df' = df {
@@ -49,9 +51,6 @@ 			load LoadAllTargets
 
 	length mname `seq` return mname
-	where
-		onError :: SomeException -> IO (Either String ())
-		onError = return . Left . show
 
 -- | Read imports from file
 waitImports :: FilePath -> IO [String]
@@ -63,19 +62,19 @@ cleanTmpImports :: FilePath -> IO ()
 cleanTmpImports dir = do
 	dumps <- liftM (map (dir </>) . filter ((== ".imports") . takeExtension)) $ getDirectoryContents dir
-	forM_ dumps $ handle ignoreIO . retry 1000 . removeFile
+	forM_ dumps $ handle ignoreIO' . retry 1000 . removeFile
 	where
-		ignoreIO :: IOException -> IO ()
-		ignoreIO _ = return ()
+		ignoreIO' :: IOException -> IO ()
+		ignoreIO' _ = return ()
 
 -- | Dump and read imports
 findMinimalImports :: [String] -> FilePath -> ErrorT String IO [String]
 findMinimalImports opts f = do
-	file <- liftIO $ canonicalizePath f
+	file <- liftE $ canonicalizePath f
 	mname <- dumpMinimalImports opts file
-	is <- liftIO $ waitImports (mname <.> "imports")
-	tmp <- liftIO getCurrentDirectory
-	liftIO $ cleanTmpImports tmp
+	is <- liftE $ waitImports (mname <.> "imports")
+	tmp <- liftE getCurrentDirectory
+	liftE $ cleanTmpImports tmp
 	return is
 
 -- | Groups several lines related to one import by indents
@@ -87,7 +86,6 @@ -- | Split import to import and import-list
 splitImport :: [String] -> (String, String)
 splitImport = splitBraces . unwords . map trim where
-	trim = twice $ reverse . dropWhile isSpace
 	cut = twice $ reverse . drop 1
 	twice f = f . f
 	splitBraces = (trim *** (trim . cut)) . break (== '(')

@@ -20,7 +20,7 @@ import Control.Concurrent.Worker
 
 ghcWorker :: IO (Worker Ghc)
-ghcWorker = startWorker (runGhc (Just libdir)) ghcInit where
+ghcWorker = startWorker (runGhc (Just libdir)) ghcInit id where
 	ghcInit f = do
 		fs <- getSessionDynFlags
 		defaultCleanupHandler fs $ do

@@ -9,6 +9,7 @@ 	TypedRegion(..),
 	typeOf,
 	OutputMessage(..),
+	parseOutputMessages, parseOutputMessage,
 	check,
 	lint,
 
@@ -53,7 +54,7 @@ import HsDev.Project
 import HsDev.Symbols
 import HsDev.Tools.Base
-import HsDev.Util ((.::), liftIOErrors, withCurrentDirectory)
+import HsDev.Util ((.::), liftIOErrors, liftThrow, withCurrentDirectory, readFileUtf8)
 
 list :: [String] -> Cabal -> ErrorT String IO [ModuleLocation]
 list opts cabal = runGhcMod (GhcMod.defaultOptions { GhcMod.ghcUserOptions = opts }) $ do
@@ -109,7 +110,7 @@ 
 info :: [String] -> Cabal -> FilePath -> String -> GhcModT IO Declaration
 info opts cabal file sname = do
-	fileCts <- liftIO $ readFile file
+	fileCts <- liftIO $ readFileUtf8 file
 	rs <- withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $
 		liftM nullToNL $ GhcMod.info file sname
 	toDecl fileCts rs
@@ -170,7 +171,7 @@ 
 typeOf :: [String] -> Cabal -> FilePath -> Int -> Int -> GhcModT IO [TypedRegion]
 typeOf opts cabal file line col = withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
-	fileCts <- liftIO $ readFile file
+	fileCts <- liftIO $ readFileUtf8 file
 	ts <- lines <$> GhcMod.types file line col
 	return $ mapMaybe (toRegionType fileCts) ts
 	where
@@ -220,6 +221,9 @@ 		v .:: "level" <*>
 		v .:: "message"
 
+parseOutputMessages :: String -> [OutputMessage]
+parseOutputMessages = mapMaybe parseOutputMessage . lines
+
 parseOutputMessage :: String -> Maybe OutputMessage
 parseOutputMessage s = do
 	groups <- matchRx "^(.+):(\\d+):(\\d+):(\\s*(Warning|Error):)?\\s*(.*)$" s
@@ -230,6 +234,17 @@ 		errorLevel = if groups 5 == Just "Warning" then WarningMessage else ErrorMessage,
 		errorMessage = nullToNL (groups `at` 6) }
 
+recalcOutputMessageTabs :: [(FilePath, String)] -> OutputMessage -> OutputMessage
+recalcOutputMessageTabs fileCts msg = msg {
+	errorLocation = recalc' (errorLocation msg) }
+	where
+		recalc' :: Location -> Location
+		recalc' loc = fromMaybe loc $ do
+			pos <- locationPosition loc
+			src <- moduleSource (locationModule loc)
+			cts <- lookup src fileCts
+			return loc { locationPosition = Just (recalcTabs cts pos) }
+
 -- | Replace NULL with newline
 nullToNL :: String -> String
 nullToNL = map $ \case
@@ -237,14 +252,18 @@ 	ch -> ch
 
 check :: [String] -> Cabal -> [FilePath] -> Maybe Project -> GhcModT IO [OutputMessage]
-check opts cabal files _ = withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
-	msgs <- lines <$> GhcMod.checkSyntax files
-	return $ mapMaybe parseOutputMessage msgs
+check opts cabal files _ = do
+	cts <- liftIO $ mapM readFileUtf8 files
+	withOptions (\o -> o { GhcMod.ghcUserOptions = cabalOpt cabal ++ opts }) $ do
+		res <- GhcMod.checkSyntax files
+		return $ map (recalcOutputMessageTabs (zip files cts)) $ parseOutputMessages res
 
 lint :: [String] -> FilePath -> GhcModT IO [OutputMessage]
-lint opts file = withOptions (\o -> o { GhcMod.hlintOpts = opts }) $ do
-	msgs <- lines <$> GhcMod.lint file
-	return $ mapMaybe parseOutputMessage msgs
+lint opts file = do
+	cts <- liftIO $ readFileUtf8 file
+	withOptions (\o -> o { GhcMod.hlintOpts = opts }) $ do
+		res <- GhcMod.lint file
+		return $ map (recalcOutputMessageTabs [(file, cts)]) $ parseOutputMessages res
 
 runGhcMod :: (GhcMod.IOish m, MonadCatch m) => GhcMod.Options -> GhcModT m a -> ErrorT String m a
 runGhcMod opts act = liftIOErrors $ ErrorT $ liftM (left show . fst) $ runGhcModT opts act
@@ -261,7 +280,7 @@ ghcModWorker :: Either Project Cabal -> IO (Worker (GhcModT IO))
 ghcModWorker p = do
 	home <- getHomeDirectory
-	startWorker (runGhcModT'' $ ghcModEnvPath home p) id
+	startWorker (runGhcModT'' $ ghcModEnvPath home p) id liftThrow
 	where
 		makeEnv :: FilePath -> IO GhcMod.GhcModEnv
 		makeEnv = GhcMod.newGhcModEnv GhcMod.defaultOptions
@@ -283,7 +302,7 @@ 
 -- | Manage many ghc-mod workers for each project/sandbox
 ghcModMultiWorker :: IO (Worker (ReaderT WorkerMap IO))
-ghcModMultiWorker = newMVar M.empty >>= \m -> startWorker (`runReaderT` m) id
+ghcModMultiWorker = newMVar M.empty >>= \m -> startWorker (`runReaderT` m) id id
 
 instance MonadThrow (GhcModT IO) where
 	throwM = lift . throwM

@@ -1,6 +1,7 @@ module HsDev.Tools.GhcMod.InferType (
 	untyped, inferType, inferTypes,
-	GhcModT
+	GhcModT,
+	infer
 	) where
 
 import Control.Applicative
@@ -9,10 +10,12 @@ import Data.String (fromString)
 import qualified Data.Text as T (unpack)
 import Data.Traversable (traverse)
+import qualified Language.Haskell.GhcMod as GhcMod
 
 import HsDev.Cabal
 import HsDev.Symbols
 import HsDev.Tools.GhcMod
+import HsDev.Util (withCurrentDirectory)
 
 -- | Is declaration untyped
 untyped :: DeclarationInfo -> Bool
@@ -22,10 +25,10 @@ -- | Infer type of declaration
 inferType :: [String] -> Cabal -> FilePath -> Declaration -> GhcModT IO Declaration
 inferType opts cabal src decl'
-	| untyped (declaration decl') = infer
+	| untyped (declaration decl') = doInfer
 	| otherwise = return decl'
 	where
-		infer = do
+		doInfer = do
 			inferred <- ((getType . declaration) <$> byInfo) <|> byTypeOf
 			return decl' {
 				declaration = setType (declaration decl') inferred }
@@ -50,4 +53,11 @@ 		inferredDecls <- traverse (\d -> inferType opts cabal src d <|> return d) $
 			moduleDeclarations m
 		return m { moduleDeclarations = inferredDecls }
+	_ -> throwError $ strMsg "Type infer works only for source files"
+
+-- | Infer type in module
+infer :: [String] -> Cabal -> Module -> ErrorT String IO Module
+infer opts cabal m = case moduleLocation m of
+	FileModule src _ -> mapErrorT (withCurrentDirectory (sourceModuleRoot (moduleName m) src)) $
+		runGhcMod GhcMod.defaultOptions $ inferTypes opts cabal m
 	_ -> throwError $ strMsg "Type infer works only for source files"

@@ -10,10 +10,11 @@ 	-- * Helper
 	(.::), (.::?), objectUnion,
 	-- * Exceptions
-	liftException, liftExceptionM, liftIOErrors,
+	liftException, liftE, liftEIO, tries, triesMap, liftExceptionM, liftIOErrors,
 	eitherT,
+	liftThrow,
 	-- * UTF-8
-	fromUtf8, toUtf8,
+	fromUtf8, toUtf8, readFileUtf8, writeFileUtf8,
 	-- * IO
 	hGetLineBS, logException, logIO, ignoreIO,
 	-- * Task
@@ -30,6 +31,7 @@ import Data.Aeson.Types (Parser)
 import Data.Char (isSpace)
 import Data.List (isPrefixOf, unfoldr)
+import Data.Maybe (catMaybes)
 import qualified Data.HashMap.Strict as HM (HashMap, toList, union)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Lazy (ByteString)
@@ -40,7 +42,7 @@ import Data.Traversable (traverse)
 import System.Directory
 import System.FilePath
-import System.IO (Handle)
+import System.IO
 
 import Control.Concurrent.Task
 
@@ -132,6 +134,21 @@ liftException :: C.MonadCatch m => m a -> ErrorT String m a
 liftException = ErrorT . liftM (left $ \(SomeException e) -> show e) . C.try
 
+-- | Same as @liftException@
+liftE :: C.MonadCatch m => m a -> ErrorT String m a
+liftE = liftException
+
+-- | @liftE@ for IO
+liftEIO :: (C.MonadCatch m, MonadIO m) => IO a -> ErrorT String m a
+liftEIO = liftE . liftIO
+
+-- | Run actions ignoring errors
+tries :: MonadPlus m => [m a] -> m [a]
+tries acts = liftM catMaybes $ sequence [liftM Just act `mplus` return Nothing | act <- acts]
+
+triesMap :: MonadPlus m => (a -> m b) -> [a] -> m [b]
+triesMap f = tries . map f
+
 -- | Lift IO exception to MonadError
 liftExceptionM :: (C.MonadCatch m, Error e, MonadError e m) => m a -> m a
 liftExceptionM act = C.catch act onError where
@@ -144,12 +161,28 @@ eitherT :: (Monad m, Error e, MonadError e m) => Either String a -> m a
 eitherT = either (throwError . strMsg) return
 
+-- | Throw error as exception
+liftThrow :: (Show e, Error e, MonadError e m, C.MonadCatch m) => m a -> m a
+liftThrow act = catchError act (C.throwM . userError . show)
+
 fromUtf8 :: ByteString -> String
 fromUtf8 = T.unpack . T.decodeUtf8
 
 toUtf8 :: String -> ByteString
 toUtf8 = T.encodeUtf8 . T.pack
 
+-- | Read file in UTF8
+readFileUtf8 :: FilePath -> IO String
+readFileUtf8 f = withFile f ReadMode $ \h -> do
+	hSetEncoding h utf8
+	cts <- hGetContents h
+	length cts `seq` return cts
+
+writeFileUtf8 :: FilePath -> String -> IO ()
+writeFileUtf8 f cts = withFile f WriteMode $ \h -> do
+	hSetEncoding h utf8
+	hPutStr h cts
+
 hGetLineBS :: Handle -> IO ByteString
 hGetLineBS = fmap L.fromStrict . B.hGetLine
 
@@ -166,5 +199,5 @@ ignoreIO :: IO () -> IO ()
 ignoreIO = handle (const (return ()) :: IOException -> IO ())
 
-liftTask :: MonadIO m => IO (Task a) -> ErrorT String m a
-liftTask = ErrorT . liftM (left (\(SomeException e) -> show e)) . liftIO . join . liftM taskWait
+liftTask :: (C.MonadThrow m, C.MonadCatch m, MonadIO m) => IO (Task a) -> ErrorT String m a
+liftTask = liftExceptionM . ErrorT . liftIO . liftM (left show) . join . liftM taskWait

@@ -2,7 +2,7 @@ 
 module Tool (
 	-- * Tool
-	toolMain, usage,
+	ToolM, toolMain, usage,
 	-- * Json command
 	jsonCmd, jsonCmd_,
 	-- * Errors

@@ -0,0 +1,60 @@+module Main (
+	main
+	) where
+
+import Control.Arrow ((***))
+import Control.Monad (liftM)
+import Data.Aeson
+import Data.List (partition, nub, sort)
+import Data.Maybe (mapMaybe)
+import System.Directory (canonicalizePath)
+import Text.Read (readMaybe)
+
+import HsDev.Tools.AutoFix
+import HsDev.Tools.GhcMod (parseOutputMessages)
+import HsDev.Util (toUtf8, liftE, readFileUtf8, writeFileUtf8)
+
+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"
+
+		show' :: Args -> ToolM [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
+
+		fix' :: Args -> ToolM [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 $ nub $ sort $ map (correctionFile) fixCorrs
+			let
+				doFix file = autoFix
+					(filter ((== file) . correctionFile) fixCorrs)
+					(filter ((== file) . correctionFile) 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"

@@ -5,16 +5,17 @@ 	) where
 
 import Control.Applicative
-import Control.Monad (liftM)
+import Control.Monad (liftM, (>=>))
 import Control.Monad.IO.Class
 import Data.Aeson (toJSON)
 import System.Directory (canonicalizePath)
 import System.FilePath (takeExtension)
 
 import HsDev.Project (readProject)
-import HsDev.Scan (scanModule)
-import HsDev.Inspect (inspectContents)
+import HsDev.Scan (scanModule, scanModify)
+import HsDev.Inspect (inspectContents, inspectDocs)
 import HsDev.Symbols.Location (ModuleLocation(..), Cabal(..))
+import HsDev.Tools.GhcMod.InferType (infer)
 
 import Tool
 
@@ -28,7 +29,12 @@ 		inspect' (Args [] opts) = liftIO getContents >>= liftM toJSON . inspectContents "stdin" (ghcs opts)
 		inspect' (Args [fname@(takeExtension -> ".hs")] opts) = do
 			fname' <- liftIO $ canonicalizePath fname
-			toJSON <$> scanModule (ghcs opts) (FileModule fname' Nothing)
+			im <- scanModule (ghcs opts) (FileModule fname' Nothing)
+			let
+				scanAdditional =
+					scanModify (\opts cabal -> inspectDocs opts) >=>
+					scanModify infer
+			toJSON <$> scanAdditional im
 		inspect' (Args [fcabal@(takeExtension -> ".cabal")] _) = do
 			fcabal' <- liftIO $ canonicalizePath fcabal
 			toJSON <$> readProject fcabal'