From 96cbf68e16fd3a019ed62fe94f2309dcd9bbef5f Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 15 Feb 2012 14:52:48 +0900 Subject: [PATCH] more applicative. error msg fix. --- Cabal.hs | 6 ++---- CabalDev.hs | 17 ++++++++--------- GHCApi.hs | 9 +++++---- Gap.hs | 9 +++------ Info.hs | 21 +++++++++++++-------- ghc-mod.cabal | 4 +++- 6 files changed, 34 insertions(+), 32 deletions(-) diff --git a/Cabal.hs b/Cabal.hs index c1e79b0..eea919d 100644 --- a/Cabal.hs +++ b/Cabal.hs @@ -25,11 +25,9 @@ importDirs :: [String] importDirs = [".","..","../..","../../..","../../../..","../../../../.."] initializeGHC :: Options -> FilePath -> [String] -> Bool -> Ghc (FilePath,LogReader) -initializeGHC opt fileName ghcOptions logging = - withCabal `gcatch` withoutCabal +initializeGHC opt fileName ghcOptions logging = withCabal <|> withoutCabal where - withoutCabal :: SomeException -> Ghc (FilePath,LogReader) - withoutCabal _ = do + withoutCabal = do logReader <- initSession opt ghcOptions importDirs logging return (fileName,logReader) withCabal = do diff --git a/CabalDev.hs b/CabalDev.hs index 91b4f1f..76ebb95 100644 --- a/CabalDev.hs +++ b/CabalDev.hs @@ -5,21 +5,20 @@ module CabalDev (modifyOptions) where options ghc-mod uses to check the source. Otherwise just pass it on. -} -import Control.Applicative ((<$>)) -import Control.Exception (SomeException, throwIO) -import Data.List (find) -import GHC (gcatch) +import Control.Applicative ((<$>),(<|>)) +import Control.Exception (throwIO) +import Data.List (find) import System.Directory -import System.FilePath (splitPath,joinPath,()) -import Text.Regex.Posix ((=~)) +import System.FilePath (splitPath,joinPath,()) +import Text.Regex.Posix ((=~)) import Types +import Data.Alternative.IO () modifyOptions :: Options -> IO Options -modifyOptions opts = found `gcatch` notFound +modifyOptions opts = found <|> notFound where found = addPath opts <$> findCabalDev - notFound :: SomeException -> IO Options - notFound _ = return opts + notFound = return opts findCabalDev :: IO String findCabalDev = getCurrentDirectory >>= searchIt . splitPath diff --git a/GHCApi.hs b/GHCApi.hs index fa6f7a6..d5ff73f 100644 --- a/GHCApi.hs +++ b/GHCApi.hs @@ -1,6 +1,7 @@ module GHCApi where -import Control.Monad +import Control.Exception +import Control.Applicative import CoreMonad import DynFlags import ErrMsg @@ -11,13 +12,13 @@ import Types ---------------------------------------------------------------- -withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a) +withGHC :: Alternative m => Ghc (m a) -> IO (m a) withGHC body = ghandle ignore $ runGhc (Just libdir) $ do dflags <- getSessionDynFlags defaultCleanupHandler dflags body where - ignore :: (MonadPlus m) => SomeException -> IO (m a) - ignore _ = return mzero + ignore :: Alternative m => SomeException -> IO (m a) + ignore _ = return empty ---------------------------------------------------------------- diff --git a/Gap.hs b/Gap.hs index e2e1286..828b1e6 100644 --- a/Gap.hs +++ b/Gap.hs @@ -15,8 +15,8 @@ module Gap ( #endif ) where +import AA () import Control.Applicative hiding (empty) -import Control.Exception import Control.Monad import DynFlags import FastString @@ -115,10 +115,7 @@ setCtx ms = do return (not . null $ top) #endif where - isTop mos = lookupMod `gcatch` returnFalse + isTop mos = lookupMod <|> returnFalse where lookupMod = lookupModule (ms_mod_name mos) Nothing >> return True - returnFalse = constE $ return False - -constE :: a -> (SomeException -> a) -constE func = \_ -> func + returnFalse = return False diff --git a/Info.hs b/Info.hs index fe9e7d1..d8319ac 100644 --- a/Info.hs +++ b/Info.hs @@ -2,6 +2,7 @@ module Info (infoExpr, typeExpr) where +import AA import Cabal import Control.Applicative import CoreUtils @@ -34,7 +35,8 @@ infoExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String infoExpr opt modstr expr file = (++ "\n") <$> info opt file modstr expr info :: Options -> FilePath -> ModuleString -> FilePath -> IO String -info opt fileName modstr expr = inModuleContext opt fileName modstr exprToInfo +info opt fileName modstr expr = + inModuleContext opt fileName modstr exprToInfo "Cannot show info" where exprToInfo = infoThing expr @@ -44,7 +46,8 @@ typeExpr :: Options -> ModuleString -> Int -> Int -> FilePath -> IO String typeExpr opt modstr lineNo colNo file = Info.typeOf opt file modstr lineNo colNo typeOf :: Options -> FilePath -> ModuleString -> Int -> Int -> IO String -typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr exprToType +typeOf opt fileName modstr lineNo colNo = + inModuleContext opt fileName modstr exprToType errmsg where exprToType = do modSum <- getModSummary $ mkModuleName modstr @@ -66,6 +69,8 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex | b `isSubspanOf` a = O.GT | otherwise = O.EQ + errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)]) + findExpr :: TypecheckedModule -> Int -> Int -> [LHsExpr Id] findExpr tcm line col = let src = tm_typechecked_source tcm @@ -119,19 +124,20 @@ pprInfo pefas (thing, fixity, insts) ---------------------------------------------------------------- -inModuleContext :: Options -> FilePath -> ModuleString -> Ghc String -> IO String -inModuleContext opt fileName modstr action = withGHC valid +inModuleContext :: Options -> FilePath -> ModuleString -> Ghc String -> String -> IO String +inModuleContext opt fileName modstr action errmsg = + withGHC (valid <|> invalid <|> return errmsg) where valid = do (file,_) <- initializeGHC opt fileName ["-w"] False setTargetFile file load LoadAllTargets - mif setContextFromTarget action invalid + doif setContextFromTarget action invalid = do initializeGHC opt fileName ["-w"] False setTargetBuffer load LoadAllTargets - mif setContextFromTarget action (return errorMessage) + doif setContextFromTarget action setTargetBuffer = do modgraph <- depanal [mkModuleName modstr] True let imports = concatMap (map (showSDoc . ppr . unLoc)) $ @@ -141,9 +147,8 @@ inModuleContext opt fileName modstr action = withGHC valid importsBuf <- Gap.toStringBuffer header clkTime <- Gap.liftIO getClockTime setTargets [Target (TargetModule $ mkModuleName modstr) True (Just (importsBuf, clkTime))] - mif m t e = m >>= \ok -> if ok then t else e + doif m t = m >>= \ok -> if ok then t else goNext sanitize = fromMaybe "SomeModule" . listToMaybe . words - errorMessage = "Couldn't determine type" setContextFromTarget :: Ghc Bool setContextFromTarget = depanal [] False >>= Gap.setCtx diff --git a/ghc-mod.cabal b/ghc-mod.cabal index a79b488..a68145f 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -23,7 +23,8 @@ Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-flymake.el ghc-command.el ghc-info.el ghc-ins-mod.el Executable ghc-mod Main-Is: GHCMod.hs - Other-Modules: Browse + Other-Modules: AA + Browse Cabal CabalDev Check @@ -43,6 +44,7 @@ Executable ghc-mod GHC-Options: -Wall Build-Depends: base >= 4.0 && < 5 , Cabal + , alternative-io , directory , filepath , ghc