From 79946f9a3d27362ecf137475fa9858f2b7f31f18 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 23 Apr 2014 16:37:24 +0900 Subject: [PATCH] removing withGHCDummyFile. --- Language/Haskell/GhcMod/Browse.hs | 2 +- Language/Haskell/GhcMod/GHCApi.hs | 20 +++++++------- Language/Haskell/GhcMod/Ghc.hs | 2 +- Language/Haskell/GhcMod/Info.hs | 45 ++++++++++++++++--------------- Language/Haskell/GhcMod/List.hs | 2 +- 5 files changed, 36 insertions(+), 35 deletions(-) diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 2b03870..4e7f115 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -31,7 +31,7 @@ browseModule :: Options -> Cradle -> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> IO String -browseModule opt cradle mdlName = withGHCDummyFile $ do +browseModule opt cradle mdlName = withGHC' $ do void $ initializeFlagsWithCradle opt cradle [] False browse opt mdlName diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index d514040..e0c6be9 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -2,7 +2,7 @@ module Language.Haskell.GhcMod.GHCApi ( withGHC - , withGHCDummyFile + , withGHC' , initializeFlagsWithCradle , setTargetFiles , addTargetFiles @@ -42,20 +42,11 @@ getSystemLibDir = do ---------------------------------------------------------------- --- | Converting the 'Ghc' monad to the 'IO' monad. -withGHCDummyFile :: Ghc a -- ^ 'Ghc' actions created by the Ghc utilities. - -> IO a -withGHCDummyFile = withGHC "Dummy" - -- | Converting the 'Ghc' monad to the 'IO' monad. withGHC :: FilePath -- ^ A target file displayed in an error message. -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities. -> IO a -withGHC file body = do - mlibdir <- getSystemLibDir - ghandle ignore $ G.runGhc mlibdir $ do - dflags <- G.getSessionDynFlags - G.defaultCleanupHandler dflags body +withGHC file body = ghandle ignore $ withGHC' body where ignore :: SomeException -> IO a ignore e = do @@ -63,6 +54,13 @@ withGHC file body = do hPrint stderr e exitSuccess +withGHC' :: Ghc a -> IO a +withGHC' body = do + mlibdir <- getSystemLibDir + G.runGhc mlibdir $ do + dflags <- G.getSessionDynFlags + G.defaultCleanupHandler dflags body + ---------------------------------------------------------------- importDirs :: [IncludeDir] diff --git a/Language/Haskell/GhcMod/Ghc.hs b/Language/Haskell/GhcMod/Ghc.hs index 0e927b5..b6c49b0 100644 --- a/Language/Haskell/GhcMod/Ghc.hs +++ b/Language/Haskell/GhcMod/Ghc.hs @@ -1,7 +1,7 @@ module Language.Haskell.GhcMod.Ghc ( -- * Converting the 'Ghc' monad to the 'IO' monad withGHC - , withGHCDummyFile + , withGHC' -- * 'Ghc' utilities , browse , check diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 5e398ec..f970ac5 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -37,19 +37,22 @@ infoExpr :: Options -> FilePath -- ^ A target file. -> Expression -- ^ A Haskell expression. -> IO String -infoExpr opt cradle file expr = (++ "\n") <$> withGHCDummyFile - (inModuleContext opt cradle file (info opt file expr) "Cannot show info") +infoExpr opt cradle file expr = withGHC' $ + inModuleContext opt cradle file (info opt file expr) -- | Obtaining information of a target expression. (GHCi's info:) info :: Options -> FilePath -- ^ A target file. -> Expression -- ^ A Haskell expression. -> Ghc String -info opt file expr = do - void $ Gap.setCtx file - sdoc <- Gap.infoThing expr - (dflag, style) <- getFlagStyle - return $ convert opt $ showPage dflag style sdoc +info opt file expr = convert opt <$> ghandle handler body + where + body = do + void $ Gap.setCtx file + sdoc <- Gap.infoThing expr + (dflag, style) <- getFlagStyle + return $ showPage dflag style sdoc + handler (SomeException e) = return $ "Cannot show info (" ++ show e ++ ")" ---------------------------------------------------------------- @@ -71,10 +74,8 @@ typeExpr :: Options -> Int -- ^ Line number. -> Int -- ^ Column number. -> IO String -typeExpr opt cradle file lineNo colNo = withGHCDummyFile $ - inModuleContext opt cradle file (types opt file lineNo colNo) errmsg - where - errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)]) +typeExpr opt cradle file lineNo colNo = withGHC' $ + inModuleContext opt cradle file (types opt file lineNo colNo) -- | Obtaining type of a target expression. (GHCi's type:) types :: Options @@ -82,12 +83,16 @@ types :: Options -> Int -- ^ Line number. -> Int -- ^ Column number. -> Ghc String -types opt file lineNo colNo = do - modSum <- Gap.setCtx file - (dflag, style) <- getFlagStyle - srcSpanTypes <- getSrcSpanType modSum lineNo colNo - let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes - return $ convert opt tups +types opt file lineNo colNo = convert opt <$> ghandle handler body + where + body = do + modSum <- Gap.setCtx file + (dflag, style) <- getFlagStyle + srcSpanTypes <- getSrcSpanType modSum lineNo colNo + let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes + return $ tups + handler (SomeException _) = return errmsg + errmsg = [] :: [((Int,Int,Int,Int),String)] getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)] getSrcSpanType modSum lineNo colNo = do @@ -129,14 +134,12 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser noWaringOptions :: [String] noWaringOptions = ["-w:"] -inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> String -> Ghc String -inModuleContext opt cradle file action errmsg = ghandle handler $ do +inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> Ghc String +inModuleContext opt cradle file action = do void $ initializeFlagsWithCradle opt cradle noWaringOptions False setTargetFiles [file] void $ G.load LoadAllTargets action - where - handler (SomeException _) = return errmsg ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index 33cf887..7e9c1e4 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/Language/Haskell/GhcMod/List.hs @@ -14,7 +14,7 @@ import UniqFM (eltsUFM) -- | Listing installed modules. listModules :: Options -> Cradle -> IO String -listModules opt cradle = withGHCDummyFile $ do +listModules opt cradle = withGHC' $ do void $ initializeFlagsWithCradle opt cradle [] False modules opt