packages feed

hsdev 0.1.4.1 → 0.1.4.2

raw patch · 19 files changed

+427/−75 lines, 19 filesdep +ghc-syb-utilsdep +sybdep −system-filepathdep ~fsnotifydep ~hdocsdep ~simple-log

Dependencies added: ghc-syb-utils, syb

Dependencies removed: system-filepath

Dependency ranges changed: fsnotify, hdocs, simple-log

Files

hsdev.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.4.1
+version:             0.1.4.2
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -62,6 +62,7 @@     HsDev.Tools.ClearImports
     HsDev.Tools.Ghc.Check
     HsDev.Tools.Ghc.Prelude
+    HsDev.Tools.Ghc.Types
     HsDev.Tools.Ghc.Worker
     HsDev.Tools.GhcMod
     HsDev.Tools.GhcMod.InferType
@@ -103,13 +104,14 @@     directory >= 1.2.0,
     exceptions >= 0.6.0,
     filepath >= 1.4.0,
-    fsnotify >= 0.1.0,
+    fsnotify >= 0.2.1,
     ghc >= 7.10.0 && < 7.11.0,
     ghc-mod >= 5.2.1.3,
     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.3,
+    hdocs >= 0.4.4,
     hlint >= 1.9.0 && < 2.0.0,
     HTTP >= 4000.2.0,
     lens >= 4.8,
@@ -123,7 +125,7 @@     regex-pcre-builtin >= 0.94,
     scientific >= 0.3,
     simple-log >= 0.3.2,
-    system-filepath >= 0.4,
+    syb >= 0.5.1,
     template-haskell,
     text >= 1.2.0,
     time >= 1.5.0,
src/Control/Concurrent/Task.hs view
@@ -3,7 +3,7 @@ module Control.Concurrent.Task (
 	Task(..), TaskException(..), TaskResult(..),
 	taskStarted, taskRunning, taskStopped, taskDone, taskFailed, taskCancelled,
-	taskWaitStart, taskWait, taskJoin, taskKill, taskCancel, taskStop,
+	taskWaitStart, taskWait, taskJoinWith, taskJoin, taskJoin_, taskKill, taskCancel, taskStop,
 	runTask, runTask_, runTaskTry, runTaskError, forkTask, tryT,
 
 	-- * Reexports
@@ -72,9 +72,17 @@ 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 = taskWait >=> either throwM return
+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 ()
src/Control/Concurrent/Worker.hs view
@@ -5,6 +5,7 @@ 	startWorker,
 	sendTask, pushTask,
 	stopWorker, syncTask,
+	inWorkerWith, inWorker, inWorker_,
 
 	module Control.Concurrent.Task
 	) where
@@ -58,3 +59,15 @@ -- | Send empty task and wait until worker run it
 syncTask :: (MonadCatch m, MonadIO m) => Worker m -> IO ()
 syncTask w = pushTask w (return ()) >>= void . taskWait
+
+-- | 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
+
+-- | 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
+
+-- | 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_
src/HsDev/Client/Commands.hs view
@@ -36,6 +36,7 @@ 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
@@ -62,6 +63,18 @@ 		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"]
+		"infer types for specified modules"
+		infer',
 	cmdList' "remove" [] (sandboxes ++ [
 		projectArg `desc` "module project",
 		fileArg `desc` "module source file",
@@ -124,9 +137,10 @@ 	-- Tool commands
 	cmdList' "hayoo" ["query"] hayooArgs "find declarations online via Hayoo" hayoo',
 	cmdList' "cabal list" ["packages..."] [] "list cabal packages" cabalList',
-	cmdList' "lint" ["files..."] [] "lint source files" lint',
-	cmdList' "check" ["files..."] [sandboxArg, ghcOpts] "check source files" check',
-	cmdList' "check-lint" ["files..."] [sandboxArg, ghcOpts] "check and lint source files" checkLint',
+	cmdList' "lint" ["files..."] [dataArg] "lint source files or file contents" lint',
+	cmdList' "check" ["files..."] [dataArg, sandboxArg, ghcOpts] "check source files or file contents" check',
+	cmdList' "check-lint" ["files..."] [dataArg, sandboxArg, ghcOpts] "check and lint source files or file contents" checkLint',
+	cmdList' "types" ["file"] [dataArg, sandboxArg, ghcOpts] "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',
@@ -269,6 +283,34 @@ 					("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
+			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
@@ -489,28 +531,79 @@ 
 		-- | HLint
 		lint' :: [String] -> Opts String -> CommandActionT [Tools.Note Tools.OutputMessage]
-		lint' files _ copts = do
-			files' <- mapM (findPath copts) files
-			mapCommandErrorStr $ liftM concat $ mapM HLint.hlint files'
+		lint' files as copts = case arg "data" as of
+			Nothing -> do
+				files' <- mapM (findPath 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 = do
-			files' <- mapM (findPath copts) files
-			db <- getDb copts
-			cabal <- getCabal copts as
-			liftM concat $ forM files' $ \file' -> do
+		check' files as copts = case arg "data" as of
+			Nothing -> do
+				files' <- mapM (findPath 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, maybe you forgot to scan it?")
+					(commandError_ $ "File '" ++ file' ++ "' not found")
 					return $
 					lookupFile file' db
-				notes <- mapCommandErrorStr $ liftTask $
-					pushTask (commandGhc copts) (runExceptT $ Check.check (listArg "ghc" as) cabal m)
+				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
+			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]
src/HsDev/Commands.hs view
@@ -38,7 +38,7 @@ import HsDev.Symbols.Resolve
 import HsDev.Symbols.Types
 import HsDev.Symbols.Util
-import HsDev.Tools.Base (matchRx, at)
+import HsDev.Tools.Base (matchRx, at_)
 import HsDev.Util (liftE, ordNub)
 
 -- | Find declaration by name
@@ -159,7 +159,7 @@ splitIdentifier :: String -> (Maybe String, String)
 splitIdentifier name = fromMaybe (Nothing, name) $ do
 	groups <- matchRx "(([A-Z][\\w']*\\.)*)(.*)" name
-	return (fmap dropDot $ groups 1, groups `at` 3)
+	return (fmap dropDot $ groups 1, groups `at_` 3)
 	where
 		dropDot :: String -> String
 		dropDot "" = ""
src/HsDev/Database/Update.hs view
@@ -12,6 +12,7 @@ 	readDB,
 
 	scanModule, scanModules, scanFile, scanCabal, scanProjectFile, scanProject, scanDirectory,
+	scanDocs, inferModTypes,
 	scan,
 	updateEvent, processEvent,
 
@@ -42,13 +43,15 @@ import qualified System.Log.Simple as Log
 import qualified System.Log.Simple.Base as Log (scopeLog)
 
+import Control.Concurrent.Worker (inWorker)
 import qualified HsDev.Cache.Structured as Cache
 import HsDev.Database
 import HsDev.Database.Async hiding (Event)
 import HsDev.Display
-import HsDev.Inspect (inspectDocs)
+import HsDev.Inspect (inspectDocs, inspectDocsGhc)
 import HsDev.Project
 import HsDev.Symbols
+import HsDev.Tools.Ghc.Worker (ghcWorker)
 import HsDev.Tools.HDocs
 import HsDev.Tools.GhcMod.InferType (inferTypes)
 import qualified HsDev.Tools.GhcMod as GhcMod
@@ -89,16 +92,16 @@ 					return $ catMaybes [M.lookup mloc' (databaseModules db') | mloc' <- mlocs']
 			when (updateDocs sets) $ do
 				Log.log Log.Trace "forking inspecting source docs"
-				void $ fork (getMods >>= waiter . mapM_ scanDocs)
+				void $ fork (getMods >>= waiter . mapM_ scanDocs_)
 			when (runInferTypes sets) $ do
 				Log.log Log.Trace "forking inferring types"
-				void $ fork (getMods >>= waiter . mapM_ inferModTypes)
-		scanDocs :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => InspectedModule -> ExceptT String m ()
-		scanDocs im = do
+				void $ fork (getMods >>= waiter . mapM_ inferModTypes_)
+		scanDocs_ :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => InspectedModule -> ExceptT String m ()
+		scanDocs_ im = do
 			im' <- liftExceptT $ S.scanModify (\opts _ -> inspectDocs opts) im
 			updater $ return $ fromModule im'
-		inferModTypes :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => InspectedModule -> ExceptT String m ()
-		inferModTypes im = do
+		inferModTypes_ :: (MonadIO m, MonadReader Settings m, MonadWriter [ModuleLocation] m) => InspectedModule -> ExceptT String m ()
+		inferModTypes_ im = do
 			-- TODO: locate sandbox
 			im' <- liftExceptT $ S.scanModify infer' im
 			updater $ return $ fromModule im'
@@ -272,6 +275,34 @@ 	where
 		inDir = maybe False (dir `isParent`) . preview (moduleIdLocation . moduleFile)
 
+-- | Scan docs for inspected modules
+scanDocs :: (MonadIO m, MonadCatchIO m) => [InspectedModule] -> ExceptT String (UpdateDB m) ()
+scanDocs ims = do
+	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
+			im' <- liftExceptT $ S.scanModify (\opts _ -> inWorkerT w . inspectDocsGhc opts) 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
+		-- TODO: locate sandbox
+		sets <- ask
+		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
+		updater $ return $ fromModule im'
+	infer' :: Settings -> [String] -> Cabal -> Module -> ExceptT String IO Module
+	infer' sets opts cabal m = case preview (moduleLocation . moduleFile) m of
+		Nothing -> return m
+		Just f -> GhcMod.waitMultiGhcMod (settingsGhcModWorker sets) f $
+			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)
 	=> (FilePath -> ExceptT String IO Structured)
@@ -292,8 +323,6 @@ 	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
 	act changed
-
-instance Format Cabal where
 
 updateEvent :: (MonadIO m, MonadCatch m, MonadCatchIO m) => Watched -> Event -> ExceptT String (UpdateDB m) ()
 updateEvent (WatchedProject proj projOpts) e
src/HsDev/Display.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Display (
 	Display(..)
@@ -7,6 +8,8 @@ import Control.Lens (view)
 import Data.Maybe (fromMaybe)
 
+import Text.Format
+
 import HsDev.Cabal
 import HsDev.Symbols.Location
 import HsDev.Project
@@ -33,3 +36,12 @@ instance Display FilePath where
 	display = id
 	displayType _ = "path"
+
+instance Format Cabal where
+	format = display
+
+instance Format ModuleLocation where
+	format = display
+
+instance Format Project where
+	format = display
src/HsDev/Inspect.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances #-}  module HsDev.Inspect (-	analyzeModule, inspectDocsChunk, inspectDocs,+	analyzeModule, inspectDocsChunk, inspectDocs, inspectDocsGhc, 	inspectContents, contentsInspection, 	inspectFile, fileInspection, 	projectDirs, projectSources,@@ -33,6 +33,7 @@ import qualified System.Directory as Dir import System.FilePath import Data.Generics.Uniplate.Data+import HDocs.Haddock  import HsDev.Symbols import HsDev.Tools.Base@@ -163,15 +164,18 @@ getDecl :: H.Decl -> [Declaration] getDecl decl' = case decl' of 	H.TypeSig loc names typeSignature -> [mkFun loc n (Function (Just $ oneLinePrint typeSignature) [] Nothing) | n <- names]-	H.TypeDecl loc n args _ -> [mkType loc n Type args]-	H.DataDecl loc dataOrNew ctx n args cons _ -> mkType loc n (ctor dataOrNew `withCtx` ctx) args : concatMap (map (addRel n) . getConDecl n args) cons-	H.GDataDecl loc dataOrNew ctx n args _ gcons _ -> mkType loc n (ctor dataOrNew `withCtx` ctx) args : concatMap (map (addRel n) . getGConDecl) gcons-	H.ClassDecl loc ctx n args _ _ -> [mkType loc n (Class `withCtx` ctx) args]+	H.TypeDecl loc n args _ -> [mkType loc n Type args `withDef` decl']+	H.DataDecl loc dataOrNew ctx n args cons _ -> (mkType loc n (ctor dataOrNew `withCtx` ctx) args `withDef` decl') : concatMap (map (addRel n) . getConDecl n args) cons+	H.GDataDecl loc dataOrNew ctx n args _ gcons _ -> (mkType loc n (ctor dataOrNew `withCtx` ctx) args `withDef` decl') : concatMap (map (addRel n) . getGConDecl) gcons+	H.ClassDecl loc ctx n args _ _ -> [mkType loc n (Class `withCtx` ctx) args `withDef` decl'] 	_ -> [] 	where 		mkType :: H.SrcLoc -> H.Name -> (TypeInfo -> DeclarationInfo) -> [H.TyVarBind] -> Declaration 		mkType loc n ctor' args = setPosition loc $ decl (identOfName n) $ ctor' $ TypeInfo Nothing (map oneLinePrint args) Nothing [] +		withDef :: H.Pretty a => Declaration -> a -> Declaration+		withDef tyDecl' tyDef = set (declaration . typeInfo . typeInfoDefinition) (Just $ prettyPrint tyDef) tyDecl'+ 		withCtx :: (TypeInfo -> DeclarationInfo) -> H.Context -> TypeInfo -> DeclarationInfo 		withCtx ctor' ctx = ctor' . set typeInfoContext (makeCtx ctx) @@ -265,6 +269,21 @@ oneLinePrint :: (H.Pretty a, IsString s) => a -> s oneLinePrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode +-- | Print something+prettyPrint :: (H.Pretty a, IsString s) => a -> s+prettyPrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.PageMode }) mode' where+	mode' = H.PPHsMode {+		H.classIndent = 4,+		H.doIndent = 4,+		H.multiIfIndent = 4,+		H.caseIndent = 4,+		H.letIndent = 4,+		H.whereIndent = 4,+		H.onsideIndent = 2,+		H.spacing = False,+		H.layout = H.PPOffsideRule,+		H.linePragmas = False }+ -- | Convert @H.SrcLoc@ to @Position toPosition :: H.SrcLoc -> Position toPosition (H.SrcLoc _ l c) = Position l c@@ -297,6 +316,14 @@ 		then hdocsProcess (fromMaybe (T.unpack $ view moduleName m) (preview (moduleLocation . moduleFile) m)) opts 		else liftM Just $ hdocs (view moduleLocation m) opts 	return $ maybe id addDocs docsMap m++-- | Like @inspectDocs@, but in @Ghc@ monad+inspectDocsGhc :: [String] -> Module -> ExceptT String Ghc Module+inspectDocsGhc opts m = case view moduleLocation m of+	FileModule fpath _ -> do+		docsMap <- liftM (fmap (formatDocs . snd) . listToMaybe) $ readSourcesGhc opts [fpath]+		return $ maybe id addDocs docsMap m+	_ -> throwError "Can inspect only source file docs"  -- | Inspect contents inspectContents :: String -> [String] -> String -> ExceptT String IO InspectedModule
src/HsDev/Symbols/Location.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
 
 module HsDev.Symbols.Location (
-	ModulePackage(..), ModuleLocation(..), moduleStandalone,
+	ModulePackage(..), ModuleLocation(..), moduleStandalone, noLocation,
 	Position(..), Region(..), region, regionAt, regionLines, regionStr,
 	Location(..),
 
@@ -34,7 +34,7 @@ 
 import HsDev.Cabal
 import HsDev.Project
-import HsDev.Util ((.::))
+import HsDev.Util ((.::), (.::?))
 
 data ModulePackage = ModulePackage {
 	_packageName :: String,
@@ -96,13 +96,17 @@ instance ToJSON ModuleLocation where
 	toJSON (FileModule f p) = object ["file" .= f, "project" .= fmap (view projectCabal) p]
 	toJSON (CabalModule c p n) = object ["cabal" .= c, "package" .= fmap show p, "name" .= n]
-	toJSON (ModuleSource s) = object ["source" .= s]
+	toJSON (ModuleSource (Just s)) = object ["source" .= s]
+	toJSON (ModuleSource Nothing) = object []
 
 instance FromJSON ModuleLocation where
 	parseJSON = withObject "module location" $ \v ->
 		(FileModule <$> v .:: "file" <*> (fmap project <$> (v .:: "project"))) <|>
 		(CabalModule <$> v .:: "cabal" <*> fmap (join . fmap readMaybe) (v .:: "package") <*> v .:: "name") <|>
-		(ModuleSource <$> v .:: "source")
+		(ModuleSource <$> v .::? "source")
+
+noLocation :: ModuleLocation
+noLocation = ModuleSource Nothing
 
 data Position = Position {
 	_positionLine :: Int,
src/HsDev/Tools/AutoFix.hs view
@@ -76,7 +76,7 @@ 
 correctors :: [CorrectorMatch]
 correctors = [
-	match "^The import of `([\\w\\.]+)' is redundant" $ \_ rgn -> Correction
+	match "^The (?:qualified )?import of `([\\w\\.]+)' is redundant" $ \_ rgn -> Correction
 		"Redundant import"
 		(replace
 			(expandLines rgn)
src/HsDev/Tools/Base.hs view
@@ -3,7 +3,7 @@ 	runWait, runWait_,
 	tool, tool_,
 	matchRx, splitRx, replaceRx,
-	at,
+	at, at_,
 	inspect,
 	-- * Read parse utils
 	ReadM,
@@ -68,6 +68,9 @@ 
 at :: (Int -> Maybe String) -> Int -> String
 at g i = fromMaybe (error $ "Can't find group " ++ show i) $ g i
+
+at_ :: (Int -> Maybe String) -> Int -> String
+at_ g = fromMaybe "" . g
 
 inspect :: Monad m => ModuleLocation -> ExceptT String m Inspection -> ExceptT String m Module -> ExceptT String m InspectedModule
 inspect mloc insp act = lift $ execStateT inspect' (Inspected InspectionNone mloc (Left "not inspected")) where
src/HsDev/Tools/ClearImports.hs view
@@ -13,6 +13,7 @@ import Control.Monad.Except
 import Data.Char
 import Data.List
+import Data.Maybe (mapMaybe)
 import System.Directory
 import System.FilePath
 import qualified Language.Haskell.Exts as Exts
@@ -27,9 +28,9 @@ dumpMinimalImports opts f = do
 	cur <- liftE getCurrentDirectory
 	file <- liftE $ canonicalizePath f
+	cts <- liftE $ readFileUtf8 file
 
-	m <- liftE $ Exts.parseFile file
-	mname <- case m of
+	mname <- case Exts.parseFileContentsWithMode (pmode file) cts of
 		Exts.ParseFailed loc err -> throwError $
 			"Failed to parse file at " ++
 			Exts.prettyPrint loc ++ ":" ++ err
@@ -53,6 +54,14 @@ 			load LoadAllTargets
 
 	length mname `seq` return mname
+	where
+		pmode :: FilePath -> Exts.ParseMode
+		pmode f' = Exts.defaultParseMode {
+			Exts.parseFilename = f',
+			Exts.baseLanguage = Exts.Haskell2010,
+			Exts.extensions = Exts.glasgowExts ++ map Exts.parseExtension exts,
+			Exts.fixities = Just Exts.baseFixities }
+		exts = mapMaybe (stripPrefix "-X") opts
 
 -- | Read imports from file
 waitImports :: FilePath -> IO [String]
src/HsDev/Tools/Ghc/Check.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards #-}
 
 module HsDev.Tools.Ghc.Check (
-	checkFiles, check,
+	checkFiles, check, checkFile, checkSource,
 
 	Ghc,
 	module HsDev.Tools.Types,
@@ -16,13 +16,16 @@ import Control.Concurrent.FiniteChan
 import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Version (showVersion)
+import Data.Time.Clock (getCurrentTime)
 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
 
@@ -45,9 +48,9 @@ 	notes <- liftIO $ stopChan ch
 	liftIO $ recalcNotesTabs notes
 
--- | Check module and collect warnings and errors
-check :: [String] -> Cabal -> Module -> ExceptT String Ghc [Note OutputMessage]
-check opts cabal m = case view moduleLocation m of
+-- | Check module source
+check :: [String] -> Cabal -> Module -> Maybe String -> ExceptT String Ghc [Note OutputMessage]
+check opts cabal m msrc = case view moduleLocation m of
 	FileModule file proj -> do
 		ch <- liftIO newChan
 		pkgs <- lift listPackages
@@ -55,20 +58,30 @@ 			dir = fromMaybe
 				(sourceModuleRoot (view moduleName m) file) $
 				preview (_Just . projectPath) proj
-		lift $ withFlags $ withCurrentDirectory dir $ do
+		dirExist <- liftIO $ doesDirectoryExist dir
+		lift $ withFlags $ (if dirExist then withCurrentDirectory dir else id) $ do
 			modifyFlags (\fs -> fs { log_action = logAction ch })
 			_ <- addCmdOpts $ concat [
 				["-Wall"],
 				cabalOpt cabal,
 				moduleOpts pkgs m,
 				opts]
+			tm <- liftIO getCurrentTime
 			clearTargets
-			target <- makeTarget (makeRelative dir file) Nothing
+			target <- makeTarget (makeRelative dir file) msrc
 			loadTargets [target]
 		notes <- liftIO $ stopChan ch
 		liftIO $ recalcNotesTabs notes
 	_ -> throwError "Module is not source"
 
+-- | Check module and collect warnings and errors
+checkFile :: [String] -> Cabal -> Module -> ExceptT String Ghc [Note OutputMessage]
+checkFile opts cabal m = check opts cabal m Nothing
+
+-- | Check module and collect warnings and errors
+checkSource :: [String] -> Cabal -> Module -> String -> ExceptT String Ghc [Note OutputMessage]
+checkSource opts cabal m src = check opts cabal m (Just src)
+
 -- | Log  ghc warnings and errors as to chan
 -- You may have to apply recalcTabs on result notes
 logAction :: Chan (Note OutputMessage) -> DynFlags -> E.Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
@@ -77,13 +90,8 @@ 		src' <- canonicalize srcMod
 		putChan ch $ Note {
 			_noteSource = src',
-			_noteRegion = case src of
-				RealSrcSpan s' ->
-					Position (srcSpanStartLine s') (srcSpanStartCol s')
-					`region`
-					Position (srcSpanEndLine s') (srcSpanEndCol s')
-				_ -> Position 0 0 `region` Position 0 0,
-			_noteLevel = sev',
+			_noteRegion = spanRegion src,
+			_noteLevel = Just sev',
 			_note = OutputMessage {
 				_message = showSDoc fs msg,
 				_messageSuggestion = Nothing } }
@@ -96,13 +104,6 @@ 		srcMod = case src of
 			RealSrcSpan s' -> FileModule (unpackFS $ srcSpanFile s') Nothing
 			_ -> ModuleSource Nothing
-
--- | Get list of installed packages
-listPackages :: Ghc [ModulePackage]
-listPackages = getSessionDynFlags >>= return . mapMaybe readPackage . fromMaybe [] . pkgDatabase
-
-readPackage :: GHC.PackageConfig -> Maybe ModulePackage
-readPackage pc = readMaybe $ GHC.packageNameString pc ++ "-" ++ showVersion (GHC.packageVersion pc)
 
 -- Recalc tabs for notes
 recalcNotesTabs :: [Note OutputMessage] -> IO [Note OutputMessage]
+ src/HsDev/Tools/Ghc/Types.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes, TemplateHaskell, OverloadedStrings #-}
+
+module HsDev.Tools.Ghc.Types (
+	TypedExpr(..), typedExpr, typedType,
+	moduleTypes, fileTypes
+	) where
+
+import Control.DeepSeq
+import Control.Lens (over, view, preview, makeLenses, _Just)
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Aeson
+import Data.Generics
+import Data.Maybe
+import System.Directory
+import System.FilePath
+
+import GHC hiding (exprType, Module, moduleName)
+import GHC.SYB.Utils (everythingStaged, Stage(TypeChecker))
+import GhcPlugins (mkFunTys)
+import CoreUtils
+import Desugar (deSugarExpr)
+import TcHsSyn (hsPatType)
+import Outputable
+import PprTyThing
+import Pretty
+
+import HsDev.Symbols
+import HsDev.Tools.Ghc.Worker
+import HsDev.Tools.Types
+import HsDev.Util hiding (withCurrentDirectory)
+
+class HasType a where
+	getType :: GhcMonad m => TypecheckedModule -> a -> m (Maybe (SrcSpan, Type))
+
+instance HasType (LHsExpr Id) where
+	getType _ e = do
+		env <- getSession
+		mbe <- liftIO $ liftM snd $ deSugarExpr env e
+		return $ do
+			ex <- mbe
+			return (getLoc e, exprType ex)
+
+instance HasType (LHsBind Id) where
+	getType _ (L spn FunBind { fun_matches = m}) = return $ Just (spn, typ) where
+		typ = mkFunTys (mg_arg_tys m) (mg_res_ty m)
+	getType _ _ = return Nothing
+
+instance HasType (LPat Id) where
+	getType _ (L spn pat) = return $ Just (spn, hsPatType pat)
+
+locatedTypes :: Typeable a => TypecheckedSource -> [Located a]
+locatedTypes = types' p where
+	types' :: Typeable r => (r -> Bool) -> GenericQ [r]
+	types' p' = everythingStaged TypeChecker (++) [] ([] `mkQ` (\x -> [x | p' x]))
+	p (L spn _) = isGoodSrcSpan spn
+
+moduleTypes :: GhcMonad m => FilePath -> m [(SrcSpan, Type)]
+moduleTypes fpath = do
+	fpath' <- liftIO $ canonicalize fpath
+	mg <- getModuleGraph
+	[m] <- liftIO $ flip filterM mg $ \m -> do
+		mfile <- traverse (liftIO . canonicalize) $ ml_hs_file (ms_location m)
+		return (Just fpath' == mfile)
+	p <- parseModule m
+	tm <- typecheckModule p
+	let
+		ts = tm_typechecked_source tm
+	liftM (catMaybes . concat) $ sequence [
+		mapM (getType tm) (locatedTypes ts :: [LHsBind Id]),
+		mapM (getType tm) (locatedTypes ts :: [LHsExpr Id]),
+		mapM (getType tm) (locatedTypes ts :: [LPat Id])]
+
+data TypedExpr = TypedExpr {
+	_typedExpr :: String,
+	_typedType :: String }
+		deriving (Eq, Ord, Read, Show)
+
+makeLenses ''TypedExpr
+
+instance NFData TypedExpr where
+	rnf (TypedExpr e t) = rnf e `seq` rnf t
+
+instance ToJSON TypedExpr where
+	toJSON (TypedExpr e t) = object [
+		"expr" .= e,
+		"type" .= t]
+
+instance FromJSON TypedExpr where
+	parseJSON = withObject "typed-expr" $ \v -> TypedExpr <$>
+		v .:: "expr" <*>
+		v .:: "type"
+
+fileTypes :: [String] -> Cabal -> Module -> Maybe String -> ExceptT String Ghc [Note TypedExpr]
+fileTypes opts cabal m msrc = case view moduleLocation m of
+	FileModule file proj -> do
+		file' <- liftIO $ canonicalize file
+		cts <- maybe (liftIO $ readFileUtf8 file') return msrc
+		pkgs <- lift listPackages
+		let
+			dir = fromMaybe
+				(sourceModuleRoot (view moduleName m) file') $
+				preview (_Just . projectPath) proj
+		dirExist <- liftIO $ doesDirectoryExist dir
+		lift $ withFlags $ (if dirExist then withCurrentDirectory dir else id) $ do
+			_ <- addCmdOpts $ concat [
+				cabalOpt cabal,
+				moduleOpts pkgs m,
+				opts]
+			target <- makeTarget (makeRelative dir file') msrc
+			loadTargets [target]
+			ts <- moduleTypes file'
+			df <- getSessionDynFlags
+			return $ map (setExpr cts . recalcTabs cts 8 . uncurry (toNote df)) ts
+	_ -> throwError "Module is not source"
+	where
+		toNote :: DynFlags -> SrcSpan -> Type -> Note String
+		toNote df spn tp = Note {
+			_noteSource = noLocation,
+			_noteRegion = spanRegion spn,
+			_noteLevel = Nothing,
+			_note = showType df tp }
+		setExpr :: String -> Note String -> Note TypedExpr
+		setExpr cts n = over note (TypedExpr (regionStr (view noteRegion n) cts)) n
+		showType :: DynFlags -> Type -> String
+		showType df = showDoc OneLineMode 80 . withPprStyleDoc df unqualStyle . pprTypeForUser
+		unqualStyle :: PprStyle
+		unqualStyle = mkUserStyle neverQualify AllTheWay
src/HsDev/Tools/Ghc/Worker.hs view
@@ -9,6 +9,7 @@ 	evaluate,
 	clearTargets, makeTarget, loadTargets,
 	-- * Utils
+	listPackages, spanRegion,
 	withCurrentDirectory,
 
 	Ghc,
@@ -20,15 +21,20 @@ import Control.Monad.Catch
 import Control.Monad.Except
 import Data.Dynamic
+import Data.Maybe
 import Data.Time.Clock (getCurrentTime)
+import Data.Version (showVersion)
 import GHC
 import GHC.Paths
 import Packages
 import StringBuffer
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
+import Text.Read
 
 import Control.Concurrent.Worker
 
+import HsDev.Symbols.Location (Position(..), Region(..), region, ModulePackage)
+
 -- | Ghc worker. Pass options and initializer action
 ghcWorker :: [String] -> Ghc () -> IO (Worker Ghc)
 ghcWorker opts initialize = startWorker (runGhc (Just libdir)) ghcInit id where
@@ -99,6 +105,18 @@ -- | Load all targets
 loadTargets :: [Target] -> Ghc ()
 loadTargets ts = setTargets ts >> load LoadAllTargets >> return ()
+
+-- | Get list of installed packages
+listPackages :: Ghc [ModulePackage]
+listPackages = getSessionDynFlags >>= return . mapMaybe readPackage . fromMaybe [] . pkgDatabase
+
+readPackage :: PackageConfig -> Maybe ModulePackage
+readPackage pc = readMaybe $ packageNameString pc ++ "-" ++ showVersion (packageVersion pc)
+
+-- | Get region of @SrcSpan@
+spanRegion :: SrcSpan -> Region
+spanRegion (RealSrcSpan s) = Position (srcSpanStartLine s) (srcSpanStartCol s) `region` Position (srcSpanEndLine s) (srcSpanEndCol s)
+spanRegion _ = Position 0 0 `region` Position 0 0
 
 -- | Set current directory and restore it after action
 withCurrentDirectory :: FilePath -> Ghc a -> Ghc a
src/HsDev/Tools/GhcMod.hs view
@@ -200,7 +200,7 @@ 	return Note {
 		_noteSource = FileModule (normalise (groups `at` 1)) Nothing,
 		_noteRegion = regionAt (Position l c),
-		_noteLevel = if groups 5 == Just "Warning" then Warning else Error,
+		_noteLevel = Just $ if groups 5 == Just "Warning" then Warning else Error,
 		_note = outputMessage $ nullToNL (groups `at` 6) }
 
 recalcOutputMessageTabs :: [(FilePath, String)] -> Note OutputMessage -> Note OutputMessage
src/HsDev/Tools/HLint.hs view
@@ -1,5 +1,5 @@ module HsDev.Tools.HLint (
-	hlint,
+	hlint, hlintFile, hlintSource,
 
 	module Control.Monad.Except
 	) where
@@ -20,20 +20,26 @@ import HsDev.Tools.Base
 import HsDev.Util (readFileUtf8, split)
 
-hlint :: FilePath -> ExceptT String IO [Note OutputMessage]
-hlint file = do
+hlint :: FilePath -> Maybe String -> ExceptT String IO [Note OutputMessage]
+hlint file msrc = do
 	file' <- liftIO $ canonicalize file
-	cts <- liftIO $ readFileUtf8 file'
+	cts <- maybe (liftIO $ readFileUtf8 file') return msrc
 	(flags, classify, hint) <- liftIO autoSettings
 	p <- liftIO $ parseModuleEx (flags { cppFlags = CppSimple }) file' (Just cts)
 	m <- either (throwError . parseErrorMessage) return p
 	return $ map (recalcTabs cts 8 . indentIdea cts . fromIdea) $ applyHints classify hint [m]
 
+hlintFile :: FilePath -> ExceptT String IO [Note OutputMessage]
+hlintFile f = hlint f Nothing
+
+hlintSource :: FilePath -> String -> ExceptT String IO [Note OutputMessage]
+hlintSource f = hlint f . Just
+
 fromIdea :: Idea -> Note OutputMessage
 fromIdea idea = Note {
 	_noteSource = FileModule (srcSpanFilename src) Nothing,
 	_noteRegion = Region (Position (srcSpanStartLine src) (srcSpanStartColumn src)) (Position (srcSpanEndLine src) (srcSpanEndColumn src)),
-	_noteLevel = case ideaSeverity idea of
+	_noteLevel = Just $ case ideaSeverity idea of
 		HL.Ignore -> Hint
 		HL.Warning -> Warning
 		HL.Error -> Error,
src/HsDev/Tools/Types.hs view
@@ -13,7 +13,7 @@ 
 import HsDev.Symbols (Canonicalize(..))
 import HsDev.Symbols.Location
-import HsDev.Util ((.::))
+import HsDev.Util ((.::), (.::?))
 
 -- | Note severity
 data Severity = Error | Warning | Hint deriving (Enum, Bounded, Eq, Ord, Read, Show)
@@ -41,7 +41,7 @@ data Note a = Note {
 	_noteSource :: ModuleLocation,
 	_noteRegion :: Region,
-	_noteLevel :: Severity,
+	_noteLevel :: Maybe Severity,
 	_note :: a }
 
 makeLenses ''Note
@@ -63,7 +63,7 @@ 	parseJSON = withObject "note" $ \v -> Note <$>
 		v .:: "source" <*>
 		v .:: "region" <*>
-		v .:: "level" <*>
+		v .::? "level" <*>
 		v .:: "note"
 
 instance RecalcTabs (Note a) where
src/System/Directory/Watcher.hs view
@@ -20,7 +20,6 @@ import Data.Maybe (isJust)
 import Data.String (fromString)
 import Data.Time.Clock.POSIX
-import qualified Filesystem.Path.CurrentOS as F (encodeString)
 import System.FilePath (takeDirectory, isDrive)
 import System.Directory
 import qualified System.FSNotify as FS
@@ -141,7 +140,7 @@ onEvent w act = events w >>= mapM_ (uncurry act)
 
 fromEvent :: FS.Event -> Event
-fromEvent e = Event t (F.encodeString $ FS.eventPath e) (utcTimeToPOSIXSeconds $ FS.eventTime e) where
+fromEvent e = Event t (FS.eventPath e) (utcTimeToPOSIXSeconds $ FS.eventTime e) where
 	t = case e of
 		FS.Added _ _ -> Added
 		FS.Modified _ _ -> Modified