hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

error handling for browse.

This commit is contained in:
Kazu Yamamoto 2014-04-24 12:45:47 +09:00
parent 2d1133ea8e
commit 93dadfef44
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Language/Haskell/GhcMod/Browse.hs
View File

@ -5,10 +5,12 @@ module Language.Haskell.GhcMod.Browse (
where where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (SomeException(..))
import Control.Monad (void) import Control.Monad (void)
import Data.Char (isAlpha) import Data.Char (isAlpha)
import Data.List (sort) import Data.List (sort)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Exception (ghandle)
import FastString (mkFastString) import FastString (mkFastString)
import GHC (Ghc, GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module) import GHC (Ghc, GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module)
import qualified GHC as G import qualified GHC as G
@ -18,7 +20,6 @@ import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Name (getOccString) import Name (getOccString)
import Outputable (ppr, Outputable) import Outputable (ppr, Outputable)
import Panic (throwGhcException)
import TyCon (isAlgTyCon) import TyCon (isAlgTyCon)
import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy) import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy)
@ -42,12 +43,11 @@ browse :: Options
-> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> Ghc String -> Ghc String
browse opt pkgmdl = do browse opt pkgmdl = do
convert opt . sort <$> (getModule >>= G.getModuleInfo >>= listExports) convert opt . sort <$> (getModule >>= listExports)
where where
(mpkg,mdl) = splitPkgMdl pkgmdl (mpkg,mdl) = splitPkgMdl pkgmdl
mdlname = G.mkModuleName mdl mdlname = G.mkModuleName mdl
mpkgid = mkFastString <$> mpkg mpkgid = mkFastString <$> mpkg
getModule = G.findModule mdlname mpkgid `G.gcatch` fallback
listExports Nothing = return [] listExports Nothing = return []
listExports (Just mdinfo) = processExports opt mdinfo listExports (Just mdinfo) = processExports opt mdinfo
-- findModule works only for package modules, moreover, -- findModule works only for package modules, moreover,
@ -55,12 +55,14 @@ browse opt pkgmdl = do
-- to browse a local module you need to load it first. -- to browse a local module you need to load it first.
-- If CmdLineError is signalled, we assume the user -- If CmdLineError is signalled, we assume the user
-- tried browsing a local module. -- tried browsing a local module.
fallback (CmdLineError _) = loadAndFind getModule = browsePackageModule `G.gcatch` fallback `G.gcatch` handler
fallback e = throwGhcException e browsePackageModule = G.findModule mdlname mpkgid >>= G.getModuleInfo
loadAndFind = do browseLocalModule = ghandle handler $ do
setTargetFiles [mdl] setTargetFiles [mdl]
G.findModule mdlname Nothing G.findModule mdlname Nothing >>= G.getModuleInfo
fallback (CmdLineError _) = browseLocalModule
fallback _ = return Nothing
handler (SomeException _) = return Nothing
-- | -- |
-- --
-- >>> splitPkgMdl "base:Prelude" -- >>> splitPkgMdl "base:Prelude"