hsdev 0.1.5.6 → 0.1.6.0

raw patch · 10 files changed

+87/−69 lines, 10 filesdep ~hlint

Dependency ranges changed: hlint

Files

hsdev.cabal +2/−2
src/HsDev/Client/Commands.hs +20/−15
src/HsDev/Commands.hs +1/−1
src/HsDev/Database/Update.hs +7/−12
src/HsDev/Database/Update/Types.hs +4/−0
src/HsDev/Server/Types.hs +25/−27
src/HsDev/Symbols.hs +5/−5
src/HsDev/Symbols/Resolve.hs +2/−2
src/HsDev/Tools/Ghc/Types.hs +19/−2
src/HsDev/Tools/HLint.hs +2/−3

hsdev.cabal view

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.5.6
+version:             0.1.6.0
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -116,7 +116,7 @@     haskell-src-exts >= 1.17.0 && < 1.18.0,
     hdocs >= 0.4.4,
     hformat >= 0.1,
-    hlint >= 1.9.0 && < 2.0.0,
+    hlint >= 1.9.13 && < 2.0.0,
     HTTP >= 4000.2.0,
     lens >= 4.8,
     lifted-base >= 0.2,

src/HsDev/Client/Commands.hs view

@@ -89,26 +89,26 @@ 			map inModule ms]
 		mods = selectModules (filters . view moduleId) dbval
 	updateProcess copts [] False False [Update.inferModTypes $ map (getInspected dbval) mods]
-runCommand copts (Remove projs packages cabals fs) = undefined
-runCommand copts (InfoModules f) = runCommandM $ do
+runCommand copts (Remove projs packages cabals fs) = runCommandM $ return $ object ["message" .= ("not implemented" :: String)]
+runCommand copts (InfoModules fs) = runCommandM $ do
 	dbval <- getDb copts
-	filter' <- targetFilter copts f
+	filter' <- targetFilters copts fs
 	return $ map (view moduleId) $ newestPackage $ selectModules (filter' . view moduleId) dbval
 runCommand copts InfoPackages = runCommandM $
 	(ordNub . sort . 	mapMaybe (preview (moduleLocation . modulePackage . _Just)) . allModules) <$> getDb copts
 runCommand copts InfoProjects = runCommandM $ (toList . databaseProjects) <$> getDb copts
 runCommand copts InfoSandboxes = runCommandM $
 	(ordNub . sort . mapMaybe (cabalOf . view moduleId) . allModules) <$> getDb copts
-runCommand copts (InfoSymbol sq f) = runCommandM $ do
-	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
-	filter' <- targetFilter copts f
+runCommand copts (InfoSymbol sq fs locals) = runCommandM $ do
+	dbval <- liftM (localsDatabase locals) $ getDb copts
+	filter' <- targetFilters copts fs
 	return $ newestPackage $ filterMatch sq $ filter (checkModule filter') $ allDeclarations dbval
-runCommand copts (InfoModule sq f) = runCommandM $ do
-	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
-	filter' <- targetFilter copts f
+runCommand copts (InfoModule sq fs) = runCommandM $ do
+	dbval <- getDb copts
+	filter' <- targetFilters copts fs
 	return $ newestPackage $ filterMatch sq $ filter (filter' . view moduleId) $ allModules dbval
 runCommand copts (InfoResolve fpath exports) = runCommandM $ do
-	dbval <- liftM (localsDatabase False) $ getDb copts -- FIXME: Where is arg locals?
+	dbval <- getDb copts
 	cabal <- liftIO $ getSandbox fpath
 	let
 		cabaldb = filterDB (restrictCabal cabal) (const True) dbval
@@ -129,10 +129,10 @@ 	dbval <- getDb copts
 	cabal <- liftIO $ getSandbox fpath
 	mapCommandErrorStr $ whois dbval cabal fpath nm
-runCommand copts (ResolveScopeModules fpath) = runCommandM $ do
+runCommand copts (ResolveScopeModules sq fpath) = runCommandM $ do
 	dbval <- getDb copts
 	cabal <- liftIO $ getSandbox fpath
-	liftM (map (view moduleId)) $ mapCommandErrorStr $ scopeModules dbval cabal fpath
+	liftM (filterMatch sq . map (view moduleId)) $ mapCommandErrorStr $ scopeModules dbval cabal fpath
 runCommand copts (ResolveScope sq global fpath) = runCommandM $ do
 	dbval <- getDb copts
 	cabal <- liftIO $ getSandbox fpath
@@ -255,6 +255,11 @@ runCommand copts (Link hold) = runCommandM $ liftIO $ commandLink copts >> when hold (commandHold copts)
 runCommand copts Exit = runCommandM $ liftIO $ commandExit copts
 
+targetFilters :: MonadIO m => CommandOptions -> [TargetFilter] -> ExceptT CommandError m (ModuleId -> Bool)
+targetFilters copts fs = do
+	fs_ <- mapM (targetFilter copts) fs
+	return $ foldr (liftM2 (&&)) (const True) fs_
+
 targetFilter :: MonadIO m => CommandOptions -> TargetFilter -> ExceptT CommandError m (ModuleId -> Bool)
 targetFilter copts f = case f of
 	TargetProject proj -> liftM inProject $ findProject copts proj
@@ -265,7 +270,6 @@ 	TargetPackage pack -> return $ inPackage pack
 	TargetSourced -> return byFile
 	TargetStandalone -> return standalone
-	TargetAny -> return (const True)
 
 -- Helper functions
 
@@ -290,7 +294,7 @@ getSandboxes :: (MonadIO m, Functor m) => CommandOptions -> [Cabal] -> ExceptT CommandError m [Cabal]
 getSandboxes copts = traverse (findSandbox copts)
 
--- | Find project by name of path
+-- | Find project by name or path
 findProject :: MonadIO m => CommandOptions -> String -> ExceptT CommandError m Project
 findProject copts proj = do
 	db' <- getDb copts
@@ -299,7 +303,7 @@ 		resultProj =
 			refineProject db' (project proj') <|>
 			find ((== proj) . view projectName) (databaseProjects db')
-	maybe (throwError $ commandStrMsg $ "Projects " ++ proj ++ " not found") return resultProj
+	maybe (throwError $ commandStrMsg $ "Project " ++ proj ++ " not found") return resultProj
 	where
 		addCabal p
 			| takeExtension p == ".cabal" = p
@@ -321,6 +325,7 @@ 	sbox <- liftIO $ searchSandbox $ view projectPath proj
 	return (proj, src, sbox)
 
+-- FIXME: Doesn't work for file without project
 -- | Check if project or source depends from this module
 inDeps :: (Project, Maybe FilePath, Cabal) -> ModuleId -> Bool
 inDeps (proj, src, cabal) = liftM2 (&&) (restrictCabal cabal) deps' where

src/HsDev/Commands.hs view

@@ -70,7 +70,7 @@ 	maybe (throwError $ "Project " ++ view projectCabal p' ++ " not found") return $
 		refineProject db p'
 
--- | Lookup visible within project symbol
+-- | Lookup visible within project/cabal symbol
 lookupSymbol :: Database -> Cabal -> FilePath -> String -> ExceptT String IO [ModuleDeclaration]
 lookupSymbol db cabal file ident = do
 	(_, mthis, mproj) <- fileCtx db file

src/HsDev/Database/Update.hs view

@@ -52,8 +52,8 @@ import HsDev.Project
 import HsDev.Symbols
 import HsDev.Tools.Ghc.Worker (ghcWorker)
+import HsDev.Tools.Ghc.Types (inferTypes)
 import HsDev.Tools.HDocs
-import HsDev.Tools.GhcMod.InferType (inferTypes)
 import qualified HsDev.Tools.GhcMod as GhcMod
 import qualified HsDev.Scan as S
 import HsDev.Scan.Browse
@@ -108,8 +108,8 @@ 		infer' :: [String] -> Cabal -> Module -> ExceptT String IO Module
 		infer' opts cabal m = case preview (moduleLocation . moduleFile) m of
 			Nothing -> return m
-			Just f -> GhcMod.waitMultiGhcMod (settingsGhcModWorker sets) f $
-				inferTypes opts cabal m
+			Just _ -> inWorkerT (settingsGhcWorker sets) $ inferTypes opts cabal m Nothing
+		inWorkerT w = ExceptT . inWorker w . runExceptT 
 
 -- | Post status
 postStatus :: (MonadIO m, MonadReader Settings m) => Task -> m ()
@@ -291,18 +291,13 @@ 
 inferModTypes :: (MonadIO m, MonadCatchIO m) => [InspectedModule] -> ExceptT String (UpdateDB m) ()
 inferModTypes = runTasks . map inferModTypes' where
-	inferModTypes' im = runTask "inferring types" (view inspectedId im) $ Log.scope "infer" $ do
-		-- TODO: locate sandbox
-		sets <- ask
+	inferModTypes' im = runTask "inferring types" (view inspectedId im) $ Log.scope "docs" $ do
+		w <- asks settingsGhcWorker
 		Log.log Log.Trace $ "Inferring types for {}" ~~ view inspectedId im
-		im' <- liftExceptT $ S.scanModify (infer' sets) im
+		im' <- liftExceptT $ S.scanModify (\opts cabal m -> inWorkerT w (inferTypes opts cabal m Nothing)) 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
+	inWorkerT w = ExceptT . inWorker w . runExceptT
 
 -- | Generic scan function. Reads cache only if data is not already loaded, removes obsolete modules and rescans changed modules.
 scan :: (MonadIO m, MonadCatch m, MonadCatchIO m)

src/HsDev/Database/Update/Types.hs view

@@ -25,6 +25,8 @@ import HsDev.Util ((.::))
 import HsDev.Watcher.Types
 
+import GHC (Ghc)
+
 data Status = StatusWorking | StatusOk | StatusError String
 
 instance ToJSON Status where
@@ -82,6 +84,7 @@ 	ghcOptions :: [String],
 	updateDocs :: Bool,
 	runInferTypes :: Bool,
+	settingsGhcWorker :: Worker Ghc,
 	settingsGhcModWorker :: Worker (ReaderT WorkerMap IO),
 	settingsLogger :: Log.Log,
 	settingsWatcher :: Watcher,
@@ -96,6 +99,7 @@ 	ghcOpts'
 	docs'
 	infer'
+	(commandGhc copts)
 	(commandGhcMod copts)
 	(commandLogger copts)
 	(commandWatcher copts)

src/HsDev/Server/Types.hs view

@@ -182,7 +182,6 @@ 		((v .:: "timeout") <|> pure 0) <*>
 		((v .:: "silent") <|> pure False)
 
--- FIXME: Why so much commands in options?
 -- | Command from client
 data Command =
 	Ping |
@@ -210,18 +209,18 @@ 		removePackages :: [String],
 		removeSandboxes :: [Cabal],
 		removeFiles :: [FilePath] } |
-	InfoModules TargetFilter |
+	InfoModules [TargetFilter] |
 	InfoPackages |
 	InfoProjects |
 	InfoSandboxes |
-	InfoSymbol SearchQuery TargetFilter |
-	InfoModule SearchQuery TargetFilter |
+	InfoSymbol SearchQuery [TargetFilter] Bool |
+	InfoModule SearchQuery [TargetFilter] |
 	InfoResolve FilePath Bool |
 	InfoProject (Either String FilePath) |
 	InfoSandbox FilePath |
 	Lookup String FilePath |
 	Whois String FilePath |
-	ResolveScopeModules FilePath |
+	ResolveScopeModules SearchQuery FilePath |
 	ResolveScope SearchQuery Bool FilePath |
 	Complete String Bool FilePath |
 	Hayoo {
@@ -274,7 +273,6 @@ 		deriving (Show)
 
 data FileContents = FileContents FilePath String deriving (Show)
--- TODO: Why deps is just string?
 data TargetFilter =
 	TargetProject String |
 	TargetFile FilePath |
@@ -283,8 +281,7 @@ 	TargetCabal Cabal |
 	TargetPackage String |
 	TargetSourced |
-	TargetStandalone |
-	TargetAny
+	TargetStandalone
 		deriving (Eq, Show)
 data SearchQuery = SearchQuery String SearchType deriving (Show)
 data SearchType = SearchExact | SearchPrefix | SearchInfix | SearchSuffix | SearchRegex deriving (Show)
@@ -303,14 +300,14 @@ 	paths f (InferTypes projs fs ms) = InferTypes <$> each f projs <*> each f fs <*> pure ms
 	paths f (Remove projs ps cs fs) = Remove <$> each f projs <*> pure ps <*> (each . paths) f cs <*> each f fs
 	paths f (InfoModules t) = InfoModules <$> paths f t
-	paths f (InfoSymbol q t) = InfoSymbol <$> pure q <*> paths f t
+	paths f (InfoSymbol q t l) = InfoSymbol <$> pure q <*> paths f t <*> pure l
 	paths f (InfoModule q t) = InfoModule <$> pure q <*> paths f t
 	paths f (InfoResolve fpath es) = InfoResolve <$> f fpath <*> pure es
 	paths f (InfoProject (Right proj)) = InfoProject <$> (Right <$> f proj)
 	paths f (InfoSandbox fpath) = InfoSandbox <$> f fpath
 	paths f (Lookup n fpath) = Lookup <$> pure n <*> f fpath
 	paths f (Whois n fpath) = Whois <$> pure n <*> f fpath
-	paths f (ResolveScopeModules fpath) = ResolveScopeModules <$> f fpath
+	paths f (ResolveScopeModules q fpath) = ResolveScopeModules q <$> f fpath
 	paths f (ResolveScope q g fpath) = ResolveScope q g <$> f fpath
 	paths f (Complete n g fpath) = Complete n g <$> f fpath
 	paths f (Lint fs fcts) = Lint <$> each f fs <*> (each . paths) f fcts
@@ -335,6 +332,9 @@ 	paths f (TargetCabal c) = TargetCabal <$> paths f c
 	paths _ t = pure t
 
+instance Paths [TargetFilter] where
+	paths = each . paths
+
 instance FromCmd Command where
 	cmdP = subparser $ mconcat [
 		cmd "ping" "ping server" (pure Ping),
@@ -356,19 +356,19 @@ 			many packageArg <*>
 			many cabalArg <*>
 			many fileArg,
-		cmd "modules" "list modules" (InfoModules <$> cmdP),
+		cmd "modules" "list modules" (InfoModules <$> many cmdP),
 		cmd "packages" "list packages" (pure InfoPackages),
 		cmd "projects" "list projects" (pure InfoProjects),
 		cmd "sandboxes" "list sandboxes" (pure InfoSandboxes),
-		cmd "symbol" "get symbol info" (InfoSymbol <$> cmdP <*> cmdP),
-		cmd "module" "get module info" (InfoModule <$> cmdP <*> cmdP),
+		cmd "symbol" "get symbol info" (InfoSymbol <$> cmdP <*> many cmdP <*> localsFlag),
+		cmd "module" "get module info" (InfoModule <$> cmdP <*> many cmdP),
 		cmd "resolve" "resolve module scope (or exports)" (InfoResolve <$> fileArg <*> exportsFlag),
 		cmd "project" "get project info" (InfoProject <$> ((Left <$> projectArg) <|> (Right <$> pathArg idm))),
 		cmd "sandbox" "get sandbox info" (InfoSandbox <$> (pathArg $ help "locate sandbox in parent of this path")),
 		cmd "lookup" "lookup for symbol" (Lookup <$> strArgument idm <*> ctx),
 		cmd "whois" "get info for symbol" (Whois <$> strArgument idm <*> ctx),
 		cmd "scope" "get declarations accessible from module or within a project" (
-			subparser (cmd "modules" "get modules accessible from module or within a project" (ResolveScopeModules <$> ctx)) <|>
+			subparser (cmd "modules" "get modules accessible from module or within a project" (ResolveScopeModules <$> cmdP <*> ctx)) <|>
 			ResolveScope <$> cmdP <*> globalFlag <*> ctx),
 		cmd "complete" "show completions for input" (Complete <$> strArgument idm <*> wideFlag <*> ctx),
 		cmd "hayoo" "find declarations online via Hayoo" (Hayoo <$> strArgument idm <*> hayooPageArg <*> hayooPagesArg),
@@ -404,7 +404,7 @@ 	cmdP = option readJSON (long "contents")
 
 instance FromCmd TargetFilter where
-	cmdP = asum [TargetProject <$> projectArg, TargetFile <$> fileArg, TargetModule <$> moduleArg, TargetDepsOf <$> depsArg, TargetCabal <$> cabalArg, TargetPackage <$> packageArg, flag' TargetSourced (long "src"), flag' TargetStandalone (long "stand"), pure TargetAny]
+	cmdP = asum [TargetProject <$> projectArg, TargetFile <$> fileArg, TargetModule <$> moduleArg, TargetDepsOf <$> depsArg, TargetCabal <$> cabalArg, TargetPackage <$> packageArg, flag' TargetSourced (long "src"), flag' TargetStandalone (long "stand")]
 
 instance FromCmd SearchQuery where
 	cmdP = SearchQuery <$> (strArgument idm <|> pure "") <*> (asum [
@@ -430,7 +430,7 @@ hlintOpts = many (strOption (long "hlint" <> metavar "option" <> short 'h' <> help "options to pass to hlint"))
 holdFlag = switch (long "hold" <> short 'h' <> help "don't return any response")
 inferFlag = switch (long "infer" <> help "infer types")
--- localsArg = switch (long "locals" <> short 'l' <> help "look in local declarations")
+localsFlag = switch (long "locals" <> short 'l' <> help "look in local declarations")
 moduleArg = strOption (long "module" <> metavar "name" <> short 'm' <> help "module name")
 packageArg = strOption (long "package" <> metavar "name" <> help "module package")
 pathArg f = strOption (long "path" <> metavar "path" <> short 'p' <> f)
@@ -455,18 +455,18 @@ 	toJSON (RefineDocs projs fs ms) = cmdJson "docs" ["projects" .= projs, "files" .= fs, "modules" .= ms]
 	toJSON (InferTypes projs fs ms) = cmdJson "infer" ["projects" .= projs, "files" .= fs, "modules" .= ms]
 	toJSON (Remove projs packages cabals fs) = cmdJson "remove" ["projects" .= projs, "packages" .= packages, "sandboxes" .= cabals, "files" .= fs]
-	toJSON (InfoModules tf) = cmdJson "modules" ["filter" .= tf]
+	toJSON (InfoModules tf) = cmdJson "modules" ["filters" .= tf]
 	toJSON InfoPackages = cmdJson "packages" []
 	toJSON InfoProjects = cmdJson "projects" []
 	toJSON InfoSandboxes = cmdJson "sandboxes" []
-	toJSON (InfoSymbol q tf) = cmdJson "symbol" ["query" .= q, "filter" .= tf]
-	toJSON (InfoModule q tf) = cmdJson "module" ["query" .= q, "filter" .= tf]
+	toJSON (InfoSymbol q tf l) = cmdJson "symbol" ["query" .= q, "filters" .= tf, "locals" .= l]
+	toJSON (InfoModule q tf) = cmdJson "module" ["query" .= q, "filters" .= tf]
 	toJSON (InfoResolve f es) = cmdJson "resolve" ["file" .= f, "exports" .= es]
 	toJSON (InfoProject p) = cmdJson "project" $ either (\pname -> ["name" .= pname]) (\ppath -> ["path" .= ppath]) p
 	toJSON (InfoSandbox p) = cmdJson "sandbox" ["path" .= p]
 	toJSON (Lookup n f) = cmdJson "lookup" ["name" .= n, "file" .= f]
 	toJSON (Whois n f) = cmdJson "whois" ["name" .= n, "file" .= f]
-	toJSON (ResolveScopeModules f) = cmdJson "scope modules" ["file" .= f]
+	toJSON (ResolveScopeModules q f) = cmdJson "scope modules" ["query" .= q, "file" .= f]
 	toJSON (ResolveScope q g f) = cmdJson "scope" ["query" .= q, "global" .= g, "file" .= f]
 	toJSON (Complete q w f) = cmdJson "complete" ["prefix" .= q, "wide" .= w, "file" .= f]
 	toJSON (Hayoo q p ps) = cmdJson "hayoo" ["query" .= q, "page" .= p, "pages" .= ps]
@@ -502,18 +502,18 @@ 			v .:: "packages" <*>
 			v .:: "sandboxes" <*>
 			v .:: "files"),
-		guardCmd "modules" v *> (InfoModules <$> v .:: "filter"),
+		guardCmd "modules" v *> (InfoModules <$> v .:: "filters"),
 		guardCmd "packages" v *> pure InfoPackages,
 		guardCmd "projects" v *> pure InfoProjects,
 		guardCmd "sandboxes" v *> pure InfoSandboxes,
-		guardCmd "symbol" v *> (InfoSymbol <$> v .:: "query" <*> v .:: "filter"),
-		guardCmd "module" v *> (InfoModule <$> v .:: "query" <*> v .:: "filter"),
+		guardCmd "symbol" v *> (InfoSymbol <$> v .:: "query" <*> v .:: "filters" <*> v .:: "locals"),
+		guardCmd "module" v *> (InfoModule <$> v .:: "query" <*> v .:: "filters"),
 		guardCmd "resolve" v *> (InfoResolve <$> v .:: "file" <*> v .:: "exports"),
 		guardCmd "project" v *> (InfoProject <$> asum [Left <$> v .:: "name", Right <$> v .:: "path"]),
 		guardCmd "sandbox" v *> (InfoSandbox <$> v .:: "path"),
 		guardCmd "lookup" v *> (Lookup <$> v .:: "name" <*> v .:: "file"),
 		guardCmd "whois" v *> (Whois <$> v .:: "name" <*> v .:: "file"),
-		guardCmd "scope modules" v *> (ResolveScopeModules <$> v .:: "file"),
+		guardCmd "scope modules" v *> (ResolveScopeModules <$> v .:: "query" <*> v .:: "file"),
 		guardCmd "scope" v *> (ResolveScope <$> v .:: "query" <*> v .:: "global" <*> v .:: "file"),
 		guardCmd "complete" v *> (Complete <$> v .:: "prefix" <*> v .:: "wide" <*> v .:: "file"),
 		guardCmd "hayoo" v *> (Hayoo <$> v .:: "query" <*> v .:: "page" <*> v .:: "pages"),
@@ -580,10 +580,9 @@ 	toJSON (TargetPackage pname) = object ["package" .= pname]
 	toJSON TargetSourced = toJSON ("sourced" :: String)
 	toJSON TargetStandalone = toJSON ("standalone" :: String)
-	toJSON TargetAny = toJSON ()
 
 instance FromJSON TargetFilter where
-	parseJSON j = obj j <|> str' <|> any' where
+	parseJSON j = obj j <|> str' where
 		obj = withObject "target-filter" $ \v -> asum [
 			TargetProject <$> v .:: "project",
 			TargetFile <$> v .:: "file",
@@ -597,7 +596,6 @@ 				"sourced" -> return TargetSourced
 				"standalone" -> return TargetStandalone
 				_ -> empty
-		any' = (\() -> TargetAny) <$> parseJSON j
 
 instance ToJSON SearchQuery where
 	toJSON (SearchQuery q st) = object ["input" .= q, "type" .= st]

src/HsDev/Symbols.hs view

@@ -5,7 +5,7 @@ 	-- * Information
 	export,
 	passImportList,
-	importName, import_,
+	importNames, import_,
 	Symbol(..),
 	unnamedModuleId,
 	sortDeclarations, moduleLocals,
@@ -68,9 +68,9 @@ 	| hiding = n `notElem` names
 	| otherwise = n `elem` names
 
--- | Get import module name
-importName :: Import -> Text
-importName i = fromMaybe (view importModuleName i) $ view importAs i
+-- | Get import module names - full and synonym
+importNames :: Import -> [Text]
+importNames i = view importModuleName i : maybe [] return (view importAs i)
 
 -- | Simple import
 import_ :: Text -> Import
@@ -141,7 +141,7 @@ 
 -- | Get scopes of @Declaration@, where @Nothing@ is global scope
 scopes :: Declaration -> [Maybe Text]
-scopes d = globalScope $ map (Just . importName) is where
+scopes d = globalScope $ concatMap (map Just . importNames) is where
 	is = fromMaybe [] $ view declarationImported d
 	globalScope
 		| any (not . view importIsQualified) is = (Nothing :)

src/HsDev/Symbols/Resolve.hs view

@@ -103,10 +103,10 @@ 	where
 		checkImport = case q of
 			Nothing -> any (not . view importIsQualified) $ fromMaybe [] $ view declarationImported decl'
-			Just q' -> any ((== q') . importName) $ fromMaybe [] $ view declarationImported decl'
+			Just q' -> any ((q' `elem`) . importNames) $ fromMaybe [] $ view declarationImported decl'
 exported decl' (ExportModule m) = decl' `justWhen` (any (unqualBy m) . fromMaybe [] . view declarationImported) where
 	unqualBy :: Text -> Import -> Bool
-	unqualBy m' i = importName i == m' && not (view importIsQualified i)
+	unqualBy m' i = m' `elem` importNames i && not (view importIsQualified i)
 
 -- | Bring declarations into scope
 resolveImport :: Module -> Import -> ResolveM [Declaration]

src/HsDev/Tools/Ghc/Types.hs view

@@ -2,16 +2,19 @@ 
 module HsDev.Tools.Ghc.Types (
 	TypedExpr(..), typedExpr, typedType,
-	moduleTypes, fileTypes
+	moduleTypes, fileTypes,
+	setModuleTypes, inferTypes
 	) where
 
 import Control.DeepSeq
-import Control.Lens (over, view, preview, makeLenses, _Just)
+import Control.Lens (over, view, set, each, preview, makeLenses, _Just)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Aeson
 import Data.Generics
+import Data.List (find)
 import Data.Maybe
+import Data.String (fromString)
 import System.Directory
 import System.FilePath
 
@@ -92,6 +95,7 @@ 		v .:: "expr" <*>
 		v .:: "type"
 
+-- | Get all types in module
 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
@@ -127,3 +131,16 @@ 		showType df = showDoc OneLineMode 80 . withPprStyleDoc df unqualStyle . pprTypeForUser
 		unqualStyle :: PprStyle
 		unqualStyle = mkUserStyle neverQualify AllTheWay
+
+-- | Set types to module
+setModuleTypes :: [Note TypedExpr] -> Module -> Module
+setModuleTypes ts = over (moduleDeclarations . each) setType where
+	setType :: Declaration -> Declaration
+	setType d = fromMaybe d $ do
+		pos <- view declarationPosition d
+		tnote <- find ((== pos) . view (noteRegion . regionFrom)) ts
+		return $ set (declaration . functionType) (Just $ fromString $ view (note . typedType) tnote) d
+
+-- | Infer types in module
+inferTypes :: [String] -> Cabal -> Module -> Maybe String -> ExceptT String Ghc Module
+inferTypes opts cabal m msrc = liftM (`setModuleTypes` m) $ fileTypes opts cabal m msrc

src/HsDev/Tools/HLint.hs view

@@ -40,10 +40,9 @@ 	_noteSource = FileModule (srcSpanFilename src) Nothing,
 	_noteRegion = Region (Position (srcSpanStartLine src) (srcSpanStartColumn src)) (Position (srcSpanEndLine src) (srcSpanEndColumn src)),
 	_noteLevel = Just $ case ideaSeverity idea of
-		HL.Ignore -> Hint
-		HL.Suggestion -> Hint
 		HL.Warning -> Warning
-		HL.Error -> Error,
+		HL.Error -> Error
+		_ -> Hint,
 	_note = OutputMessage {
 		_message = ideaHint idea,
 		_messageSuggestion = ideaTo idea } }